diff --git a/Lang/4D/00-LANG.txt b/Lang/4D/00-LANG.txt index d591e6be7f..8c8b507919 100644 --- a/Lang/4D/00-LANG.txt +++ b/Lang/4D/00-LANG.txt @@ -1,3 +1,6 @@ -{{stub}}{{language|4D}}{{IDE}}'''4D''' (or '''4th Dimension''') is a database management system and [[:Category:Integrated Development Environments|integrated development environment]] authored by Laurent Ribardière in 1984. +{{stub}} +{{language|4D +|site=https://us.4d.com/ +}}{{IDE}}'''4D''' (or '''4th Dimension''') is a database management system and [[:Category:Integrated Development Environments|integrated development environment]] authored by Laurent Ribardière in 1984. ==Citations== *[[wp:4th_Dimension_%28Software%29|Wikipedia:4th Dimension (Software)]] \ No newline at end of file diff --git a/Lang/68000-Assembly/00-LANG.txt b/Lang/68000-Assembly/00-LANG.txt index cfd37d0eae..245cbaaea5 100644 --- a/Lang/68000-Assembly/00-LANG.txt +++ b/Lang/68000-Assembly/00-LANG.txt @@ -3,31 +3,36 @@ {{language}} 68000 assembly is the assembly language used for the Motorola 68000, or commonly known as the 68K. It should not be confused with the 6800 (which predates it). The Motorola 68000 is a big-endian processor with full 32-bit capabilities (despite most systems that use it being considered 16-bit.) It was used in many computers such as the Amiga or the Canon Cat, as well as game consoles such as the Sega Genesis and Neo Geo. - ==Architecture Overview== ===Big-Endian=== The 68000, unlike most processors of its era, is big-endian. This means that bytes are stored from left to right. The example below illustrates this concept: -MOVE.L #$12345678,$100000 ;store the hexadecimal numeral #$12345678 at memory address $100000 + +MOVE.L #$12345678,$100000 ;store the hexadecimal numeral #$12345678 at memory address $100000 + +
 ;hexdump of $100000:
 ;$100000 = $12
 ;$100001 = $34
 ;$100002 = $56
-;$100003 = $78
+;$100003 = $78
+
On a little-endian processor such as in [[x86 Assembly]], the order of the bytes would be reversed, i.e.: -;hexdump of $100000 +
+;hexdump of $100000
 ;$100000 = $78
 ;$100001 = $56
 ;$100002 = $34
-;$100003 = $12
+;$100003 = $12
+
-This difference isn't usually relevant in the majority of situations, so don't concern yourself too much. It's much more important when doing [[6502 Assembly]] where registers are smaller than the address space. +The main difference is that if you wanted to access this value as a byte or word it would be at a different address, whereas with a little endian architecture it is at the same address. ===Notation Conventions=== How you write the source code depends on your assembler and the syntax it uses. This page is written using Motorola syntax but there is also Milo syntax which has different conventions. -How you go about defining numbers or text in your code varies wildly between assemblers. I'm using VASM and these are the rules I have to follow, but your assembler may be different. +How you go about defining numbers or text in your code varies wildly between assemblers. * A number with a # in front represents a constant, literal value. For example, the 3 in MOVE.B #3,D0 represents the number 3. @@ -45,72 +50,88 @@ How you go about defining numbers or text in your code varies wildly between ass * The operand before the comma is the "source", and the operand after is the "destination." For example, MOVE.L D3,D2 takes the value in D3 and stores it into D2, not the other way around. This is the opposite of x86 and ARM, which have the source on the right and the destination on the left. - -Data blocks, on the other hand, begin with DC.B, DC.W, or DC.L and each represents a constant numeric value. Strangely, you do NOT prefix these with # to signify them as constants (doing so will cause an error on most assemblers). However, you can use the $ or % modifiers to denote hexadecimal or binary. +Data blocks, on the other hand, begin with DC.B, DC.W, or DC.L and each represents a constant numeric value. You do NOT prefix these with # to signify them as constants (doing so will cause an error on most assemblers). However, you can use the $ or % modifiers to denote hexadecimal or binary. Keep in mind that there is no requirement to use hexadecimal, decimal, or binary in your source code. It all gets converted to binary anyway. However, it is recommended to use the notation that is appropriate for how your data is meant to be interpreted, for readability purposes. ===Data Registers=== There are eight 32-bit data registers on the 68000, numbered D0-D7. As the name implies, these are designed to hold data. Much like in [[ARM Assembly]], each one is identical in terms of which commands it can use. A command that can be used for D0 can be used for any other D-register. -MOVE.B #$FF,D0 ;move the hexadecimal value 0xFF into the bottom byte of D0. -ADD.W #$8000,D4 ;add hexadecimal 0x8000 to the value stored in D4. + +MOVE.B #$FF,D0 ;move the hexadecimal value 0xFF into the bottom byte of D0. +ADD.W #$8000,D4 ;add hexadecimal 0x8000 to the value stored in D4. + ===Address Registers=== There are eight of these as well, numbered A0-A7. A7 is reserved as the stack pointer, and is commonly referenced as SP in assemblers. The others are free to use for any purpose. Although these registers are 32-bit, the 68000's address space is 24-bit (ranges from 0x000000 to 0xFFFFFF), so the leftmost byte is ignored. You can do simple math involving these registers but more complicated commands like multiply or divide can only be used with data registers. Address registers are used to contain addresses and extract the values stored within. ====Loading From Memory==== -MOVEA.L #$200000,A2 ;usually these are loaded from a label. + +MOVEA.L #$200000,A2 ;usually these are loaded from a label. ;The hex dump of address $200000: 44 55 66 77 MOVE.L #$00000000,D0 MOVE.B (A2),D0 ;load the byte stored at $200000 into D0. D0 = #$00000044 MOVE.W (A2),D0 ;load the word stored at $200000 into D0. D0 = #$00004455 MOVE.L (A2),D0 ;load the long stored at $200000 into D0. D0 = #$44556677 -MOVE.L D2,(A5) ;store the contents of D2 into the memory address pointed to by A5. - +MOVE.L D2,(A5) ;store the contents of D2 into the memory address pointed to by A5. + Note that it's also possible to transfer values to/from memory directly, without involving address registers at all. For constant memory locations, this is fine. However, the real strength of the address registers is in their pre-decrement and post-increment modes, which constant memory locations cannot use. -MOVE.L ($00FF0000),D0 + +MOVE.L ($00FF0000),D0 MOVE.W D1,($00FFFFFE) -MOVE.W ($00FF0000),($00FF1000) +MOVE.W ($00FF0000),($00FF1000) + The use of parentheses is not required on most assemblers, but can be used as a reminder to someone reading your code that these represent the values stored at the specified memory locations rather than literal numbers. ====Post-Increment==== The post-increment mode is specified by adding a + to the end of parentheses. This means that after the command is done, the address stored in the address register (not the value stored at that address) is increased by the byte length of the command (1 for .B, 2 for .W, 4 for .L). -MOVEA.L #$00240000,A4 ;load the address $240000 into A4 + +MOVEA.L #$00240000,A4 ;load the address $240000 into A4 MOVE.W (A4)+,D0 ;move the word stored at $240000 into D0, then increment to #$240002 MOVE.L (A4)+,D1 ;move the long stored at $240000 into D1, then increment to #$240006 -MOVE.L (SP)+,D3 ;pop the top value of the stack into D3 +MOVE.L (SP)+,D3 ;pop the top value of the stack into D3 + ====Pre-Decrement==== The pre-decrement mode is specified by typing a - before the parentheses. This means that before the command is done, the address stored in the address register is decreased by the byte length of the command. -MOVEA.L #$0024000A,A4 ;load the address $24000A into A4 +MOVEA.L #$0024000A,A4 ;load the address $24000A into A4 MOVE.W -(A4),D0 ;move the word stored at $240008 into D0 MOVE.L -(A4),D1 ;move the long stored at $240004 into D1 -MOVE.L D2,-(SP) ;push the contents of D2 onto the stack +MOVE.L D2,-(SP) ;push the contents of D2 onto the stack ====Address Offsets==== A memory address can be offset by a data register, an immediate value, or both. If a data register is used, only the bottom 2 bytes are considered. In either case, the contents of the data register and/or the immediate value are added to the value stored in the address register, and the value is read from that address at the specified length. The offsets are applied during the calculation only; the actual contents in the address register after the move are unchanged. Using a post-increment or pre-decrement with this addressing mode will only update the address by the specified length, not by the offsets. -MOVE.B (4,A0,D0),D1 ;The byte at A0+D0+4 is loaded into D1. + +MOVE.B (4,A0,D0),D1 ;The byte at A0+D0+4 is loaded into D1. + + It's possible to use the same data register as the offset and the destination. This does not cause any problems whatsoever, as the data register offset is "locked in" before the move, and is only updated after the command fully executes. Using the same command again immediately afterwards will offset based on the new value of that register. -MOVE.W (6,A0,D0),D0 ;The word at A0+D0+6 is read, then loaded into D0. + +MOVE.W (6,A0,D0),D0 ;The word at A0+D0+6 is read, then loaded into D0. + + A very important note is that when using this method with words and longs, the resulting address must be even! Otherwise the CPU will crash. For MOVE.B it doesn't matter. ====Effective Address==== A calculated offset can be saved to an address register with the LEA command, which stands for "Load Effective Address." [[x86 Assembly]] also has this command, and it serves the same purpose. The syntax for it can be a bit misleading depending on your assembler. -LEA myData,A0 ;load the effective address of myData into A0 + +LEA myData,A0 ;load the effective address of myData into A0 LEA (4,A0),A1 ;load into A1 the effective address A0+4. This looks like a dereference operation but it is not! -MOVE.W (A1),D1 ;dereference A1, loading the value it points to into D1. +MOVE.W (A1),D1 ;dereference A1, loading the value it points to into D1. + This can get confusing, especially if you have tables of pointers. Just remember that LEA cannot dereference an address. If you don't want to store the effective address in an address register, you can use PEA (push effective address) to put it onto the stack instead. -LEA myData,A0 ;load the effective address of myData into A0 -PEA (4,A0) ;store the effective address of A0+4 onto the stack. + +LEA myData,A0 ;load the effective address of myData into A0 +PEA (4,A0) ;store the effective address of A0+4 onto the stack. + ====The Stack==== The 68000's stack is commonly referred to as SP but it is also address register A7. This register is handled differently than the other address registers when pushing bytes onto the stack. A byte value pushed onto the stack will be padded to the right. The stack needs to pad byte-length data so that it can stay word-aligned at all times. Otherwise the CPU would crash as soon as you tried to use the stack for anything other than a byte! @@ -124,48 +145,48 @@ The 68000 can work with 8-bit, 16-bit, or 32-bit values. Some commands only work If you don't specify a length with your command, it usually defaults to word length, but ultimately it depends on the command you are using. (Some commands cannot be used at word length.) Bytes and words moved into a register are always stored on the right-hand side. For example: -MOVE.L #$FFFFFFFF,D7 + +MOVE.L #$FFFFFFFF,D7 MOVE.B #$00,D7 ;D7 contains #$FFFFFF00 -MOVE.W #$2222,D7 ;D7 contains #$FFFF2222 +MOVE.W #$2222,D7 ;D7 contains #$FFFF2222 + As you can see, the rest of the register is unchanged. (On the ARM, it would turn to zeroes.) This is very important to remember. If your code is doing something unexpected it might be due to the "old" value of the register corrupting another function. If the given constant is smaller than the length provided, the value is padded to the left with zeroes. -MOVE.W #$FF,D3 ;D3 = #$xxxx00FF, where x is the previous value of D3. -MOVE.L #0,D3 ;D3 = #$00000000 + +MOVE.W #$FF,D3 ;D3 = #$xxxx00FF, where x is the previous value of D3. +MOVE.L #0,D3 ;D3 = #$00000000 + Loading immediate values into address registers is different. You can only move words or longer into address registers, and if you move a word, the value is sign-extended. This means that if the top nibble of the word is 8 or greater, the value gets padded to the left with Fs, and is padded with zeroes if the top nibble is 7 or less. If you're adding a constant value less than 7FFF to an address, it's usually safe to use the word length operation, which takes less bytes to encode than the long length version. -MOVEA.W #$8000,A4 ;A4 = #$FFFF8000. Remember the top byte is ignored so this is the same as #$00FF8000. -MOVEA.W #$7FFF,A3 ;A3 = #$00007FFF + +MOVEA.W #$8000,A4 ;A4 = #$FFFF8000. Remember the top byte is ignored so this is the same as #$00FF8000. +MOVEA.W #$7FFF,A3 ;A3 = #$00007FFF + ==The Flags== The flags are stored in the Condition Code Register, also known as the CCR. The 68000 has no built-in commands like CLC for clearing/setting individual flags. Rather, you can alter them directly with MOVE,AND,OR, and EOR. Unfortunately, this means you'll have to remember which bits represent which flags. Or, if your assembler supports macros, you can define a macro that handles this for you. The flags update automatically after most operations, and take into consideration the operand sizes when doing so. Check out this example: - + MOVE.L #$12FF,D0 ADD.B #1,D0 - + Since we used ADD.B, D0 now contains $1200, and the extend, carry, and zero flags are all set. Had we done ADD.W, we would get $1300 in D0 with none of those flags set. The flags are based on what the actual instruction "sees", not the entire register at all times. * X: The eXtend flag is bit 4 of the CCR, and is similar to the carry flag. It gets set and cleared often for the same reasons and is used with the ADDX, SUBX, NEGX, ROXL, and ROXR commands. Why the 68000 has both this and the carry flag, I still don't know. - * N: The negative flag is bit 3 of the CCR, and is set when the last operation resulted in a "negative" value. What constitutes a negative value depends on the size of the last operation - for .B instructions, $80-$FF. For .W instructions, $8000-$FFFF, and for .L instructions, $80000000-$FFFFFFFF. - * Z: The zero flag is bit 2 of the CCR and works like you would expect - it's set whenever an operation results in zero. Unlike x86 Assembly, this also includes moving 0 directly into a register, clearing a register or memory with CLR, etc. - * V: The overflow flag is bit 1 of the CCR. It is set whenever a math operation results in a value crossing the $7F-$80 boundary. (Wraparound from 00 to FF doesn't count as overflow, but it does set the carry flag.) - * C: The carry flag is bit 0 of the CCR. It is set when a math operation results in a carry or borrow. Rolling over from FF to 00, or a 1 getting "pushed out" via a bit shift or rotate, set the carry flag. When using CMP, the carry flag determines the unsigned magnitude comparison. Carry set is less than, carry clear is greater than or equal. - - In truth, the flags are a 16-bit register, of which the CCR is just the "low half". The SR (status register) is the full 16-bit register. There are a few additional flags in the upper half, which are used by the operating system. You can read these but for the most part you won't need to write to them. @@ -189,13 +210,15 @@ The 68000 supports 7 different interrupts, often called IRQs or Interrupt Reques ==Alignment== The 68000 can only read or write words and longs at even addresses. Doing so at an odd address will result in the CPU crashing. (Note that reading byte data will not cause a crash regardless of whether it's located at an odd or even address.) This isn't usually a problem, but it can be if the programmer is not careful with the way their data is organized. Consider the following example: -TestData: + +TestData: DC.B $02 DC.W $0345 LEA TestData,A0 ;load effective address of TestData into A0. MOVE.B (A0)+,D0 ;load $02 into D0, increment A0 by 1 -MOVE.W (A0)+,D1 ;this crashes the CPU since A0 is now odd +MOVE.W (A0)+,D1 ;this crashes the CPU since A0 is now odd + How was it known that the address was odd at the second instruction? Simple. All instructions take an even number of bytes to encode. So there are only a few ways improper alignment can occur: * An odd value is loaded into an address register. @@ -205,18 +228,23 @@ How was it known that the address was odd at the second instruction? Simple. All If the programmer is smart with the way they encode byte-length data they can avoid this problem entirely with little effort. One way is to separate byte-length data into its own table. -ByteData: + +ByteData: DC.B $20,$40,$60,$80 WordData: -DC.W $1000,$2000,$3000,$4000 +DC.W $1000,$2000,$3000,$4000 + Another way is to pad the data with an extra byte, so that there is an even number of entries in the table. This becomes impractical with large data tables, so the EVEN directive can be placed after a series of bytes. If the byte count is odd, EVEN will pad the data with an extra byte. If it's already even, the EVEN command is ignored. This saves you the trouble of having to count a long series of bytes without worrying about wasting space. -MyString: DC.B "HELLO WORLD 12345678900000",0 -EVEN ;some assemblers require this to be on its own line + +MyString: DC.B "HELLO WORLD 12345678900000",0 +EVEN ;some assemblers require this to be on its own line + A third way is to perform a "dummy read." This is when a value is read from an address using pre-decrement or post-increment, with the sole purpose of moving the pointer, and the value being read is of zero interest. This method lets you work with mixed data types in the same table, but it requires the programmer to know in advance where the byte-length data begins and ends. -TestData: + +TestData: DC.B $02,$03,$04 DC.W $0345 @@ -227,7 +255,8 @@ MOVE.B (A0)+,(A1)+ ;copy $04 to a new memory location ;if we did MOVE.W (A0)+,(A1)+ now we'd crash. First we need to adjust the pointers. MOVE.B (A0)+,D7 ;dummy read to D7. Now A0 is word aligned. MOVE.B (A1)+,D7 ;dummy read to D7. Now A1 is word aligned. -MOVE.W (A0)+,(A1)+ ;copy $0345 to a new memory location +MOVE.W (A0)+,(A1)+ ;copy $0345 to a new memory location + Using ADDA.L #1,A0 and ADDA.L #1,A1 would have worked also, instead of the dummy read. The 68000 gives the programmer a lot of different ways to do a task. diff --git a/Lang/68000-Assembly/Musical-scale b/Lang/68000-Assembly/Musical-scale new file mode 120000 index 0000000000..0a23b13b4e --- /dev/null +++ b/Lang/68000-Assembly/Musical-scale @@ -0,0 +1 @@ +../../Task/Musical-scale/68000-Assembly \ No newline at end of file diff --git a/Lang/8080-Assembly/Align-columns b/Lang/8080-Assembly/Align-columns new file mode 120000 index 0000000000..d9134cb487 --- /dev/null +++ b/Lang/8080-Assembly/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/8080-Assembly \ No newline at end of file diff --git a/Lang/ABAP/00-LANG.txt b/Lang/ABAP/00-LANG.txt index 446b44c265..819bd4cbc5 100644 --- a/Lang/ABAP/00-LANG.txt +++ b/Lang/ABAP/00-LANG.txt @@ -1,2 +1,14 @@ -{{stub}}{{language|site=http://www.sdn.sap.com/irj/sdn/abap}} -ABAP (Advanced Business Application Programming) is a programming language developed by the german software vendor SAP. It is mainly used to build high performance business applications. \ No newline at end of file +{{stub}}{{language +|site=http://www.sdn.sap.com/irj/sdn/abap +|safety=safe +|strength=strong +|compat=nominative +|checking=static +|tags=abap}} +ABAP (Advanced Business Application Programming) is a programming language developed by the german software vendor SAP. It is mainly used to build high performance business applications. + +==Citation== +*[https://en.wikipedia.org/wiki/ABAP] + +[[Category:Programming paradigm/Object-oriented]] +[[Category:Programming paradigm/Imperative]] \ No newline at end of file diff --git a/Lang/ABC/Arithmetic-derivative b/Lang/ABC/Arithmetic-derivative new file mode 120000 index 0000000000..4225078056 --- /dev/null +++ b/Lang/ABC/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/ABC \ No newline at end of file diff --git a/Lang/ALGOL-60/Even-or-odd b/Lang/ALGOL-60/Even-or-odd new file mode 120000 index 0000000000..13baeccf6c --- /dev/null +++ b/Lang/ALGOL-60/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/ALGOL-60 \ No newline at end of file diff --git a/Lang/ALGOL-60/Harmonic-series b/Lang/ALGOL-60/Harmonic-series new file mode 120000 index 0000000000..a1eefb4086 --- /dev/null +++ b/Lang/ALGOL-60/Harmonic-series @@ -0,0 +1 @@ +../../Task/Harmonic-series/ALGOL-60 \ No newline at end of file diff --git a/Lang/ALGOL-60/Nth-root b/Lang/ALGOL-60/Nth-root new file mode 120000 index 0000000000..3032f52453 --- /dev/null +++ b/Lang/ALGOL-60/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/ALGOL-60 \ No newline at end of file diff --git a/Lang/ALGOL-60/Square-free-integers b/Lang/ALGOL-60/Square-free-integers new file mode 120000 index 0000000000..caff91a536 --- /dev/null +++ b/Lang/ALGOL-60/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/ALGOL-60 \ No newline at end of file diff --git a/Lang/ALGOL-60/Sum-of-a-series b/Lang/ALGOL-60/Sum-of-a-series new file mode 120000 index 0000000000..48b6d3380c --- /dev/null +++ b/Lang/ALGOL-60/Sum-of-a-series @@ -0,0 +1 @@ +../../Task/Sum-of-a-series/ALGOL-60 \ No newline at end of file diff --git a/Lang/ALGOL-68/100-prisoners b/Lang/ALGOL-68/100-prisoners new file mode 120000 index 0000000000..f6c4da597a --- /dev/null +++ b/Lang/ALGOL-68/100-prisoners @@ -0,0 +1 @@ +../../Task/100-prisoners/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Bitmap-B-zier-curves-Quadratic b/Lang/ALGOL-68/Bitmap-B-zier-curves-Quadratic new file mode 120000 index 0000000000..30ab56c310 --- /dev/null +++ b/Lang/ALGOL-68/Bitmap-B-zier-curves-Quadratic @@ -0,0 +1 @@ +../../Task/Bitmap-B-zier-curves-Quadratic/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Burrows-Wheeler-transform b/Lang/ALGOL-68/Burrows-Wheeler-transform new file mode 120000 index 0000000000..203e0e501f --- /dev/null +++ b/Lang/ALGOL-68/Burrows-Wheeler-transform @@ -0,0 +1 @@ +../../Task/Burrows-Wheeler-transform/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Chernicks-Carmichael-numbers b/Lang/ALGOL-68/Chernicks-Carmichael-numbers new file mode 120000 index 0000000000..ebdbb0354b --- /dev/null +++ b/Lang/ALGOL-68/Chernicks-Carmichael-numbers @@ -0,0 +1 @@ +../../Task/Chernicks-Carmichael-numbers/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Determinant-and-permanent b/Lang/ALGOL-68/Determinant-and-permanent new file mode 120000 index 0000000000..e8a753594d --- /dev/null +++ b/Lang/ALGOL-68/Determinant-and-permanent @@ -0,0 +1 @@ +../../Task/Determinant-and-permanent/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Display-an-outline-as-a-nested-table b/Lang/ALGOL-68/Display-an-outline-as-a-nested-table new file mode 120000 index 0000000000..41ea472cc8 --- /dev/null +++ b/Lang/ALGOL-68/Display-an-outline-as-a-nested-table @@ -0,0 +1 @@ +../../Task/Display-an-outline-as-a-nested-table/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Elementary-cellular-automaton-Random-number-generator b/Lang/ALGOL-68/Elementary-cellular-automaton-Random-number-generator new file mode 120000 index 0000000000..a4aed0fa0e --- /dev/null +++ b/Lang/ALGOL-68/Elementary-cellular-automaton-Random-number-generator @@ -0,0 +1 @@ +../../Task/Elementary-cellular-automaton-Random-number-generator/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Four-is-magic b/Lang/ALGOL-68/Four-is-magic new file mode 120000 index 0000000000..007db868ed --- /dev/null +++ b/Lang/ALGOL-68/Four-is-magic @@ -0,0 +1 @@ +../../Task/Four-is-magic/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/IBAN b/Lang/ALGOL-68/IBAN new file mode 120000 index 0000000000..08ea01a928 --- /dev/null +++ b/Lang/ALGOL-68/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Jaro-similarity b/Lang/ALGOL-68/Jaro-similarity new file mode 120000 index 0000000000..0255b5f0fa --- /dev/null +++ b/Lang/ALGOL-68/Jaro-similarity @@ -0,0 +1 @@ +../../Task/Jaro-similarity/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Longest-increasing-subsequence b/Lang/ALGOL-68/Longest-increasing-subsequence new file mode 120000 index 0000000000..a09c83eed3 --- /dev/null +++ b/Lang/ALGOL-68/Longest-increasing-subsequence @@ -0,0 +1 @@ +../../Task/Longest-increasing-subsequence/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Partition-function-P b/Lang/ALGOL-68/Partition-function-P new file mode 120000 index 0000000000..98f6538801 --- /dev/null +++ b/Lang/ALGOL-68/Partition-function-P @@ -0,0 +1 @@ +../../Task/Partition-function-P/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Pentagram b/Lang/ALGOL-68/Pentagram new file mode 120000 index 0000000000..7ab101a89e --- /dev/null +++ b/Lang/ALGOL-68/Pentagram @@ -0,0 +1 @@ +../../Task/Pentagram/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-W/Calculating-the-value-of-e b/Lang/ALGOL-W/Calculating-the-value-of-e new file mode 120000 index 0000000000..0bccb15458 --- /dev/null +++ b/Lang/ALGOL-W/Calculating-the-value-of-e @@ -0,0 +1 @@ +../../Task/Calculating-the-value-of-e/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/McNuggets-problem b/Lang/ALGOL-W/McNuggets-problem new file mode 120000 index 0000000000..74213b63b7 --- /dev/null +++ b/Lang/ALGOL-W/McNuggets-problem @@ -0,0 +1 @@ +../../Task/McNuggets-problem/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Square-free-integers b/Lang/ALGOL-W/Square-free-integers new file mode 120000 index 0000000000..c98b8e474a --- /dev/null +++ b/Lang/ALGOL-W/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/ALGOL-W \ No newline at end of file diff --git a/Lang/ANSI-BASIC/Angle-difference-between-two-bearings b/Lang/ANSI-BASIC/Angle-difference-between-two-bearings new file mode 120000 index 0000000000..de48f860b4 --- /dev/null +++ b/Lang/ANSI-BASIC/Angle-difference-between-two-bearings @@ -0,0 +1 @@ +../../Task/Angle-difference-between-two-bearings/ANSI-BASIC \ No newline at end of file diff --git a/Lang/ANSI-BASIC/Leonardo-numbers b/Lang/ANSI-BASIC/Leonardo-numbers new file mode 120000 index 0000000000..eeb51e71aa --- /dev/null +++ b/Lang/ANSI-BASIC/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/ANSI-BASIC \ No newline at end of file diff --git a/Lang/ANSI-BASIC/Luhn-test-of-credit-card-numbers b/Lang/ANSI-BASIC/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..5e8c5fe6dd --- /dev/null +++ b/Lang/ANSI-BASIC/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/ANSI-BASIC \ No newline at end of file diff --git a/Lang/ANSI-BASIC/Nth-root b/Lang/ANSI-BASIC/Nth-root new file mode 120000 index 0000000000..089f4d872e --- /dev/null +++ b/Lang/ANSI-BASIC/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/ANSI-BASIC \ No newline at end of file diff --git a/Lang/ANSI-BASIC/Temperature-conversion b/Lang/ANSI-BASIC/Temperature-conversion new file mode 120000 index 0000000000..af167d778a --- /dev/null +++ b/Lang/ANSI-BASIC/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/ANSI-BASIC \ No newline at end of file diff --git a/Lang/APL/Arithmetic-derivative b/Lang/APL/Arithmetic-derivative new file mode 120000 index 0000000000..c5dd2fd89b --- /dev/null +++ b/Lang/APL/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/APL \ No newline at end of file diff --git a/Lang/ARM-Assembly/Pancake-numbers b/Lang/ARM-Assembly/Pancake-numbers new file mode 120000 index 0000000000..7bcfc9ff51 --- /dev/null +++ b/Lang/ARM-Assembly/Pancake-numbers @@ -0,0 +1 @@ +../../Task/Pancake-numbers/ARM-Assembly \ No newline at end of file diff --git a/Lang/ASIC/Dragon-curve b/Lang/ASIC/Dragon-curve new file mode 120000 index 0000000000..7538c55bbc --- /dev/null +++ b/Lang/ASIC/Dragon-curve @@ -0,0 +1 @@ +../../Task/Dragon-curve/ASIC \ No newline at end of file diff --git a/Lang/ASIC/Luhn-test-of-credit-card-numbers b/Lang/ASIC/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..30c2c72edb --- /dev/null +++ b/Lang/ASIC/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/ASIC \ No newline at end of file diff --git a/Lang/ASIC/Temperature-conversion b/Lang/ASIC/Temperature-conversion new file mode 120000 index 0000000000..312278bfcd --- /dev/null +++ b/Lang/ASIC/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/ASIC \ No newline at end of file diff --git a/Lang/Action-/Arithmetic-derivative b/Lang/Action-/Arithmetic-derivative new file mode 120000 index 0000000000..8206b6a192 --- /dev/null +++ b/Lang/Action-/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/Action- \ No newline at end of file diff --git a/Lang/ActionScript/00-LANG.txt b/Lang/ActionScript/00-LANG.txt index 14a7dc41bf..4fe99ed760 100644 --- a/Lang/ActionScript/00-LANG.txt +++ b/Lang/ActionScript/00-LANG.txt @@ -4,7 +4,8 @@ |strength=strong |safety=safe |checking=static -|LCT=yes}} +|LCT=yes +|tags=actionscript, as}} {{Language programming paradigm|Distributed}} {{Language programming paradigm|Imperative}} diff --git a/Lang/Ada/00-LANG.txt b/Lang/Ada/00-LANG.txt index f17f9738ab..e9eb8d687d 100644 --- a/Lang/Ada/00-LANG.txt +++ b/Lang/Ada/00-LANG.txt @@ -8,7 +8,7 @@ |strength=strong |safety=safe |LCT=yes -|bnf=http://www.adaic.org/standards/1zrm/html/RM-P.html}}'''Ada''' is a structured, statically typed [[imperative programming|imperative]] computer programming language. Ada was initially standardized by [[ANSI]] in 1983 and by [[ISO]] in 1987. This version of the language is commonly known as [[Ada 83]]. The next version was standardized by ISO in 1995 (ISO/IEC 8652:1995) and is commonly known as [[Ada 95]]. Following that ISO published ISO/IEC 8652:1995/Amd 1:2007 in 2007, which is commonly known as [[Ada 2005]]. Most recently ISO published [http://www.ada-auth.org/standards/12rm/html/RM-TTL.html ISO/IEC 8652:2012(E)], commonly known as [[Ada 2012]]. Formally only the most recent version of the language is known as '''Ada'''. +|bnf=http://www.ada-auth.org/standards/22rm/html/RM-P-1.html}}'''Ada''' is a structured, statically typed [[imperative programming|imperative]] computer programming language. Ada was initially standardized by [[ANSI]] in 1983 and by [[ISO]] in 1987. This version of the language is commonly known as [[Ada 83]]. The next version was standardized by ISO in 1995 (ISO/IEC 8652:1995) and is commonly known as [[Ada 95]]. Following that ISO published ISO/IEC 8652:1995/Amd 1:2007 in 2007, which is commonly known as [[Ada 2005]]. Afterwards they published ISO/IEC 8652:2012(E), also known as [[Ada 2012]]. Most recently ISO published [http://www.ada-auth.org/standards/22rm/html/RM-TTL.html ISO/IEC 8652:2023], commonly known as [[Ada 2022]]. Formally only the most recent version of the language is known as '''Ada'''. The language is named after [[wp:Ada_Lovelace|Augusta Ada King, Countess of Lovelace]] thought to be the first ever programmer. Initially it was designed for [http://www.defense.gov U.S. Department of Defense]. The language is used for large and mission-critical systems. See [[wp:Ada_(programming_language)|also]]. ==Grammar== diff --git a/Lang/Ada/Arithmetic-derivative b/Lang/Ada/Arithmetic-derivative new file mode 120000 index 0000000000..87dd4d6940 --- /dev/null +++ b/Lang/Ada/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/Ada \ No newline at end of file diff --git a/Lang/Ada/Blum-integer b/Lang/Ada/Blum-integer new file mode 120000 index 0000000000..48b2715109 --- /dev/null +++ b/Lang/Ada/Blum-integer @@ -0,0 +1 @@ +../../Task/Blum-integer/Ada \ No newline at end of file diff --git a/Lang/Ada/Chaos-game b/Lang/Ada/Chaos-game new file mode 120000 index 0000000000..456fd72f97 --- /dev/null +++ b/Lang/Ada/Chaos-game @@ -0,0 +1 @@ +../../Task/Chaos-game/Ada \ No newline at end of file diff --git a/Lang/Ada/Lah-numbers b/Lang/Ada/Lah-numbers new file mode 120000 index 0000000000..e4f08d947d --- /dev/null +++ b/Lang/Ada/Lah-numbers @@ -0,0 +1 @@ +../../Task/Lah-numbers/Ada \ No newline at end of file diff --git a/Lang/Ada/Left-factorials b/Lang/Ada/Left-factorials new file mode 120000 index 0000000000..8c62b38a57 --- /dev/null +++ b/Lang/Ada/Left-factorials @@ -0,0 +1 @@ +../../Task/Left-factorials/Ada \ No newline at end of file diff --git a/Lang/Ada/Sierpinski-pentagon b/Lang/Ada/Sierpinski-pentagon new file mode 120000 index 0000000000..d3c2f495a7 --- /dev/null +++ b/Lang/Ada/Sierpinski-pentagon @@ -0,0 +1 @@ +../../Task/Sierpinski-pentagon/Ada \ No newline at end of file diff --git a/Lang/Ada/Smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k b/Lang/Ada/Smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k new file mode 120000 index 0000000000..acb5a83713 --- /dev/null +++ b/Lang/Ada/Smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k @@ -0,0 +1 @@ +../../Task/Smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k/Ada \ No newline at end of file diff --git a/Lang/AmigaBASIC/Chaos-game b/Lang/AmigaBASIC/Chaos-game new file mode 120000 index 0000000000..06fb31b581 --- /dev/null +++ b/Lang/AmigaBASIC/Chaos-game @@ -0,0 +1 @@ +../../Task/Chaos-game/AmigaBASIC \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/00-LANG.txt b/Lang/Applesoft-BASIC/00-LANG.txt index b47ab777d1..854387033b 100644 --- a/Lang/Applesoft-BASIC/00-LANG.txt +++ b/Lang/Applesoft-BASIC/00-LANG.txt @@ -7,4 +7,5 @@ * [[wp:Applesoft BASIC|Wikipedia: Applesoft BASIC]] * [http://www.landsnail.com/a2ref.htm Apple II Programmer's Reference] from ][ In a Mac, via [http://www.landsnail.com/ Landsnail.com] * [http://www.hoist-point.com/applesoft_basic_tutorial.htm AppleSoft BASIC tutorial for absolute beginners] +* [https://www.calormen.com/jsbasic/ Applesoft BASIC in Javascript] On-line interpreter * ''[[Tasks not implemented in Applesoft BASIC|Tasks not implemented in Applesoft BASIC]]'' \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Dragon-curve b/Lang/Applesoft-BASIC/Dragon-curve new file mode 120000 index 0000000000..89a81bf5e7 --- /dev/null +++ b/Lang/Applesoft-BASIC/Dragon-curve @@ -0,0 +1 @@ +../../Task/Dragon-curve/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Aquarius-BASIC/00-LANG.txt b/Lang/Aquarius-BASIC/00-LANG.txt index 787837afb3..1314ae0882 100644 --- a/Lang/Aquarius-BASIC/00-LANG.txt +++ b/Lang/Aquarius-BASIC/00-LANG.txt @@ -2,4 +2,37 @@ |exec=interpreted |tags=basic,aquariusbasic }} -{{Implementation|BASIC}}'''Aquarius BASIC''' refers to the more or less stripped-down releases of Microsoft BASIC for the Mattel/Radofin Aquarius. The built-in ROM BASIC was seriously restricted since the system only included 4K of RAM and 8K of ROM by default. Minus the RAM used for video and system management, only about 1.7K or RAM were usable by default; the optionally available Extended Microsoft BASIC that came on ROM cartridge was somewhat more generous, and RAM expansion cartridges were available. \ No newline at end of file +{{Implementation|BASIC}}'''Aquarius BASIC''' refers to the more or less stripped-down releases of Microsoft BASIC for the Mattel/Radofin Aquarius, a home computer released in 1983. + +The built-in ROM BASIC was seriously restricted since the system only included 4K of RAM and 8K of ROM by default. Minus the RAM used for video and system management, only about 1.7K of RAM were usable by default; the optionally available Extended Microsoft BASIC that came on ROM cartridge was somewhat more generous, and RAM expansion cartridges were available. + +BASIC lines can be a maximum of 72 characters long. Only the first two characters of a variable name are significant, so e.g. ABC and ABBA will contain the same value: + +10 ABC=3 +20 ABBA=5 +30 PRINT ABC;ABBA +RUN + 5 5 + +The Aquarius features a text-mode screen of 40x25 characters with 16 colors. BASIC only uses 38x24 characters, i.e. the row at the top and the two outermost columns on each side are not accessible when editing, PRINTing, or LISTing. However, all 40x25 characters can be modified via POKEs from BASIC to screen memory. + +Screen character memory starts at 0x3000 (12288); color RAM (with high nibble = foreground color; low nibble = background color) starts at 0x3400 (12288 + 1024 = 13312). Border color can be set by POKEing to the top left character, e.g. POKE 13312,7 will turn the border color to white. BASIC programs start at 0x3901.[https://www.vdsteenoven.com/aquarius/malloc.html] + +BASIC can set and unset 80x72-resolution pixels on the Aquarius with the PSET and PRESET commands (each text character consists of 2x3 pixels). This program for instance draws an ellipsis: +10 PRINT CHR$(11); +20 PI=3.141593 : R=30 +30 FOR I=0 TO 360 +40 X=R*SIN(I*PI/180) +50 Y=R*COS(I*PI/180) +60 PSET(39+X,35+Y) +70 NEXT + +The Aquarius character set cannot be redefined. + +By default, the total space for string variables is only 50 bytes! This can be increased with CLEAR, e.g. CLEAR 200 will reserve 200 bytes for strings. You can check with PRINT FRE("a") how much unused string space is still available. + +Emulators of the Mattel Aquarius include MAME and [https://aquarius.je/aqualite/ AquaLite]. + +==See Also== +* [[wp:Mattel Aquarius|Mattel Aquarius]] at Wikipedia +* [https://archive.org/search?query=mattel+aquarius Aquarius manuals at the Internet Archive] \ No newline at end of file diff --git a/Lang/Aquarius-BASIC/Archimedean-spiral b/Lang/Aquarius-BASIC/Archimedean-spiral new file mode 120000 index 0000000000..a52a300e36 --- /dev/null +++ b/Lang/Aquarius-BASIC/Archimedean-spiral @@ -0,0 +1 @@ +../../Task/Archimedean-spiral/Aquarius-BASIC \ No newline at end of file diff --git a/Lang/Aquarius-BASIC/Colour-bars-Display b/Lang/Aquarius-BASIC/Colour-bars-Display new file mode 120000 index 0000000000..5113e0e205 --- /dev/null +++ b/Lang/Aquarius-BASIC/Colour-bars-Display @@ -0,0 +1 @@ +../../Task/Colour-bars-Display/Aquarius-BASIC \ No newline at end of file diff --git a/Lang/Aquarius-BASIC/Mandelbrot-set b/Lang/Aquarius-BASIC/Mandelbrot-set new file mode 120000 index 0000000000..e078ca10a9 --- /dev/null +++ b/Lang/Aquarius-BASIC/Mandelbrot-set @@ -0,0 +1 @@ +../../Task/Mandelbrot-set/Aquarius-BASIC \ No newline at end of file diff --git a/Lang/Aquarius-BASIC/Matrix-digital-rain b/Lang/Aquarius-BASIC/Matrix-digital-rain new file mode 120000 index 0000000000..227ab761a1 --- /dev/null +++ b/Lang/Aquarius-BASIC/Matrix-digital-rain @@ -0,0 +1 @@ +../../Task/Matrix-digital-rain/Aquarius-BASIC \ No newline at end of file diff --git a/Lang/Aquarius-BASIC/Musical-scale b/Lang/Aquarius-BASIC/Musical-scale new file mode 120000 index 0000000000..16fb0326f5 --- /dev/null +++ b/Lang/Aquarius-BASIC/Musical-scale @@ -0,0 +1 @@ +../../Task/Musical-scale/Aquarius-BASIC \ No newline at end of file diff --git a/Lang/Aquarius-BASIC/Terminal-control-Display-an-extended-character b/Lang/Aquarius-BASIC/Terminal-control-Display-an-extended-character new file mode 120000 index 0000000000..908e3614b8 --- /dev/null +++ b/Lang/Aquarius-BASIC/Terminal-control-Display-an-extended-character @@ -0,0 +1 @@ +../../Task/Terminal-control-Display-an-extended-character/Aquarius-BASIC \ No newline at end of file diff --git a/Lang/Arturo/00-LANG.txt b/Lang/Arturo/00-LANG.txt index e01d1ab72c..7424af10da 100644 --- a/Lang/Arturo/00-LANG.txt +++ b/Lang/Arturo/00-LANG.txt @@ -16,8 +16,8 @@ The language has been designed following some very simple and straightforward pr factorial: function [n][ - if? n > 0 -> n * factorial n-1 - else -> 1 + switch n > 0 -> n * factorial n-1 + -> 1 ] loop 1..19 [x]-> diff --git a/Lang/Arturo/Abstract-type b/Lang/Arturo/Abstract-type new file mode 120000 index 0000000000..d0cab7a251 --- /dev/null +++ b/Lang/Arturo/Abstract-type @@ -0,0 +1 @@ +../../Task/Abstract-type/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Bitmap-Bresenhams-line-algorithm b/Lang/Arturo/Bitmap-Bresenhams-line-algorithm new file mode 120000 index 0000000000..903f7d1b02 --- /dev/null +++ b/Lang/Arturo/Bitmap-Bresenhams-line-algorithm @@ -0,0 +1 @@ +../../Task/Bitmap-Bresenhams-line-algorithm/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Inheritance-Single b/Lang/Arturo/Inheritance-Single new file mode 120000 index 0000000000..9ea196311d --- /dev/null +++ b/Lang/Arturo/Inheritance-Single @@ -0,0 +1 @@ +../../Task/Inheritance-Single/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Number-names b/Lang/Arturo/Number-names new file mode 120000 index 0000000000..0265b7a150 --- /dev/null +++ b/Lang/Arturo/Number-names @@ -0,0 +1 @@ +../../Task/Number-names/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Radical-of-an-integer b/Lang/Arturo/Radical-of-an-integer new file mode 120000 index 0000000000..0b80f4a924 --- /dev/null +++ b/Lang/Arturo/Radical-of-an-integer @@ -0,0 +1 @@ +../../Task/Radical-of-an-integer/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Reflection-List-methods b/Lang/Arturo/Reflection-List-methods new file mode 120000 index 0000000000..b2c29c2e7a --- /dev/null +++ b/Lang/Arturo/Reflection-List-methods @@ -0,0 +1 @@ +../../Task/Reflection-List-methods/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Rosetta-Code-Find-unimplemented-tasks b/Lang/Arturo/Rosetta-Code-Find-unimplemented-tasks new file mode 120000 index 0000000000..6c58da52bd --- /dev/null +++ b/Lang/Arturo/Rosetta-Code-Find-unimplemented-tasks @@ -0,0 +1 @@ +../../Task/Rosetta-Code-Find-unimplemented-tasks/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Spelling-of-ordinal-numbers b/Lang/Arturo/Spelling-of-ordinal-numbers new file mode 120000 index 0000000000..0d47ac2434 --- /dev/null +++ b/Lang/Arturo/Spelling-of-ordinal-numbers @@ -0,0 +1 @@ +../../Task/Spelling-of-ordinal-numbers/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Taxicab-numbers b/Lang/Arturo/Taxicab-numbers new file mode 120000 index 0000000000..9c84413e59 --- /dev/null +++ b/Lang/Arturo/Taxicab-numbers @@ -0,0 +1 @@ +../../Task/Taxicab-numbers/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Weird-numbers b/Lang/Arturo/Weird-numbers new file mode 120000 index 0000000000..2f062bea69 --- /dev/null +++ b/Lang/Arturo/Weird-numbers @@ -0,0 +1 @@ +../../Task/Weird-numbers/Arturo \ No newline at end of file diff --git a/Lang/Arturo/Zumkeller-numbers b/Lang/Arturo/Zumkeller-numbers new file mode 120000 index 0000000000..b956d7f399 --- /dev/null +++ b/Lang/Arturo/Zumkeller-numbers @@ -0,0 +1 @@ +../../Task/Zumkeller-numbers/Arturo \ No newline at end of file diff --git a/Lang/Atari-BASIC/00-LANG.txt b/Lang/Atari-BASIC/00-LANG.txt index 233d214413..f0ee8029ec 100644 --- a/Lang/Atari-BASIC/00-LANG.txt +++ b/Lang/Atari-BASIC/00-LANG.txt @@ -3,6 +3,23 @@ |tags=basic,ataribasic }} {{Implementation|BASIC}} -'''Atari BASIC''' refers to the BASIC that shipped with Atari 8-bit micros. +'''Atari BASIC''' refers to the BASIC that shipped with Atari 8-bit micros. Revision A was released on cartridge for early models like the Atari 400 and 800 (1979), while revision B was included in ROM on later models such as the 800XL (1983). (Revision A is considered superior because revision B has more bugs!) Revision C was released on cartridge to address the bugs introduced in revision B. It was also in ROM on later 800XL computers and the XE range. -See Wikipedia: https://en.wikipedia.org/wiki/Atari_BASIC \ No newline at end of file +Emulators for Atari 8-bit computers include: +*[https://atari800.github.io/ Atari800] (Windows, Mac, Linux, etc.) +*[https://www.virtualdub.org/altirra.html Altirra] (Windows) + +Downloading the original Atari ROMs is not necessary for Atari800 or Altirra because they include the open source Altirra ROMs, which also feature Altirra BASIC, a fully compatible replacement for Atari BASIC. Altirra BASIC and OS are also better optimized than the original Atari ROMs; especially FOR loops and floating point functions are much quicker. + +To start Atari800 in BASIC mode, run it as atari800 -basic. Some important keys in Atari800 are F1=Settings, F5=Reset, F7=Break, F9=Quit, F10=Screenshot; see [https://github.com/atari800/atari800/blob/master/DOC/USAGE DOC/USAGE] for more. Lowercase characters in strings can be entered by first pressing Caps Lock in Atari800. + +In Atari800, folders on the host computer can be mounted in ''Emulator Configuration ⇨ Host Device Settings'', so then you can e.g. use LOAD "H1:MYPROG.BAS" to load a program from local disk. By default, folders are mounted read-only. + +BASIC programs in tokenized form are loaded and saved with LOAD and SAVE; in ASCII/ATASCII format you load them with ENTER and save them with LIST, e.g. LIST “H1:PROGRAM.LST”. + +After 9 minutes of inactivity, a screen saver (called attract mode by Atari) will activate and cycle colors. This can be stopped by an occasional POKE 77,0 to reset the timer. + +Like in Palo Alto Tiny BASIC, commands can be abbreviated by their first (unique) letters and a period, e.g. L. for LIST or GR. for GRAPHICS. + +==See Also== +*[https://en.wikipedia.org/wiki/Atari_BASIC Atari BASIC] in Wikipedia \ No newline at end of file diff --git a/Lang/Atari-BASIC/Archimedean-spiral b/Lang/Atari-BASIC/Archimedean-spiral new file mode 120000 index 0000000000..3e75563330 --- /dev/null +++ b/Lang/Atari-BASIC/Archimedean-spiral @@ -0,0 +1 @@ +../../Task/Archimedean-spiral/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Chaos-game b/Lang/Atari-BASIC/Chaos-game new file mode 120000 index 0000000000..f88e0f8ada --- /dev/null +++ b/Lang/Atari-BASIC/Chaos-game @@ -0,0 +1 @@ +../../Task/Chaos-game/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Color-of-a-screen-pixel b/Lang/Atari-BASIC/Color-of-a-screen-pixel new file mode 120000 index 0000000000..b097621245 --- /dev/null +++ b/Lang/Atari-BASIC/Color-of-a-screen-pixel @@ -0,0 +1 @@ +../../Task/Color-of-a-screen-pixel/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Colour-bars-Display b/Lang/Atari-BASIC/Colour-bars-Display new file mode 120000 index 0000000000..03db8dce96 --- /dev/null +++ b/Lang/Atari-BASIC/Colour-bars-Display @@ -0,0 +1 @@ +../../Task/Colour-bars-Display/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Draw-a-clock b/Lang/Atari-BASIC/Draw-a-clock new file mode 120000 index 0000000000..f8dd467da4 --- /dev/null +++ b/Lang/Atari-BASIC/Draw-a-clock @@ -0,0 +1 @@ +../../Task/Draw-a-clock/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Mandelbrot-set b/Lang/Atari-BASIC/Mandelbrot-set new file mode 120000 index 0000000000..45e66ccff0 --- /dev/null +++ b/Lang/Atari-BASIC/Mandelbrot-set @@ -0,0 +1 @@ +../../Task/Mandelbrot-set/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Musical-scale b/Lang/Atari-BASIC/Musical-scale new file mode 120000 index 0000000000..b870e25059 --- /dev/null +++ b/Lang/Atari-BASIC/Musical-scale @@ -0,0 +1 @@ +../../Task/Musical-scale/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Random-number-generator-device- b/Lang/Atari-BASIC/Random-number-generator-device- new file mode 120000 index 0000000000..bc35b665ee --- /dev/null +++ b/Lang/Atari-BASIC/Random-number-generator-device- @@ -0,0 +1 @@ +../../Task/Random-number-generator-device-/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Reverse-a-string b/Lang/Atari-BASIC/Reverse-a-string new file mode 120000 index 0000000000..c2ff7e214b --- /dev/null +++ b/Lang/Atari-BASIC/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/System-time b/Lang/Atari-BASIC/System-time new file mode 120000 index 0000000000..c4df1e6a39 --- /dev/null +++ b/Lang/Atari-BASIC/System-time @@ -0,0 +1 @@ +../../Task/System-time/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Terminal-control-Hiding-the-cursor b/Lang/Atari-BASIC/Terminal-control-Hiding-the-cursor new file mode 120000 index 0000000000..78972a34b6 --- /dev/null +++ b/Lang/Atari-BASIC/Terminal-control-Hiding-the-cursor @@ -0,0 +1 @@ +../../Task/Terminal-control-Hiding-the-cursor/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Terminal-control-Inverse-video b/Lang/Atari-BASIC/Terminal-control-Inverse-video new file mode 120000 index 0000000000..8c57f75946 --- /dev/null +++ b/Lang/Atari-BASIC/Terminal-control-Inverse-video @@ -0,0 +1 @@ +../../Task/Terminal-control-Inverse-video/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Terminal-control-Positional-read b/Lang/Atari-BASIC/Terminal-control-Positional-read new file mode 120000 index 0000000000..a0575b2278 --- /dev/null +++ b/Lang/Atari-BASIC/Terminal-control-Positional-read @@ -0,0 +1 @@ +../../Task/Terminal-control-Positional-read/Atari-BASIC \ No newline at end of file diff --git a/Lang/Atari-BASIC/Terminal-control-Ringing-the-terminal-bell b/Lang/Atari-BASIC/Terminal-control-Ringing-the-terminal-bell new file mode 120000 index 0000000000..3666cabb9e --- /dev/null +++ b/Lang/Atari-BASIC/Terminal-control-Ringing-the-terminal-bell @@ -0,0 +1 @@ +../../Task/Terminal-control-Ringing-the-terminal-bell/Atari-BASIC \ No newline at end of file diff --git a/Lang/AutoHotKey-V2/00-LANG.txt b/Lang/AutoHotKey-V2/00-LANG.txt deleted file mode 100644 index a333f928af..0000000000 --- a/Lang/AutoHotKey-V2/00-LANG.txt +++ /dev/null @@ -1 +0,0 @@ -{{stub}}{{language|AutoHotKey V2}} \ No newline at end of file diff --git a/Lang/AutoHotKey-V2/00-META.yaml b/Lang/AutoHotKey-V2/00-META.yaml deleted file mode 100644 index 316ebe0ccb..0000000000 --- a/Lang/AutoHotKey-V2/00-META.yaml +++ /dev/null @@ -1,2 +0,0 @@ ---- -from: http://rosettacode.org/wiki/Category:AutoHotKey_V2 diff --git a/Lang/AutoHotKey-V2/Hello-world-Graphical b/Lang/AutoHotKey-V2/Hello-world-Graphical deleted file mode 120000 index 89783bc714..0000000000 --- a/Lang/AutoHotKey-V2/Hello-world-Graphical +++ /dev/null @@ -1 +0,0 @@ -../../Task/Hello-world-Graphical/AutoHotKey-V2 \ No newline at end of file diff --git a/Lang/Autohotkey-V2/00-LANG.txt b/Lang/Autohotkey-V2/00-LANG.txt new file mode 100644 index 0000000000..b3e33b65ab --- /dev/null +++ b/Lang/Autohotkey-V2/00-LANG.txt @@ -0,0 +1,16 @@ +{{stub}}AutoHotkey V2 is an [[open source]] programming language for Microsoft [[Windows]]. + +AutoHotkey v2 is a major update to the AutoHotkey language, which includes numerous new features and improvements. + +== Citations == + +* [https://www.autohotkey.com/docs/v2/ Documentation] +* [http://autohotkey.com/download Downloads] +* [http://autohotkey.com/docs/scripts/ Script Showcase] +* [http://autohotkey.com/boards/ New Community forum] +* [http://www.autohotkey.com/forum/ Archived Community forum] +* [http://ahkscript.org/foundation AutoHotkey Foundation LLC] +* [[wp:AutoHotkey|AutoHotkey on Wikipedia]] +* #ahk on [http://webchat.freenode.net/?channels=%23ahk Freenode Web interface] +* [[:Category:AutoHotkey_Originated]] +{{language|Ayrch}} \ No newline at end of file diff --git a/Lang/Autohotkey-V2/00-META.yaml b/Lang/Autohotkey-V2/00-META.yaml new file mode 100644 index 0000000000..651d1bc21b --- /dev/null +++ b/Lang/Autohotkey-V2/00-META.yaml @@ -0,0 +1,2 @@ +--- +from: http://rosettacode.org/wiki/Category:Autohotkey_V2 diff --git a/Lang/Autohotkey-V2/Hello-world-Graphical b/Lang/Autohotkey-V2/Hello-world-Graphical new file mode 120000 index 0000000000..0375a8eeb7 --- /dev/null +++ b/Lang/Autohotkey-V2/Hello-world-Graphical @@ -0,0 +1 @@ +../../Task/Hello-world-Graphical/Autohotkey-V2 \ No newline at end of file diff --git a/Lang/BASIC/00-LANG.txt b/Lang/BASIC/00-LANG.txt index 745f847ac8..ddee550d0d 100644 --- a/Lang/BASIC/00-LANG.txt +++ b/Lang/BASIC/00-LANG.txt @@ -37,6 +37,7 @@ BASIC became popular, with many different implementations for various computers. ***[[wp:Applesoft BASIC]] ***[[wp:Atari Microsoft BASIC]] ***[[wp:Commodore BASIC]] +***[[wp:Extended Color BASIC]] ***[[wp:IBM BASIC]] ***[[wp:MS BASIC for Macintosh]] ***[[wp:MSX BASIC]] diff --git a/Lang/BASIC/Arithmetic-derivative b/Lang/BASIC/Arithmetic-derivative new file mode 120000 index 0000000000..25cf9a8b6a --- /dev/null +++ b/Lang/BASIC/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/BASIC \ No newline at end of file diff --git a/Lang/BASIC/Temperature-conversion b/Lang/BASIC/Temperature-conversion deleted file mode 120000 index 21182b0539..0000000000 --- a/Lang/BASIC/Temperature-conversion +++ /dev/null @@ -1 +0,0 @@ -../../Task/Temperature-conversion/BASIC \ No newline at end of file diff --git a/Lang/BQN/Bell-numbers b/Lang/BQN/Bell-numbers new file mode 120000 index 0000000000..2c520a34e3 --- /dev/null +++ b/Lang/BQN/Bell-numbers @@ -0,0 +1 @@ +../../Task/Bell-numbers/BQN \ No newline at end of file diff --git a/Lang/BQN/Call-an-object-method b/Lang/BQN/Call-an-object-method new file mode 120000 index 0000000000..eb9e8d9920 --- /dev/null +++ b/Lang/BQN/Call-an-object-method @@ -0,0 +1 @@ +../../Task/Call-an-object-method/BQN \ No newline at end of file diff --git a/Lang/BQN/I-before-E-except-after-C b/Lang/BQN/I-before-E-except-after-C new file mode 120000 index 0000000000..5fd82fbd92 --- /dev/null +++ b/Lang/BQN/I-before-E-except-after-C @@ -0,0 +1 @@ +../../Task/I-before-E-except-after-C/BQN \ No newline at end of file diff --git a/Lang/Basic09/00-LANG.txt b/Lang/Basic09/00-LANG.txt index 16853881ce..fa600ca16b 100644 --- a/Lang/Basic09/00-LANG.txt +++ b/Lang/Basic09/00-LANG.txt @@ -1 +1,3 @@ -{{language|Basic09}}Basic09 is a dialect of BASIC created by Microware Systems Corporation in 1978 for use on the OS-9 operating system designed for the Motorola 6809 microporcessor. There is a version for OS-9/68000, "Microware BASIC", identical save that the INTEGER type is a four-byte signed integer instead of two-byte and REAL is IEEE 754 double precision rather than the five-byte format in the original version. \ No newline at end of file +{{language|Basic09}} +{{implementation|BASIC}} +Basic09 is a dialect of BASIC created by Microware Systems Corporation in 1978 for use on the OS-9 operating system designed for the Motorola 6809 microporcessor. There is a version for OS-9/68000, "Microware BASIC", identical save that the INTEGER type is a four-byte signed integer instead of two-byte and REAL is IEEE 754 double precision rather than the five-byte format in the original version. \ No newline at end of file diff --git a/Lang/Blade/00-LANG.txt b/Lang/Blade/00-LANG.txt index f18c210bc3..71d6c9cdba 100644 --- a/Lang/Blade/00-LANG.txt +++ b/Lang/Blade/00-LANG.txt @@ -6,25 +6,13 @@ |parampass=value |LCT=yes}}{{language programming paradigm|Object-oriented}}{{language programming paradigm|functional}} -'''Blade''' is a simple, fast, clean and dynamic language that allows you to develop complex applications quickly. Blade emphasises algorithm over syntax and for this reason, it has a very small but powerful syntax set with a very natural feel. +'''Blade''' is a modern general-purpose programming language focused on enterprise Web, IoT, and secure application development. '''Blade''' offers a comprehensive set of tools and libraries out of the box leading to reduced reliance on third-party packages. -If you’ve ever had experience with a compiled language (e.g. [[C]]/[[C++]], [[Java]], etc), then one thing you’ll quickly notice (at least I did) was how much the whole process of write-compile-run-debug can be tedious and get in the way of creative programming and sometimes you even forget that mind-blowing algorithm you were going to write and take over the world in the whole process of compiling. +'''Blade''' comes equipped with an integrated package management system, simplifying the management of both internal and external dependencies and a self-hostable repository server making it ideal for private organisational and personal use. Its intuitive syntax and gentle learning curve ensure an accessible experience for developers of all skill levels. Leveraging the best features from JavaScript, Python, Ruby, and Dart, '''Blade''' provides a familiar and robust ecosystem that enables developers to harness the strengths of these languages effortlessly. -Sometimes, you just want to automate a few tasks, for example, I have a simple program to always remind me to get away from my laptop and eat something (you know how it is) and yet another one to suggest food for me. Do you find yourself needing this often? Do you know why you haven’t written it? Get out of your head, you are writing a compiled language! Compiling takes longer than the time it will take you to convince yourself that you need to eat. - -At other times, you have written this amazing program and you want users to be able to control it using a simple scripting language. I know… I know… there are many interpreted languages out there that will do the job just fine. Well… you still have one problem. Your users aren’t going to remember all the crazy going on in many of them (Yes [[Lua]]! I’m staring at you. What you gonna do about it?) - -Other times, we kind of find a very good solution to our problem in languages like [[Python]] (I must confess, even '''Blade''' did learn a lot of things from it), but the structure of such languages usually creates a new overhead in writing complex programs. It’s really difficult keeping a tab of indentations in such languages especially when you are not in a GUI IDE environment. I tried to work [[Python]] in nano, but man… it wasn’t easy. - -If you are feeling me, then Blade is just right for you. - -Blade is a simple language that has tried very much to learn from the mistake and successes of its predecessors. - -Blade is interpreted and simple like [[Python]] but with a more generic [[C]]-like syntax and a ridiculously simple Object-orientation similar to [[Dart]] and the granularity of [[JavaScript]] while still maintaining a very minimal syntax and keywords when compared to all of them. - -'''Blade is designed to be a memorizable language and the entire “language” can be learned in one sitting. However, Blade is as complete and powerful as any language can be and can be applied in the field of web, mobile, desktop, scientific, academic and research engineering to mention a few.''' +While '''Blade''' focuses on Web and IoT, it is also great for general software development. ==Links== -* [https://bladelang.com https://bladelang.com] +* [https://bladelang.org https://bladelang.org] * [https://github.com/blade-lang/blade https://github.com/blade-lang/blade] -* [https://bladelang.com/quick-learn.html Quick Language Introduction] \ No newline at end of file +* [https://bladelang.org/quick-learn.html Quick Language Introduction] \ No newline at end of file diff --git a/Lang/C-sharp/Periodic-table b/Lang/C-sharp/Periodic-table new file mode 120000 index 0000000000..97d676b17d --- /dev/null +++ b/Lang/C-sharp/Periodic-table @@ -0,0 +1 @@ +../../Task/Periodic-table/C-sharp \ No newline at end of file diff --git a/Lang/CLU/Arithmetic-derivative b/Lang/CLU/Arithmetic-derivative new file mode 120000 index 0000000000..f0f81c6bc1 --- /dev/null +++ b/Lang/CLU/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/CLU \ No newline at end of file diff --git a/Lang/Chipmunk-Basic/ASCII-art-diagram-converter b/Lang/Chipmunk-Basic/ASCII-art-diagram-converter new file mode 120000 index 0000000000..a034d74b58 --- /dev/null +++ b/Lang/Chipmunk-Basic/ASCII-art-diagram-converter @@ -0,0 +1 @@ +../../Task/ASCII-art-diagram-converter/Chipmunk-Basic \ No newline at end of file diff --git a/Lang/Chipmunk-Basic/Generate-Chess960-starting-position b/Lang/Chipmunk-Basic/Generate-Chess960-starting-position new file mode 120000 index 0000000000..daceb0cf8f --- /dev/null +++ b/Lang/Chipmunk-Basic/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Chipmunk-Basic \ No newline at end of file diff --git a/Lang/Commodore-BASIC/Random-number-generator-device- b/Lang/Commodore-BASIC/Random-number-generator-device- new file mode 120000 index 0000000000..f23b1d0d42 --- /dev/null +++ b/Lang/Commodore-BASIC/Random-number-generator-device- @@ -0,0 +1 @@ +../../Task/Random-number-generator-device-/Commodore-BASIC \ No newline at end of file diff --git a/Lang/Cowgol/Align-columns b/Lang/Cowgol/Align-columns new file mode 120000 index 0000000000..2931644d20 --- /dev/null +++ b/Lang/Cowgol/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Cowgol \ No newline at end of file diff --git a/Lang/Cowgol/Arithmetic-derivative b/Lang/Cowgol/Arithmetic-derivative new file mode 120000 index 0000000000..5d9cc4afd2 --- /dev/null +++ b/Lang/Cowgol/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/Cowgol \ No newline at end of file diff --git a/Lang/Crystal/00-LANG.txt b/Lang/Crystal/00-LANG.txt index b671a267bf..365be4df5f 100644 --- a/Lang/Crystal/00-LANG.txt +++ b/Lang/Crystal/00-LANG.txt @@ -14,4 +14,7 @@ Crystal is a programming language with the following goals: * Have compile-time evaluation and generation of code, to avoid boilerplate code. * Compile to efficient native code. -You can ask for help on Freenode in the #crystal-lang channel. \ No newline at end of file +You can ask for help on LiberaChat in the [ircs://irc.libera.chat:6697#crystal-lang #crystal-lang] channel ([https://web.libera.chat/#crystal-lang web]). + +==Tasks not implemented in Crystal== +[[Tasks not implemented in Crystal]] \ No newline at end of file diff --git a/Lang/Crystal/Abbreviations-automatic b/Lang/Crystal/Abbreviations-automatic new file mode 120000 index 0000000000..356658ce4c --- /dev/null +++ b/Lang/Crystal/Abbreviations-automatic @@ -0,0 +1 @@ +../../Task/Abbreviations-automatic/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Archimedean-spiral b/Lang/Crystal/Archimedean-spiral new file mode 120000 index 0000000000..38cdafc563 --- /dev/null +++ b/Lang/Crystal/Archimedean-spiral @@ -0,0 +1 @@ +../../Task/Archimedean-spiral/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Colour-bars-Display b/Lang/Crystal/Colour-bars-Display new file mode 120000 index 0000000000..0ec7f62738 --- /dev/null +++ b/Lang/Crystal/Colour-bars-Display @@ -0,0 +1 @@ +../../Task/Colour-bars-Display/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Enumerations b/Lang/Crystal/Enumerations new file mode 120000 index 0000000000..81276f7ab4 --- /dev/null +++ b/Lang/Crystal/Enumerations @@ -0,0 +1 @@ +../../Task/Enumerations/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Evolutionary-algorithm b/Lang/Crystal/Evolutionary-algorithm new file mode 120000 index 0000000000..a0bcba6242 --- /dev/null +++ b/Lang/Crystal/Evolutionary-algorithm @@ -0,0 +1 @@ +../../Task/Evolutionary-algorithm/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Letter-frequency b/Lang/Crystal/Letter-frequency new file mode 120000 index 0000000000..9aed428d1c --- /dev/null +++ b/Lang/Crystal/Letter-frequency @@ -0,0 +1 @@ +../../Task/Letter-frequency/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Stem-and-leaf-plot b/Lang/Crystal/Stem-and-leaf-plot new file mode 120000 index 0000000000..4fac378f12 --- /dev/null +++ b/Lang/Crystal/Stem-and-leaf-plot @@ -0,0 +1 @@ +../../Task/Stem-and-leaf-plot/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Sudan-function b/Lang/Crystal/Sudan-function new file mode 120000 index 0000000000..a75bf5defc --- /dev/null +++ b/Lang/Crystal/Sudan-function @@ -0,0 +1 @@ +../../Task/Sudan-function/Crystal \ No newline at end of file diff --git a/Lang/Crystal/Textonyms b/Lang/Crystal/Textonyms new file mode 120000 index 0000000000..e9c8a3c5ec --- /dev/null +++ b/Lang/Crystal/Textonyms @@ -0,0 +1 @@ +../../Task/Textonyms/Crystal \ No newline at end of file diff --git a/Lang/Dart/Character-codes b/Lang/Dart/Character-codes new file mode 120000 index 0000000000..eee070c4f5 --- /dev/null +++ b/Lang/Dart/Character-codes @@ -0,0 +1 @@ +../../Task/Character-codes/Dart \ No newline at end of file diff --git a/Lang/Draco/Align-columns b/Lang/Draco/Align-columns new file mode 120000 index 0000000000..00c426b153 --- /dev/null +++ b/Lang/Draco/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Draco \ No newline at end of file diff --git a/Lang/Draco/Arithmetic-derivative b/Lang/Draco/Arithmetic-derivative new file mode 120000 index 0000000000..b83ffadf85 --- /dev/null +++ b/Lang/Draco/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/Draco \ No newline at end of file diff --git a/Lang/Draco/Doomsday-rule b/Lang/Draco/Doomsday-rule new file mode 120000 index 0000000000..50f248643e --- /dev/null +++ b/Lang/Draco/Doomsday-rule @@ -0,0 +1 @@ +../../Task/Doomsday-rule/Draco \ No newline at end of file diff --git a/Lang/Draco/Horners-rule-for-polynomial-evaluation b/Lang/Draco/Horners-rule-for-polynomial-evaluation new file mode 120000 index 0000000000..3be037b7e6 --- /dev/null +++ b/Lang/Draco/Horners-rule-for-polynomial-evaluation @@ -0,0 +1 @@ +../../Task/Horners-rule-for-polynomial-evaluation/Draco \ No newline at end of file diff --git a/Lang/Draco/Roman-numerals-Encode b/Lang/Draco/Roman-numerals-Encode new file mode 120000 index 0000000000..11eed87fb8 --- /dev/null +++ b/Lang/Draco/Roman-numerals-Encode @@ -0,0 +1 @@ +../../Task/Roman-numerals-Encode/Draco \ No newline at end of file diff --git a/Lang/Draco/Tokenize-a-string b/Lang/Draco/Tokenize-a-string new file mode 120000 index 0000000000..b60ddd21df --- /dev/null +++ b/Lang/Draco/Tokenize-a-string @@ -0,0 +1 @@ +../../Task/Tokenize-a-string/Draco \ No newline at end of file diff --git a/Lang/EDSAC-order-code/Shoelace-formula-for-polygonal-area b/Lang/EDSAC-order-code/Shoelace-formula-for-polygonal-area new file mode 120000 index 0000000000..fb3446e1bf --- /dev/null +++ b/Lang/EDSAC-order-code/Shoelace-formula-for-polygonal-area @@ -0,0 +1 @@ +../../Task/Shoelace-formula-for-polygonal-area/EDSAC-order-code \ No newline at end of file diff --git a/Lang/EMal/Delegates b/Lang/EMal/Delegates new file mode 120000 index 0000000000..5293d68109 --- /dev/null +++ b/Lang/EMal/Delegates @@ -0,0 +1 @@ +../../Task/Delegates/EMal \ No newline at end of file diff --git a/Lang/EMal/Gamma-function b/Lang/EMal/Gamma-function new file mode 120000 index 0000000000..f928139952 --- /dev/null +++ b/Lang/EMal/Gamma-function @@ -0,0 +1 @@ +../../Task/Gamma-function/EMal \ No newline at end of file diff --git a/Lang/EMal/Guess-the-number b/Lang/EMal/Guess-the-number new file mode 120000 index 0000000000..fc6e3366e6 --- /dev/null +++ b/Lang/EMal/Guess-the-number @@ -0,0 +1 @@ +../../Task/Guess-the-number/EMal \ No newline at end of file diff --git a/Lang/EMal/Sudan-function b/Lang/EMal/Sudan-function new file mode 120000 index 0000000000..ea87f1432e --- /dev/null +++ b/Lang/EMal/Sudan-function @@ -0,0 +1 @@ +../../Task/Sudan-function/EMal \ No newline at end of file diff --git a/Lang/EMal/Ternary-logic b/Lang/EMal/Ternary-logic new file mode 120000 index 0000000000..837bedfab5 --- /dev/null +++ b/Lang/EMal/Ternary-logic @@ -0,0 +1 @@ +../../Task/Ternary-logic/EMal \ No newline at end of file diff --git a/Lang/EasyLang/Bitmap-B-zier-curves-Quadratic b/Lang/EasyLang/Bitmap-B-zier-curves-Quadratic new file mode 120000 index 0000000000..569a661356 --- /dev/null +++ b/Lang/EasyLang/Bitmap-B-zier-curves-Quadratic @@ -0,0 +1 @@ +../../Task/Bitmap-B-zier-curves-Quadratic/EasyLang \ No newline at end of file diff --git a/Lang/EasyLang/Fractran b/Lang/EasyLang/Fractran new file mode 120000 index 0000000000..431453ab79 --- /dev/null +++ b/Lang/EasyLang/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/EasyLang \ No newline at end of file diff --git a/Lang/EasyLang/Modified-random-distribution b/Lang/EasyLang/Modified-random-distribution new file mode 120000 index 0000000000..127bc0bcb6 --- /dev/null +++ b/Lang/EasyLang/Modified-random-distribution @@ -0,0 +1 @@ +../../Task/Modified-random-distribution/EasyLang \ No newline at end of file diff --git a/Lang/EasyLang/Sort-an-outline-at-every-level b/Lang/EasyLang/Sort-an-outline-at-every-level new file mode 120000 index 0000000000..aa549fd59a --- /dev/null +++ b/Lang/EasyLang/Sort-an-outline-at-every-level @@ -0,0 +1 @@ +../../Task/Sort-an-outline-at-every-level/EasyLang \ No newline at end of file diff --git a/Lang/EasyLang/Square-free-integers b/Lang/EasyLang/Square-free-integers new file mode 120000 index 0000000000..07046cee4c --- /dev/null +++ b/Lang/EasyLang/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/EasyLang \ No newline at end of file diff --git a/Lang/EasyLang/URL-encoding b/Lang/EasyLang/URL-encoding new file mode 120000 index 0000000000..c0b065b1e5 --- /dev/null +++ b/Lang/EasyLang/URL-encoding @@ -0,0 +1 @@ +../../Task/URL-encoding/EasyLang \ No newline at end of file diff --git a/Lang/EasyLang/Universal-Turing-machine b/Lang/EasyLang/Universal-Turing-machine new file mode 120000 index 0000000000..c6c36c7e83 --- /dev/null +++ b/Lang/EasyLang/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/EasyLang \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Align-columns b/Lang/Emacs-Lisp/Align-columns new file mode 120000 index 0000000000..9be61160c6 --- /dev/null +++ b/Lang/Emacs-Lisp/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Emacs-Lisp \ No newline at end of file diff --git a/Lang/F-Sharp/Probabilistic-choice b/Lang/F-Sharp/Probabilistic-choice new file mode 120000 index 0000000000..b7d2692fe4 --- /dev/null +++ b/Lang/F-Sharp/Probabilistic-choice @@ -0,0 +1 @@ +../../Task/Probabilistic-choice/F-Sharp \ No newline at end of file diff --git a/Lang/Forth/Bell-numbers b/Lang/Forth/Bell-numbers new file mode 120000 index 0000000000..d0f973798a --- /dev/null +++ b/Lang/Forth/Bell-numbers @@ -0,0 +1 @@ +../../Task/Bell-numbers/Forth \ No newline at end of file diff --git a/Lang/Forth/Deceptive-numbers b/Lang/Forth/Deceptive-numbers new file mode 120000 index 0000000000..68978661e4 --- /dev/null +++ b/Lang/Forth/Deceptive-numbers @@ -0,0 +1 @@ +../../Task/Deceptive-numbers/Forth \ No newline at end of file diff --git a/Lang/Forth/Duffinian-numbers b/Lang/Forth/Duffinian-numbers new file mode 120000 index 0000000000..9a7e28500f --- /dev/null +++ b/Lang/Forth/Duffinian-numbers @@ -0,0 +1 @@ +../../Task/Duffinian-numbers/Forth \ No newline at end of file diff --git a/Lang/Forth/Fibonacci-word b/Lang/Forth/Fibonacci-word new file mode 120000 index 0000000000..b5b4488597 --- /dev/null +++ b/Lang/Forth/Fibonacci-word @@ -0,0 +1 @@ +../../Task/Fibonacci-word/Forth \ No newline at end of file diff --git a/Lang/Forth/GUI-component-interaction b/Lang/Forth/GUI-component-interaction new file mode 120000 index 0000000000..6ac944b586 --- /dev/null +++ b/Lang/Forth/GUI-component-interaction @@ -0,0 +1 @@ +../../Task/GUI-component-interaction/Forth \ No newline at end of file diff --git a/Lang/Forth/Lah-numbers b/Lang/Forth/Lah-numbers new file mode 120000 index 0000000000..63faba81d9 --- /dev/null +++ b/Lang/Forth/Lah-numbers @@ -0,0 +1 @@ +../../Task/Lah-numbers/Forth \ No newline at end of file diff --git a/Lang/Forth/Leonardo-numbers b/Lang/Forth/Leonardo-numbers new file mode 120000 index 0000000000..5742a06693 --- /dev/null +++ b/Lang/Forth/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/Forth \ No newline at end of file diff --git a/Lang/Forth/M-bius-function b/Lang/Forth/M-bius-function new file mode 120000 index 0000000000..02d70b9302 --- /dev/null +++ b/Lang/Forth/M-bius-function @@ -0,0 +1 @@ +../../Task/M-bius-function/Forth \ No newline at end of file diff --git a/Lang/Forth/Sorting-algorithms-Pancake-sort b/Lang/Forth/Sorting-algorithms-Pancake-sort new file mode 120000 index 0000000000..84e38b0321 --- /dev/null +++ b/Lang/Forth/Sorting-algorithms-Pancake-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Pancake-sort/Forth \ No newline at end of file diff --git a/Lang/Forth/Stirling-numbers-of-the-first-kind b/Lang/Forth/Stirling-numbers-of-the-first-kind new file mode 120000 index 0000000000..f35ec2aaf5 --- /dev/null +++ b/Lang/Forth/Stirling-numbers-of-the-first-kind @@ -0,0 +1 @@ +../../Task/Stirling-numbers-of-the-first-kind/Forth \ No newline at end of file diff --git a/Lang/Forth/Stirling-numbers-of-the-second-kind b/Lang/Forth/Stirling-numbers-of-the-second-kind new file mode 120000 index 0000000000..a86eb5dfc1 --- /dev/null +++ b/Lang/Forth/Stirling-numbers-of-the-second-kind @@ -0,0 +1 @@ +../../Task/Stirling-numbers-of-the-second-kind/Forth \ No newline at end of file diff --git a/Lang/Forth/Twin-primes b/Lang/Forth/Twin-primes new file mode 120000 index 0000000000..7812aac04a --- /dev/null +++ b/Lang/Forth/Twin-primes @@ -0,0 +1 @@ +../../Task/Twin-primes/Forth \ No newline at end of file diff --git a/Lang/Fortran/Additive-primes b/Lang/Fortran/Additive-primes new file mode 120000 index 0000000000..ea531b1d68 --- /dev/null +++ b/Lang/Fortran/Additive-primes @@ -0,0 +1 @@ +../../Task/Additive-primes/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Blum-integer b/Lang/Fortran/Blum-integer new file mode 120000 index 0000000000..814d829eed --- /dev/null +++ b/Lang/Fortran/Blum-integer @@ -0,0 +1 @@ +../../Task/Blum-integer/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Burrows-Wheeler-transform b/Lang/Fortran/Burrows-Wheeler-transform new file mode 120000 index 0000000000..e312b27f94 --- /dev/null +++ b/Lang/Fortran/Burrows-Wheeler-transform @@ -0,0 +1 @@ +../../Task/Burrows-Wheeler-transform/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Chaocipher b/Lang/Fortran/Chaocipher new file mode 120000 index 0000000000..1db3092120 --- /dev/null +++ b/Lang/Fortran/Chaocipher @@ -0,0 +1 @@ +../../Task/Chaocipher/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Ranking-methods b/Lang/Fortran/Ranking-methods new file mode 120000 index 0000000000..a369cc6fab --- /dev/null +++ b/Lang/Fortran/Ranking-methods @@ -0,0 +1 @@ +../../Task/Ranking-methods/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Strip-whitespace-from-a-string-Top-and-tail b/Lang/Fortran/Strip-whitespace-from-a-string-Top-and-tail new file mode 120000 index 0000000000..e6e0c4696a --- /dev/null +++ b/Lang/Fortran/Strip-whitespace-from-a-string-Top-and-tail @@ -0,0 +1 @@ +../../Task/Strip-whitespace-from-a-string-Top-and-tail/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Vigen-re-cipher-Cryptanalysis b/Lang/Fortran/Vigen-re-cipher-Cryptanalysis new file mode 120000 index 0000000000..1fbd3a2ec4 --- /dev/null +++ b/Lang/Fortran/Vigen-re-cipher-Cryptanalysis @@ -0,0 +1 @@ +../../Task/Vigen-re-cipher-Cryptanalysis/Fortran \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Binary-strings b/Lang/Free-Pascal-Lazarus/Binary-strings new file mode 120000 index 0000000000..f6ed90f24b --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Binary-strings @@ -0,0 +1 @@ +../../Task/Binary-strings/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Boyer-Moore-string-search b/Lang/Free-Pascal-Lazarus/Boyer-Moore-string-search new file mode 120000 index 0000000000..9902c3a3ea --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Boyer-Moore-string-search @@ -0,0 +1 @@ +../../Task/Boyer-Moore-string-search/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Fractal-tree b/Lang/Free-Pascal-Lazarus/Fractal-tree new file mode 120000 index 0000000000..c2081a0860 --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Fractal-tree @@ -0,0 +1 @@ +../../Task/Fractal-tree/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Hickerson-series-of-almost-integers b/Lang/Free-Pascal-Lazarus/Hickerson-series-of-almost-integers new file mode 120000 index 0000000000..e8c446d1f2 --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Hickerson-series-of-almost-integers @@ -0,0 +1 @@ +../../Task/Hickerson-series-of-almost-integers/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Leonardo-numbers b/Lang/Free-Pascal-Lazarus/Leonardo-numbers new file mode 120000 index 0000000000..5fc9b6dc54 --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Ordered-words b/Lang/Free-Pascal-Lazarus/Ordered-words new file mode 120000 index 0000000000..ec364f330e --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Ordered-words @@ -0,0 +1 @@ +../../Task/Ordered-words/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Probabilistic-choice b/Lang/Free-Pascal-Lazarus/Probabilistic-choice new file mode 120000 index 0000000000..0f85f5937f --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Probabilistic-choice @@ -0,0 +1 @@ +../../Task/Probabilistic-choice/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/Free-Pascal-Lazarus/Sorting-algorithms-Shell-sort b/Lang/Free-Pascal-Lazarus/Sorting-algorithms-Shell-sort new file mode 120000 index 0000000000..e5c8120991 --- /dev/null +++ b/Lang/Free-Pascal-Lazarus/Sorting-algorithms-Shell-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Shell-sort/Free-Pascal-Lazarus \ No newline at end of file diff --git a/Lang/FreeBASIC/24-game-Solve b/Lang/FreeBASIC/24-game-Solve new file mode 120000 index 0000000000..68ad0335d9 --- /dev/null +++ b/Lang/FreeBASIC/24-game-Solve @@ -0,0 +1 @@ +../../Task/24-game-Solve/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/ASCII-art-diagram-converter b/Lang/FreeBASIC/ASCII-art-diagram-converter new file mode 120000 index 0000000000..f349074235 --- /dev/null +++ b/Lang/FreeBASIC/ASCII-art-diagram-converter @@ -0,0 +1 @@ +../../Task/ASCII-art-diagram-converter/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Arithmetic-derivative b/Lang/FreeBASIC/Arithmetic-derivative new file mode 120000 index 0000000000..2a22a10780 --- /dev/null +++ b/Lang/FreeBASIC/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Bitmap-PPM-conversion-through-a-pipe b/Lang/FreeBASIC/Bitmap-PPM-conversion-through-a-pipe new file mode 120000 index 0000000000..9082778f9e --- /dev/null +++ b/Lang/FreeBASIC/Bitmap-PPM-conversion-through-a-pipe @@ -0,0 +1 @@ +../../Task/Bitmap-PPM-conversion-through-a-pipe/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Bitmap-Read-an-image-through-a-pipe b/Lang/FreeBASIC/Bitmap-Read-an-image-through-a-pipe new file mode 120000 index 0000000000..17dd1b6040 --- /dev/null +++ b/Lang/FreeBASIC/Bitmap-Read-an-image-through-a-pipe @@ -0,0 +1 @@ +../../Task/Bitmap-Read-an-image-through-a-pipe/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Cyclotomic-polynomial b/Lang/FreeBASIC/Cyclotomic-polynomial new file mode 120000 index 0000000000..82e1fdeb03 --- /dev/null +++ b/Lang/FreeBASIC/Cyclotomic-polynomial @@ -0,0 +1 @@ +../../Task/Cyclotomic-polynomial/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Dijkstras-algorithm b/Lang/FreeBASIC/Dijkstras-algorithm new file mode 120000 index 0000000000..4465c347e7 --- /dev/null +++ b/Lang/FreeBASIC/Dijkstras-algorithm @@ -0,0 +1 @@ +../../Task/Dijkstras-algorithm/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Dining-philosophers b/Lang/FreeBASIC/Dining-philosophers new file mode 120000 index 0000000000..5d616c69b5 --- /dev/null +++ b/Lang/FreeBASIC/Dining-philosophers @@ -0,0 +1 @@ +../../Task/Dining-philosophers/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Distance-and-Bearing b/Lang/FreeBASIC/Distance-and-Bearing new file mode 120000 index 0000000000..14b1500a35 --- /dev/null +++ b/Lang/FreeBASIC/Distance-and-Bearing @@ -0,0 +1 @@ +../../Task/Distance-and-Bearing/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Four-is-the-number-of-letters-in-the-... b/Lang/FreeBASIC/Four-is-the-number-of-letters-in-the-... new file mode 120000 index 0000000000..7c1f37136c --- /dev/null +++ b/Lang/FreeBASIC/Four-is-the-number-of-letters-in-the-... @@ -0,0 +1 @@ +../../Task/Four-is-the-number-of-letters-in-the-.../FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/HTTPS-Client-authenticated b/Lang/FreeBASIC/HTTPS-Client-authenticated new file mode 120000 index 0000000000..8c2cbfcd86 --- /dev/null +++ b/Lang/FreeBASIC/HTTPS-Client-authenticated @@ -0,0 +1 @@ +../../Task/HTTPS-Client-authenticated/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Inverted-index b/Lang/FreeBASIC/Inverted-index new file mode 120000 index 0000000000..affc1bf23c --- /dev/null +++ b/Lang/FreeBASIC/Inverted-index @@ -0,0 +1 @@ +../../Task/Inverted-index/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Median-filter b/Lang/FreeBASIC/Median-filter new file mode 120000 index 0000000000..a0d5eec8a2 --- /dev/null +++ b/Lang/FreeBASIC/Median-filter @@ -0,0 +1 @@ +../../Task/Median-filter/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Multiplicative-order b/Lang/FreeBASIC/Multiplicative-order new file mode 120000 index 0000000000..1ba98d9611 --- /dev/null +++ b/Lang/FreeBASIC/Multiplicative-order @@ -0,0 +1 @@ +../../Task/Multiplicative-order/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Percolation-Bond-percolation b/Lang/FreeBASIC/Percolation-Bond-percolation new file mode 120000 index 0000000000..15d6381502 --- /dev/null +++ b/Lang/FreeBASIC/Percolation-Bond-percolation @@ -0,0 +1 @@ +../../Task/Percolation-Bond-percolation/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Primes---allocate-descendants-to-their-ancestors b/Lang/FreeBASIC/Primes---allocate-descendants-to-their-ancestors new file mode 120000 index 0000000000..49848d0592 --- /dev/null +++ b/Lang/FreeBASIC/Primes---allocate-descendants-to-their-ancestors @@ -0,0 +1 @@ +../../Task/Primes---allocate-descendants-to-their-ancestors/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/S-expressions b/Lang/FreeBASIC/S-expressions new file mode 120000 index 0000000000..9a014b780a --- /dev/null +++ b/Lang/FreeBASIC/S-expressions @@ -0,0 +1 @@ +../../Task/S-expressions/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Sisyphus-sequence b/Lang/FreeBASIC/Sisyphus-sequence new file mode 120000 index 0000000000..10074b9571 --- /dev/null +++ b/Lang/FreeBASIC/Sisyphus-sequence @@ -0,0 +1 @@ +../../Task/Sisyphus-sequence/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Sort-a-list-of-object-identifiers b/Lang/FreeBASIC/Sort-a-list-of-object-identifiers new file mode 120000 index 0000000000..2c5a5fbb3b --- /dev/null +++ b/Lang/FreeBASIC/Sort-a-list-of-object-identifiers @@ -0,0 +1 @@ +../../Task/Sort-a-list-of-object-identifiers/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Sort-an-outline-at-every-level b/Lang/FreeBASIC/Sort-an-outline-at-every-level new file mode 120000 index 0000000000..ae4c555049 --- /dev/null +++ b/Lang/FreeBASIC/Sort-an-outline-at-every-level @@ -0,0 +1 @@ +../../Task/Sort-an-outline-at-every-level/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Sorting-algorithms-Radix-sort b/Lang/FreeBASIC/Sorting-algorithms-Radix-sort new file mode 120000 index 0000000000..bddec7031b --- /dev/null +++ b/Lang/FreeBASIC/Sorting-algorithms-Radix-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Radix-sort/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Topological-sort b/Lang/FreeBASIC/Topological-sort new file mode 120000 index 0000000000..c6cd407c9f --- /dev/null +++ b/Lang/FreeBASIC/Topological-sort @@ -0,0 +1 @@ +../../Task/Topological-sort/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Truth-table b/Lang/FreeBASIC/Truth-table new file mode 120000 index 0000000000..228be906c6 --- /dev/null +++ b/Lang/FreeBASIC/Truth-table @@ -0,0 +1 @@ +../../Task/Truth-table/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Vigen-re-cipher-Cryptanalysis b/Lang/FreeBASIC/Vigen-re-cipher-Cryptanalysis new file mode 120000 index 0000000000..a802341d36 --- /dev/null +++ b/Lang/FreeBASIC/Vigen-re-cipher-Cryptanalysis @@ -0,0 +1 @@ +../../Task/Vigen-re-cipher-Cryptanalysis/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Web-scraping b/Lang/FreeBASIC/Web-scraping deleted file mode 120000 index ef3ee370f4..0000000000 --- a/Lang/FreeBASIC/Web-scraping +++ /dev/null @@ -1 +0,0 @@ -../../Task/Web-scraping/FreeBASIC \ No newline at end of file diff --git a/Lang/FutureBasic/00-LANG.txt b/Lang/FutureBasic/00-LANG.txt index d3dbdba2ec..36f5f0b065 100644 --- a/Lang/FutureBasic/00-LANG.txt +++ b/Lang/FutureBasic/00-LANG.txt @@ -12,7 +12,11 @@ [[File:FutureBasicIcon.png|64px|top]] -FutureBasic began life as Zbasic, a commercial variant of [[BASIC]] for the early Macintoshes, but has grown far beyond that into a mature freeware IDE that, through its FBtoC translator, can be used to compile C and Objective-C [[object-oriented]] code using the clang compiler included with an Xcode installation. It is excellent as a educational tool and for fast prototyping -- especially in Objective-C (Cocoa) by those who prefer programmatic code without the overhead of Xcode. Among its enthusiasts are commercial developers, engineers, professors, doctors, musicians, writers and a host of amateurs who program with FB for the sheer joy of it. +FutureBasic — commonly called FB by its users — is a robust freeware Macintosh IDE. + +It began life as Zbasic, a commercial variant of [[BASIC]] for the early Macintoshes, but has grown far beyond that into a mature IDE compatible with the latest macOSes. Through its FBtoC translator, it can be used to compile C and Objective-C [[object-oriented]] code. It uses the industry-standard clang compiler included with an Xcode installation. + +FB is excellent as a educational tool, for fast prototyping and for commercial application development. In addition to its native language, it can incorporate C and Objective-C (Cocoa) for those who prefer programmatic code without the overhead of Xcode. It is compatible with Xcode nib and xib files used for building GUIs. Among its enthusiasts are commercial developers, engineers, professors, doctors, musicians, writers and a host of amateurs who program with FB for the sheer joy of it. == FutureBasic Home Page & Download == @@ -64,11 +68,11 @@ In 1995 Staz Software, led by Chris Stasny based in Diamondhead, Miss., acquired When Apple transitioned the Mac from 68k to PowerPC, the FB editor was rewritten by Stasny and was coupled with an adaptation of the compiler by Andy Gariepy. The result of their efforts, a dramatically enhanced IDE called FB^3 (FB-cubed) was released in September 1999. -Major update releases introduced a full-featured Appearance Compliant runtime written by the late New Zealander Robert Purves renown for his brilliant programming. Once completely carbonized to run natively on the Mac OS X, the FutureBASIC Integrated Development Environment (FB IDE) was called FB4 and released in July 2004. +Major update releases introduced a full-featured Appearance Compliant runtime written by the late New Zealander Robert Purves renowned for his brilliant programming. Once completely carbonized to run natively on the Mac OS X, the FutureBASIC Integrated Development Environment (FB IDE) was called FB4 and released in July 2004. In August 2005, Staz Software was devastated by Hurricane Katrina just at the time Apple was transitioning from Motorola PPC microprocessors to Intel chips. FB development slowed almost to a standstill. On January 1, 2008, Staz Software announced that FB would henceforth be freeware and FB4 with FBtoC 1.0 was made available. -Since that time, an independent team of volunteer developers initially lead by Purves continued to improve FBtoC, which took code produced by the FB Editor and translated it to C for processing by gcc which was eventually transitioned to the more robust clang. +Since that time, an independent team of volunteer developers initially led by Purves continued to improve FBtoC, which took code produced by the FB Editor and translated it to C for processing by gcc which was eventually transitioned to the more robust clang. On Sunday, June 3, 2012, members of the FB List Serve were notified that Robert Purves had died after a long bout with cancer. The news came as a surprise to many FB developers who were unaware of Purves' illness. While coping with cancer, he continued as an active member of the FB community, improving FB, answering questions, solving problems, and posting exquisitely terse code often salted with pithy remarks from his wonderfully dry humor. He never mentioned his health problems and never complained. A tribute to Purves can be found at the bottom of the FB Home Page diff --git a/Lang/FutureBasic/AKS-test-for-primes b/Lang/FutureBasic/AKS-test-for-primes new file mode 120000 index 0000000000..d7fcaa6502 --- /dev/null +++ b/Lang/FutureBasic/AKS-test-for-primes @@ -0,0 +1 @@ +../../Task/AKS-test-for-primes/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Achilles-numbers b/Lang/FutureBasic/Achilles-numbers new file mode 120000 index 0000000000..a912859c01 --- /dev/null +++ b/Lang/FutureBasic/Achilles-numbers @@ -0,0 +1 @@ +../../Task/Achilles-numbers/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Aliquot-sequence-classifications b/Lang/FutureBasic/Aliquot-sequence-classifications new file mode 120000 index 0000000000..d24c82afdc --- /dev/null +++ b/Lang/FutureBasic/Aliquot-sequence-classifications @@ -0,0 +1 @@ +../../Task/Aliquot-sequence-classifications/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Angles-geometric-normalization-and-conversion b/Lang/FutureBasic/Angles-geometric-normalization-and-conversion new file mode 120000 index 0000000000..63c4e835a4 --- /dev/null +++ b/Lang/FutureBasic/Angles-geometric-normalization-and-conversion @@ -0,0 +1 @@ +../../Task/Angles-geometric-normalization-and-conversion/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Arithmetic-derivative b/Lang/FutureBasic/Arithmetic-derivative new file mode 120000 index 0000000000..4b54c16b3d --- /dev/null +++ b/Lang/FutureBasic/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Assertions b/Lang/FutureBasic/Assertions new file mode 120000 index 0000000000..6270ababb4 --- /dev/null +++ b/Lang/FutureBasic/Assertions @@ -0,0 +1 @@ +../../Task/Assertions/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Brownian-tree b/Lang/FutureBasic/Brownian-tree new file mode 120000 index 0000000000..26e06861c7 --- /dev/null +++ b/Lang/FutureBasic/Brownian-tree @@ -0,0 +1 @@ +../../Task/Brownian-tree/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Catalan-numbers-Pascals-triangle b/Lang/FutureBasic/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..48a5bd3f8b --- /dev/null +++ b/Lang/FutureBasic/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Command-line-arguments b/Lang/FutureBasic/Command-line-arguments new file mode 120000 index 0000000000..2926af8716 --- /dev/null +++ b/Lang/FutureBasic/Command-line-arguments @@ -0,0 +1 @@ +../../Task/Command-line-arguments/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Constrained-random-points-on-a-circle b/Lang/FutureBasic/Constrained-random-points-on-a-circle new file mode 120000 index 0000000000..db1c784250 --- /dev/null +++ b/Lang/FutureBasic/Constrained-random-points-on-a-circle @@ -0,0 +1 @@ +../../Task/Constrained-random-points-on-a-circle/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Death-Star b/Lang/FutureBasic/Death-Star new file mode 120000 index 0000000000..6a87d38224 --- /dev/null +++ b/Lang/FutureBasic/Death-Star @@ -0,0 +1 @@ +../../Task/Death-Star/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Digital-root b/Lang/FutureBasic/Digital-root new file mode 120000 index 0000000000..63da54faf1 --- /dev/null +++ b/Lang/FutureBasic/Digital-root @@ -0,0 +1 @@ +../../Task/Digital-root/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Dinesmans-multiple-dwelling-problem b/Lang/FutureBasic/Dinesmans-multiple-dwelling-problem new file mode 120000 index 0000000000..cdb0294902 --- /dev/null +++ b/Lang/FutureBasic/Dinesmans-multiple-dwelling-problem @@ -0,0 +1 @@ +../../Task/Dinesmans-multiple-dwelling-problem/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Doubly-linked-list-Definition b/Lang/FutureBasic/Doubly-linked-list-Definition new file mode 120000 index 0000000000..dbb3fa0478 --- /dev/null +++ b/Lang/FutureBasic/Doubly-linked-list-Definition @@ -0,0 +1 @@ +../../Task/Doubly-linked-list-Definition/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Eban-numbers b/Lang/FutureBasic/Eban-numbers new file mode 120000 index 0000000000..2ae3f59434 --- /dev/null +++ b/Lang/FutureBasic/Eban-numbers @@ -0,0 +1 @@ +../../Task/Eban-numbers/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Echo-server b/Lang/FutureBasic/Echo-server new file mode 120000 index 0000000000..25d59262e7 --- /dev/null +++ b/Lang/FutureBasic/Echo-server @@ -0,0 +1 @@ +../../Task/Echo-server/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Egyptian-division b/Lang/FutureBasic/Egyptian-division new file mode 120000 index 0000000000..5961af2842 --- /dev/null +++ b/Lang/FutureBasic/Egyptian-division @@ -0,0 +1 @@ +../../Task/Egyptian-division/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Entropy b/Lang/FutureBasic/Entropy new file mode 120000 index 0000000000..6336540906 --- /dev/null +++ b/Lang/FutureBasic/Entropy @@ -0,0 +1 @@ +../../Task/Entropy/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Evolutionary-algorithm b/Lang/FutureBasic/Evolutionary-algorithm new file mode 120000 index 0000000000..6ad9576429 --- /dev/null +++ b/Lang/FutureBasic/Evolutionary-algorithm @@ -0,0 +1 @@ +../../Task/Evolutionary-algorithm/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Fibonacci-word b/Lang/FutureBasic/Fibonacci-word new file mode 120000 index 0000000000..c773eeed44 --- /dev/null +++ b/Lang/FutureBasic/Fibonacci-word @@ -0,0 +1 @@ +../../Task/Fibonacci-word/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Find-the-missing-permutation b/Lang/FutureBasic/Find-the-missing-permutation new file mode 120000 index 0000000000..83f97c5dbb --- /dev/null +++ b/Lang/FutureBasic/Find-the-missing-permutation @@ -0,0 +1 @@ +../../Task/Find-the-missing-permutation/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Flipping-bits-game b/Lang/FutureBasic/Flipping-bits-game new file mode 120000 index 0000000000..439479c614 --- /dev/null +++ b/Lang/FutureBasic/Flipping-bits-game @@ -0,0 +1 @@ +../../Task/Flipping-bits-game/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Gray-code b/Lang/FutureBasic/Gray-code new file mode 120000 index 0000000000..5eafcaba04 --- /dev/null +++ b/Lang/FutureBasic/Gray-code @@ -0,0 +1 @@ +../../Task/Gray-code/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/HTTPS-Authenticated b/Lang/FutureBasic/HTTPS-Authenticated new file mode 120000 index 0000000000..9edb1d8326 --- /dev/null +++ b/Lang/FutureBasic/HTTPS-Authenticated @@ -0,0 +1 @@ +../../Task/HTTPS-Authenticated/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Halt-and-catch-fire b/Lang/FutureBasic/Halt-and-catch-fire new file mode 120000 index 0000000000..d78c73210e --- /dev/null +++ b/Lang/FutureBasic/Halt-and-catch-fire @@ -0,0 +1 @@ +../../Task/Halt-and-catch-fire/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Hello-world-Standard-error b/Lang/FutureBasic/Hello-world-Standard-error new file mode 120000 index 0000000000..326ae936a9 --- /dev/null +++ b/Lang/FutureBasic/Hello-world-Standard-error @@ -0,0 +1 @@ +../../Task/Hello-world-Standard-error/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Here-document b/Lang/FutureBasic/Here-document new file mode 120000 index 0000000000..44b4edadd8 --- /dev/null +++ b/Lang/FutureBasic/Here-document @@ -0,0 +1 @@ +../../Task/Here-document/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Hofstadter-Q-sequence b/Lang/FutureBasic/Hofstadter-Q-sequence new file mode 120000 index 0000000000..bb38370ecf --- /dev/null +++ b/Lang/FutureBasic/Hofstadter-Q-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Q-sequence/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Hunt-the-Wumpus b/Lang/FutureBasic/Hunt-the-Wumpus new file mode 120000 index 0000000000..6ac2d19ea6 --- /dev/null +++ b/Lang/FutureBasic/Hunt-the-Wumpus @@ -0,0 +1 @@ +../../Task/Hunt-the-Wumpus/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Integer-overflow b/Lang/FutureBasic/Integer-overflow new file mode 120000 index 0000000000..37f3cd9e93 --- /dev/null +++ b/Lang/FutureBasic/Integer-overflow @@ -0,0 +1 @@ +../../Task/Integer-overflow/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Knights-tour b/Lang/FutureBasic/Knights-tour new file mode 120000 index 0000000000..c40890eb0e --- /dev/null +++ b/Lang/FutureBasic/Knights-tour @@ -0,0 +1 @@ +../../Task/Knights-tour/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/MAC-vendor-lookup b/Lang/FutureBasic/MAC-vendor-lookup new file mode 120000 index 0000000000..63a0a7c0b7 --- /dev/null +++ b/Lang/FutureBasic/MAC-vendor-lookup @@ -0,0 +1 @@ +../../Task/MAC-vendor-lookup/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Mastermind b/Lang/FutureBasic/Mastermind new file mode 120000 index 0000000000..e02911b738 --- /dev/null +++ b/Lang/FutureBasic/Mastermind @@ -0,0 +1 @@ +../../Task/Mastermind/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Mayan-calendar b/Lang/FutureBasic/Mayan-calendar new file mode 120000 index 0000000000..7b5f78ca25 --- /dev/null +++ b/Lang/FutureBasic/Mayan-calendar @@ -0,0 +1 @@ +../../Task/Mayan-calendar/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Minesweeper-game b/Lang/FutureBasic/Minesweeper-game new file mode 120000 index 0000000000..fdc515bbc6 --- /dev/null +++ b/Lang/FutureBasic/Minesweeper-game @@ -0,0 +1 @@ +../../Task/Minesweeper-game/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Pascals-triangle b/Lang/FutureBasic/Pascals-triangle new file mode 120000 index 0000000000..31e8218285 --- /dev/null +++ b/Lang/FutureBasic/Pascals-triangle @@ -0,0 +1 @@ +../../Task/Pascals-triangle/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Pentagram b/Lang/FutureBasic/Pentagram new file mode 120000 index 0000000000..036f2d484a --- /dev/null +++ b/Lang/FutureBasic/Pentagram @@ -0,0 +1 @@ +../../Task/Pentagram/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Poker-hand-analyser b/Lang/FutureBasic/Poker-hand-analyser new file mode 120000 index 0000000000..35dd2acb93 --- /dev/null +++ b/Lang/FutureBasic/Poker-hand-analyser @@ -0,0 +1 @@ +../../Task/Poker-hand-analyser/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Range-expansion b/Lang/FutureBasic/Range-expansion new file mode 120000 index 0000000000..9b92918178 --- /dev/null +++ b/Lang/FutureBasic/Range-expansion @@ -0,0 +1 @@ +../../Task/Range-expansion/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Range-extraction b/Lang/FutureBasic/Range-extraction new file mode 120000 index 0000000000..9a5f1d0533 --- /dev/null +++ b/Lang/FutureBasic/Range-extraction @@ -0,0 +1 @@ +../../Task/Range-extraction/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Resistor-mesh b/Lang/FutureBasic/Resistor-mesh new file mode 120000 index 0000000000..318a1a0f13 --- /dev/null +++ b/Lang/FutureBasic/Resistor-mesh @@ -0,0 +1 @@ +../../Task/Resistor-mesh/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/SHA-256 b/Lang/FutureBasic/SHA-256 new file mode 120000 index 0000000000..0d14776e97 --- /dev/null +++ b/Lang/FutureBasic/SHA-256 @@ -0,0 +1 @@ +../../Task/SHA-256/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Semordnilap b/Lang/FutureBasic/Semordnilap new file mode 120000 index 0000000000..23f6715ad0 --- /dev/null +++ b/Lang/FutureBasic/Semordnilap @@ -0,0 +1 @@ +../../Task/Semordnilap/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Sierpinski-carpet b/Lang/FutureBasic/Sierpinski-carpet new file mode 120000 index 0000000000..c79bb878a8 --- /dev/null +++ b/Lang/FutureBasic/Sierpinski-carpet @@ -0,0 +1 @@ +../../Task/Sierpinski-carpet/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Sort-disjoint-sublist b/Lang/FutureBasic/Sort-disjoint-sublist new file mode 120000 index 0000000000..030bf0bfd7 --- /dev/null +++ b/Lang/FutureBasic/Sort-disjoint-sublist @@ -0,0 +1 @@ +../../Task/Sort-disjoint-sublist/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Spiral-matrix b/Lang/FutureBasic/Spiral-matrix new file mode 120000 index 0000000000..4d24174200 --- /dev/null +++ b/Lang/FutureBasic/Spiral-matrix @@ -0,0 +1 @@ +../../Task/Spiral-matrix/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Strip-block-comments b/Lang/FutureBasic/Strip-block-comments new file mode 120000 index 0000000000..1f0c4fb53d --- /dev/null +++ b/Lang/FutureBasic/Strip-block-comments @@ -0,0 +1 @@ +../../Task/Strip-block-comments/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Strip-control-codes-and-extended-characters-from-a-string b/Lang/FutureBasic/Strip-control-codes-and-extended-characters-from-a-string new file mode 120000 index 0000000000..ae3840dae2 --- /dev/null +++ b/Lang/FutureBasic/Strip-control-codes-and-extended-characters-from-a-string @@ -0,0 +1 @@ +../../Task/Strip-control-codes-and-extended-characters-from-a-string/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Terminal-control-Coloured-text b/Lang/FutureBasic/Terminal-control-Coloured-text new file mode 120000 index 0000000000..6858a62734 --- /dev/null +++ b/Lang/FutureBasic/Terminal-control-Coloured-text @@ -0,0 +1 @@ +../../Task/Terminal-control-Coloured-text/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Terminal-control-Cursor-movement b/Lang/FutureBasic/Terminal-control-Cursor-movement new file mode 120000 index 0000000000..050e1439d6 --- /dev/null +++ b/Lang/FutureBasic/Terminal-control-Cursor-movement @@ -0,0 +1 @@ +../../Task/Terminal-control-Cursor-movement/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Terminal-control-Cursor-positioning b/Lang/FutureBasic/Terminal-control-Cursor-positioning new file mode 120000 index 0000000000..22f710aaf6 --- /dev/null +++ b/Lang/FutureBasic/Terminal-control-Cursor-positioning @@ -0,0 +1 @@ +../../Task/Terminal-control-Cursor-positioning/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Terminal-control-Hiding-the-cursor b/Lang/FutureBasic/Terminal-control-Hiding-the-cursor new file mode 120000 index 0000000000..22bc1dda83 --- /dev/null +++ b/Lang/FutureBasic/Terminal-control-Hiding-the-cursor @@ -0,0 +1 @@ +../../Task/Terminal-control-Hiding-the-cursor/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Terminal-control-Ringing-the-terminal-bell b/Lang/FutureBasic/Terminal-control-Ringing-the-terminal-bell new file mode 120000 index 0000000000..6f8d6c609a --- /dev/null +++ b/Lang/FutureBasic/Terminal-control-Ringing-the-terminal-bell @@ -0,0 +1 @@ +../../Task/Terminal-control-Ringing-the-terminal-bell/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Terminal-control-Unicode-output b/Lang/FutureBasic/Terminal-control-Unicode-output new file mode 120000 index 0000000000..712dfa9fa9 --- /dev/null +++ b/Lang/FutureBasic/Terminal-control-Unicode-output @@ -0,0 +1 @@ +../../Task/Terminal-control-Unicode-output/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Tic-tac-toe b/Lang/FutureBasic/Tic-tac-toe new file mode 120000 index 0000000000..e0c70b24fe --- /dev/null +++ b/Lang/FutureBasic/Tic-tac-toe @@ -0,0 +1 @@ +../../Task/Tic-tac-toe/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Use-another-language-to-call-a-function b/Lang/FutureBasic/Use-another-language-to-call-a-function new file mode 120000 index 0000000000..704ff5c0c8 --- /dev/null +++ b/Lang/FutureBasic/Use-another-language-to-call-a-function @@ -0,0 +1 @@ +../../Task/Use-another-language-to-call-a-function/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Validate-International-Securities-Identification-Number b/Lang/FutureBasic/Validate-International-Securities-Identification-Number new file mode 120000 index 0000000000..81f74f067a --- /dev/null +++ b/Lang/FutureBasic/Validate-International-Securities-Identification-Number @@ -0,0 +1 @@ +../../Task/Validate-International-Securities-Identification-Number/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Yahoo-search-interface b/Lang/FutureBasic/Yahoo-search-interface new file mode 120000 index 0000000000..9f29c6ac04 --- /dev/null +++ b/Lang/FutureBasic/Yahoo-search-interface @@ -0,0 +1 @@ +../../Task/Yahoo-search-interface/FutureBasic \ No newline at end of file diff --git a/Lang/GW-BASIC/Case-sensitivity-of-identifiers b/Lang/GW-BASIC/Case-sensitivity-of-identifiers deleted file mode 120000 index 605ddebd53..0000000000 --- a/Lang/GW-BASIC/Case-sensitivity-of-identifiers +++ /dev/null @@ -1 +0,0 @@ -../../Task/Case-sensitivity-of-identifiers/GW-BASIC \ No newline at end of file diff --git a/Lang/GW-BASIC/Leonardo-numbers b/Lang/GW-BASIC/Leonardo-numbers new file mode 120000 index 0000000000..f7945f7063 --- /dev/null +++ b/Lang/GW-BASIC/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/GW-BASIC \ No newline at end of file diff --git a/Lang/GW-BASIC/Luhn-test-of-credit-card-numbers b/Lang/GW-BASIC/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..3e46368b55 --- /dev/null +++ b/Lang/GW-BASIC/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/GW-BASIC \ No newline at end of file diff --git a/Lang/GW-BASIC/Nth-root b/Lang/GW-BASIC/Nth-root new file mode 120000 index 0000000000..44da5f255f --- /dev/null +++ b/Lang/GW-BASIC/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/GW-BASIC \ No newline at end of file diff --git a/Lang/Gambas/Generate-Chess960-starting-position b/Lang/Gambas/Generate-Chess960-starting-position new file mode 120000 index 0000000000..3ee17430bf --- /dev/null +++ b/Lang/Gambas/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Gambas \ No newline at end of file diff --git a/Lang/Go/Bifid-cipher b/Lang/Go/Bifid-cipher new file mode 120000 index 0000000000..329ffb397d --- /dev/null +++ b/Lang/Go/Bifid-cipher @@ -0,0 +1 @@ +../../Task/Bifid-cipher/Go \ No newline at end of file diff --git a/Lang/Go/Terminal-control-Unicode-output b/Lang/Go/Terminal-control-Unicode-output deleted file mode 120000 index 7532989408..0000000000 --- a/Lang/Go/Terminal-control-Unicode-output +++ /dev/null @@ -1 +0,0 @@ -../../Task/Terminal-control-Unicode-output/Go \ No newline at end of file diff --git a/Lang/Golfscript/00-LANG.txt b/Lang/Golfscript/00-LANG.txt index 67be1df4fd..ce1ed4276d 100644 --- a/Lang/Golfscript/00-LANG.txt +++ b/Lang/Golfscript/00-LANG.txt @@ -1,5 +1,10 @@ {{language|GolfScript |site=http://www.golfscript.com/golfscript/index.html }} +{{try|Golfscript|[https://tio.run/#golfscript Try Golfscript on tio.run].}} {{language programming paradigm|Concatenative}} -GolfScript is a stack oriented esoteric programming language aimed at solving problems (holes) in as few keystrokes as possible. It also aims to be simple and easy to write. \ No newline at end of file +GolfScript is a stack oriented esoteric programming language aimed at solving problems (holes) in as few keystrokes as possible. It also aims to be simple and easy to write. + +== External links == +* [https://golfscript.com/golfscript/ Official website] +* [https://codegolf.stackexchange.com/questions/5264/tips-for-golfing-in-golfscript Tips for golfing in Golfscript] \ No newline at end of file diff --git a/Lang/Guile/2048 b/Lang/Guile/2048 new file mode 120000 index 0000000000..69532585e1 --- /dev/null +++ b/Lang/Guile/2048 @@ -0,0 +1 @@ +../../Task/2048/Guile \ No newline at end of file diff --git a/Lang/Guile/A+B b/Lang/Guile/A+B new file mode 120000 index 0000000000..ea7ff34909 --- /dev/null +++ b/Lang/Guile/A+B @@ -0,0 +1 @@ +../../Task/A+B/Guile \ No newline at end of file diff --git a/Lang/Guile/MD5-Implementation b/Lang/Guile/MD5-Implementation new file mode 120000 index 0000000000..c467572ebf --- /dev/null +++ b/Lang/Guile/MD5-Implementation @@ -0,0 +1 @@ +../../Task/MD5-Implementation/Guile \ No newline at end of file diff --git a/Lang/Guish/00-LANG.txt b/Lang/Guish/00-LANG.txt index 593da31c91..e15298f7c3 100644 --- a/Lang/Guish/00-LANG.txt +++ b/Lang/Guish/00-LANG.txt @@ -1016,7 +1016,7 @@ Any element that's not a page has a particular text alignment that can be change -Francesco Palumbo <phranz@subfc.net> +Francesco Palumbo = THANKS = diff --git a/Lang/Haskell/Bifid-cipher b/Lang/Haskell/Bifid-cipher new file mode 120000 index 0000000000..e9402d0afc --- /dev/null +++ b/Lang/Haskell/Bifid-cipher @@ -0,0 +1 @@ +../../Task/Bifid-cipher/Haskell \ No newline at end of file diff --git a/Lang/Idris/Palindrome-detection b/Lang/Idris/Palindrome-detection new file mode 120000 index 0000000000..58af724843 --- /dev/null +++ b/Lang/Idris/Palindrome-detection @@ -0,0 +1 @@ +../../Task/Palindrome-detection/Idris \ No newline at end of file diff --git a/Lang/J/00-LANG.txt b/Lang/J/00-LANG.txt index c2cd3a263c..5ca185b4f1 100644 --- a/Lang/J/00-LANG.txt +++ b/Lang/J/00-LANG.txt @@ -117,7 +117,7 @@ Discussion of the goals of the J community on RC and general guidelines for pres *[[User:Lambertdw|David Lambert]]:[[Special:Contributions/Lambertdw|contributions]] *[[User:JimTheriot|JimTheriot]]: [[Special:Contributions/JimTheriot|contributions]] *[[User:DevonMcC|Devon McCormick]]: [[Special:Contributions/DevonMcC|contributions]] -*[[User:Cchando|Cameron Chandoke]]: [[Special:Contributions/Cchando|contributions]] +*[[User:Cchando|Cameron Chandoke]]: [[Special:Contributions/Cchando|contributions]], [[j:User:Cameron_Chandoke|J wiki]] == Try me == diff --git a/Lang/Java/00-LANG.txt b/Lang/Java/00-LANG.txt index 72a980a538..9df12a7429 100644 --- a/Lang/Java/00-LANG.txt +++ b/Lang/Java/00-LANG.txt @@ -41,4 +41,4 @@ Useful Java links: * [http://openjdk.java.net OpenJDK] ==Todo== -[[Reports:Tasks_not_implemented_in_Java]] \ No newline at end of file +[https://rosettacode.org/wiki/Tasks_not_implemented_in_Java Tasks not implemented in Java] \ No newline at end of file diff --git a/Lang/Java/Sylvesters-sequence b/Lang/Java/Sylvesters-sequence new file mode 120000 index 0000000000..6dfb05d095 --- /dev/null +++ b/Lang/Java/Sylvesters-sequence @@ -0,0 +1 @@ +../../Task/Sylvesters-sequence/Java \ No newline at end of file diff --git a/Lang/JavaScript/Horizontal-sundial-calculations b/Lang/JavaScript/Horizontal-sundial-calculations new file mode 120000 index 0000000000..854f95761b --- /dev/null +++ b/Lang/JavaScript/Horizontal-sundial-calculations @@ -0,0 +1 @@ +../../Task/Horizontal-sundial-calculations/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/ISBN13-check-digit b/Lang/JavaScript/ISBN13-check-digit new file mode 120000 index 0000000000..a76c26065c --- /dev/null +++ b/Lang/JavaScript/ISBN13-check-digit @@ -0,0 +1 @@ +../../Task/ISBN13-check-digit/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Periodic-table b/Lang/JavaScript/Periodic-table new file mode 120000 index 0000000000..3252400859 --- /dev/null +++ b/Lang/JavaScript/Periodic-table @@ -0,0 +1 @@ +../../Task/Periodic-table/JavaScript \ No newline at end of file diff --git a/Lang/Joy/Case-sensitivity-of-identifiers b/Lang/Joy/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..e8f5c2c1db --- /dev/null +++ b/Lang/Joy/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/Joy \ No newline at end of file diff --git a/Lang/Joy/Read-a-file-line-by-line b/Lang/Joy/Read-a-file-line-by-line new file mode 120000 index 0000000000..9985d0bc9c --- /dev/null +++ b/Lang/Joy/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/Joy \ No newline at end of file diff --git a/Lang/Joy/Sort-an-integer-array b/Lang/Joy/Sort-an-integer-array new file mode 120000 index 0000000000..91921cd08e --- /dev/null +++ b/Lang/Joy/Sort-an-integer-array @@ -0,0 +1 @@ +../../Task/Sort-an-integer-array/Joy \ No newline at end of file diff --git a/Lang/Joy/Unicode-variable-names b/Lang/Joy/Unicode-variable-names new file mode 120000 index 0000000000..b7f93a76ef --- /dev/null +++ b/Lang/Joy/Unicode-variable-names @@ -0,0 +1 @@ +../../Task/Unicode-variable-names/Joy \ No newline at end of file diff --git a/Lang/K/Compare-a-list-of-strings b/Lang/K/Compare-a-list-of-strings new file mode 120000 index 0000000000..e673df5891 --- /dev/null +++ b/Lang/K/Compare-a-list-of-strings @@ -0,0 +1 @@ +../../Task/Compare-a-list-of-strings/K \ No newline at end of file diff --git a/Lang/K/Sieve-of-Eratosthenes b/Lang/K/Sieve-of-Eratosthenes new file mode 120000 index 0000000000..c66b9a1b22 --- /dev/null +++ b/Lang/K/Sieve-of-Eratosthenes @@ -0,0 +1 @@ +../../Task/Sieve-of-Eratosthenes/K \ No newline at end of file diff --git a/Lang/K/Sum-multiples-of-3-and-5 b/Lang/K/Sum-multiples-of-3-and-5 new file mode 120000 index 0000000000..625ba55b5f --- /dev/null +++ b/Lang/K/Sum-multiples-of-3-and-5 @@ -0,0 +1 @@ +../../Task/Sum-multiples-of-3-and-5/K \ No newline at end of file diff --git a/Lang/Kotlin/Radical-of-an-integer b/Lang/Kotlin/Radical-of-an-integer new file mode 120000 index 0000000000..e9d51e3e8d --- /dev/null +++ b/Lang/Kotlin/Radical-of-an-integer @@ -0,0 +1 @@ +../../Task/Radical-of-an-integer/Kotlin \ No newline at end of file diff --git a/Lang/LDPL/Command-line-arguments b/Lang/LDPL/Command-line-arguments new file mode 120000 index 0000000000..7b4b88a226 --- /dev/null +++ b/Lang/LDPL/Command-line-arguments @@ -0,0 +1 @@ +../../Task/Command-line-arguments/LDPL \ No newline at end of file diff --git a/Lang/LOLCODE/A+B b/Lang/LOLCODE/A+B new file mode 120000 index 0000000000..d5ea45853c --- /dev/null +++ b/Lang/LOLCODE/A+B @@ -0,0 +1 @@ +../../Task/A+B/LOLCODE \ No newline at end of file diff --git a/Lang/Langur/Arithmetic-Complex b/Lang/Langur/Arithmetic-Complex new file mode 120000 index 0000000000..5341d853ac --- /dev/null +++ b/Lang/Langur/Arithmetic-Complex @@ -0,0 +1 @@ +../../Task/Arithmetic-Complex/Langur \ No newline at end of file diff --git a/Lang/Langur/Program-name b/Lang/Langur/Program-name deleted file mode 120000 index 04198cf0de..0000000000 --- a/Lang/Langur/Program-name +++ /dev/null @@ -1 +0,0 @@ -../../Task/Program-name/Langur \ No newline at end of file diff --git a/Lang/Locomotive-Basic/Animate-a-pendulum b/Lang/Locomotive-Basic/Animate-a-pendulum new file mode 120000 index 0000000000..32a0ee5149 --- /dev/null +++ b/Lang/Locomotive-Basic/Animate-a-pendulum @@ -0,0 +1 @@ +../../Task/Animate-a-pendulum/Locomotive-Basic \ No newline at end of file diff --git a/Lang/Locomotive-Basic/Forest-fire b/Lang/Locomotive-Basic/Forest-fire new file mode 120000 index 0000000000..44a3c54d6a --- /dev/null +++ b/Lang/Locomotive-Basic/Forest-fire @@ -0,0 +1 @@ +../../Task/Forest-fire/Locomotive-Basic \ No newline at end of file diff --git a/Lang/Lua/Duffinian-numbers b/Lang/Lua/Duffinian-numbers new file mode 120000 index 0000000000..3d384f7bda --- /dev/null +++ b/Lang/Lua/Duffinian-numbers @@ -0,0 +1 @@ +../../Task/Duffinian-numbers/Lua \ No newline at end of file diff --git a/Lang/Lua/Hello-world-Line-printer b/Lang/Lua/Hello-world-Line-printer new file mode 120000 index 0000000000..1ade14f20f --- /dev/null +++ b/Lang/Lua/Hello-world-Line-printer @@ -0,0 +1 @@ +../../Task/Hello-world-Line-printer/Lua \ No newline at end of file diff --git a/Lang/Lua/Parsing-RPN-calculator-algorithm b/Lang/Lua/Parsing-RPN-calculator-algorithm deleted file mode 120000 index 397c1ccfd1..0000000000 --- a/Lang/Lua/Parsing-RPN-calculator-algorithm +++ /dev/null @@ -1 +0,0 @@ -../../Task/Parsing-RPN-calculator-algorithm/Lua \ No newline at end of file diff --git a/Lang/Lua/Summarize-primes b/Lang/Lua/Summarize-primes new file mode 120000 index 0000000000..601bc61d3c --- /dev/null +++ b/Lang/Lua/Summarize-primes @@ -0,0 +1 @@ +../../Task/Summarize-primes/Lua \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Arbitrary-precision-integers-included- b/Lang/M2000-Interpreter/Arbitrary-precision-integers-included- new file mode 120000 index 0000000000..4f4595771b --- /dev/null +++ b/Lang/M2000-Interpreter/Arbitrary-precision-integers-included- @@ -0,0 +1 @@ +../../Task/Arbitrary-precision-integers-included-/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Arithmetic-Complex b/Lang/M2000-Interpreter/Arithmetic-Complex new file mode 120000 index 0000000000..d7240f321f --- /dev/null +++ b/Lang/M2000-Interpreter/Arithmetic-Complex @@ -0,0 +1 @@ +../../Task/Arithmetic-Complex/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Averages-Simple-moving-average b/Lang/M2000-Interpreter/Averages-Simple-moving-average new file mode 120000 index 0000000000..4d812f1b4c --- /dev/null +++ b/Lang/M2000-Interpreter/Averages-Simple-moving-average @@ -0,0 +1 @@ +../../Task/Averages-Simple-moving-average/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Bifid-cipher b/Lang/M2000-Interpreter/Bifid-cipher new file mode 120000 index 0000000000..c97cd39b1f --- /dev/null +++ b/Lang/M2000-Interpreter/Bifid-cipher @@ -0,0 +1 @@ +../../Task/Bifid-cipher/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Binary-strings b/Lang/M2000-Interpreter/Binary-strings new file mode 120000 index 0000000000..7890dd1bf5 --- /dev/null +++ b/Lang/M2000-Interpreter/Binary-strings @@ -0,0 +1 @@ +../../Task/Binary-strings/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Bioinformatics-base-count b/Lang/M2000-Interpreter/Bioinformatics-base-count new file mode 120000 index 0000000000..a75bd15fc5 --- /dev/null +++ b/Lang/M2000-Interpreter/Bioinformatics-base-count @@ -0,0 +1 @@ +../../Task/Bioinformatics-base-count/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Bitmap-B-zier-curves-Quadratic b/Lang/M2000-Interpreter/Bitmap-B-zier-curves-Quadratic new file mode 120000 index 0000000000..2471b47323 --- /dev/null +++ b/Lang/M2000-Interpreter/Bitmap-B-zier-curves-Quadratic @@ -0,0 +1 @@ +../../Task/Bitmap-B-zier-curves-Quadratic/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Bitmap-Bresenhams-line-algorithm b/Lang/M2000-Interpreter/Bitmap-Bresenhams-line-algorithm new file mode 120000 index 0000000000..37e0c9a050 --- /dev/null +++ b/Lang/M2000-Interpreter/Bitmap-Bresenhams-line-algorithm @@ -0,0 +1 @@ +../../Task/Bitmap-Bresenhams-line-algorithm/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Bitwise-operations b/Lang/M2000-Interpreter/Bitwise-operations new file mode 120000 index 0000000000..7b5956a12b --- /dev/null +++ b/Lang/M2000-Interpreter/Bitwise-operations @@ -0,0 +1 @@ +../../Task/Bitwise-operations/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Compound-data-type b/Lang/M2000-Interpreter/Compound-data-type new file mode 120000 index 0000000000..661e74ca81 --- /dev/null +++ b/Lang/M2000-Interpreter/Compound-data-type @@ -0,0 +1 @@ +../../Task/Compound-data-type/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Count-occurrences-of-a-substring b/Lang/M2000-Interpreter/Count-occurrences-of-a-substring new file mode 120000 index 0000000000..96e93abdc4 --- /dev/null +++ b/Lang/M2000-Interpreter/Count-occurrences-of-a-substring @@ -0,0 +1 @@ +../../Task/Count-occurrences-of-a-substring/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Deal-cards-for-FreeCell b/Lang/M2000-Interpreter/Deal-cards-for-FreeCell new file mode 120000 index 0000000000..59b0374429 --- /dev/null +++ b/Lang/M2000-Interpreter/Deal-cards-for-FreeCell @@ -0,0 +1 @@ +../../Task/Deal-cards-for-FreeCell/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Doomsday-rule b/Lang/M2000-Interpreter/Doomsday-rule new file mode 120000 index 0000000000..64bda385da --- /dev/null +++ b/Lang/M2000-Interpreter/Doomsday-rule @@ -0,0 +1 @@ +../../Task/Doomsday-rule/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Egyptian-division b/Lang/M2000-Interpreter/Egyptian-division new file mode 120000 index 0000000000..ed8318ad3d --- /dev/null +++ b/Lang/M2000-Interpreter/Egyptian-division @@ -0,0 +1 @@ +../../Task/Egyptian-division/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Eulers-identity b/Lang/M2000-Interpreter/Eulers-identity new file mode 120000 index 0000000000..af0f40c33c --- /dev/null +++ b/Lang/M2000-Interpreter/Eulers-identity @@ -0,0 +1 @@ +../../Task/Eulers-identity/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Execute-Computer-Zero b/Lang/M2000-Interpreter/Execute-Computer-Zero new file mode 120000 index 0000000000..fecab5c3ec --- /dev/null +++ b/Lang/M2000-Interpreter/Execute-Computer-Zero @@ -0,0 +1 @@ +../../Task/Execute-Computer-Zero/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Fast-Fourier-transform b/Lang/M2000-Interpreter/Fast-Fourier-transform new file mode 120000 index 0000000000..e70d70854c --- /dev/null +++ b/Lang/M2000-Interpreter/Fast-Fourier-transform @@ -0,0 +1 @@ +../../Task/Fast-Fourier-transform/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Four-is-magic b/Lang/M2000-Interpreter/Four-is-magic new file mode 120000 index 0000000000..3bd19ce379 --- /dev/null +++ b/Lang/M2000-Interpreter/Four-is-magic @@ -0,0 +1 @@ +../../Task/Four-is-magic/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/ISBN13-check-digit b/Lang/M2000-Interpreter/ISBN13-check-digit new file mode 120000 index 0000000000..b320adf2bf --- /dev/null +++ b/Lang/M2000-Interpreter/ISBN13-check-digit @@ -0,0 +1 @@ +../../Task/ISBN13-check-digit/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Leonardo-numbers b/Lang/M2000-Interpreter/Leonardo-numbers new file mode 120000 index 0000000000..4f37c1babb --- /dev/null +++ b/Lang/M2000-Interpreter/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Long-multiplication b/Lang/M2000-Interpreter/Long-multiplication new file mode 120000 index 0000000000..ba1dc9bc62 --- /dev/null +++ b/Lang/M2000-Interpreter/Long-multiplication @@ -0,0 +1 @@ +../../Task/Long-multiplication/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Mastermind b/Lang/M2000-Interpreter/Mastermind new file mode 120000 index 0000000000..3cfbb80935 --- /dev/null +++ b/Lang/M2000-Interpreter/Mastermind @@ -0,0 +1 @@ +../../Task/Mastermind/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Matrix-digital-rain b/Lang/M2000-Interpreter/Matrix-digital-rain new file mode 120000 index 0000000000..c3f5d509a7 --- /dev/null +++ b/Lang/M2000-Interpreter/Matrix-digital-rain @@ -0,0 +1 @@ +../../Task/Matrix-digital-rain/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Matrix-transposition b/Lang/M2000-Interpreter/Matrix-transposition new file mode 120000 index 0000000000..5ea61d7980 --- /dev/null +++ b/Lang/M2000-Interpreter/Matrix-transposition @@ -0,0 +1 @@ +../../Task/Matrix-transposition/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Miller-Rabin-primality-test b/Lang/M2000-Interpreter/Miller-Rabin-primality-test new file mode 120000 index 0000000000..70c84948c0 --- /dev/null +++ b/Lang/M2000-Interpreter/Miller-Rabin-primality-test @@ -0,0 +1 @@ +../../Task/Miller-Rabin-primality-test/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Modified-random-distribution b/Lang/M2000-Interpreter/Modified-random-distribution new file mode 120000 index 0000000000..bbbb129f02 --- /dev/null +++ b/Lang/M2000-Interpreter/Modified-random-distribution @@ -0,0 +1 @@ +../../Task/Modified-random-distribution/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Modular-exponentiation b/Lang/M2000-Interpreter/Modular-exponentiation new file mode 120000 index 0000000000..99e9549d1a --- /dev/null +++ b/Lang/M2000-Interpreter/Modular-exponentiation @@ -0,0 +1 @@ +../../Task/Modular-exponentiation/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Morse-code b/Lang/M2000-Interpreter/Morse-code new file mode 120000 index 0000000000..77ce05e92e --- /dev/null +++ b/Lang/M2000-Interpreter/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Multi-dimensional-array b/Lang/M2000-Interpreter/Multi-dimensional-array new file mode 120000 index 0000000000..24c2948fdf --- /dev/null +++ b/Lang/M2000-Interpreter/Multi-dimensional-array @@ -0,0 +1 @@ +../../Task/Multi-dimensional-array/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Multiple-regression b/Lang/M2000-Interpreter/Multiple-regression new file mode 120000 index 0000000000..f645ea689c --- /dev/null +++ b/Lang/M2000-Interpreter/Multiple-regression @@ -0,0 +1 @@ +../../Task/Multiple-regression/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Number-names b/Lang/M2000-Interpreter/Number-names new file mode 120000 index 0000000000..acf20af45b --- /dev/null +++ b/Lang/M2000-Interpreter/Number-names @@ -0,0 +1 @@ +../../Task/Number-names/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Ordered-words b/Lang/M2000-Interpreter/Ordered-words new file mode 120000 index 0000000000..ccf0ec6f16 --- /dev/null +++ b/Lang/M2000-Interpreter/Ordered-words @@ -0,0 +1 @@ +../../Task/Ordered-words/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Periodic-table b/Lang/M2000-Interpreter/Periodic-table new file mode 120000 index 0000000000..0e286fad08 --- /dev/null +++ b/Lang/M2000-Interpreter/Periodic-table @@ -0,0 +1 @@ +../../Task/Periodic-table/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Polyspiral b/Lang/M2000-Interpreter/Polyspiral new file mode 120000 index 0000000000..f2eb619d45 --- /dev/null +++ b/Lang/M2000-Interpreter/Polyspiral @@ -0,0 +1 @@ +../../Task/Polyspiral/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Pseudo-random-numbers-Middle-square-method b/Lang/M2000-Interpreter/Pseudo-random-numbers-Middle-square-method new file mode 120000 index 0000000000..71371c48fd --- /dev/null +++ b/Lang/M2000-Interpreter/Pseudo-random-numbers-Middle-square-method @@ -0,0 +1 @@ +../../Task/Pseudo-random-numbers-Middle-square-method/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Pseudo-random-numbers-Xorshift-star b/Lang/M2000-Interpreter/Pseudo-random-numbers-Xorshift-star new file mode 120000 index 0000000000..a60ebed0a5 --- /dev/null +++ b/Lang/M2000-Interpreter/Pseudo-random-numbers-Xorshift-star @@ -0,0 +1 @@ +../../Task/Pseudo-random-numbers-Xorshift-star/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Read-a-specific-line-from-a-file b/Lang/M2000-Interpreter/Read-a-specific-line-from-a-file new file mode 120000 index 0000000000..12c1b22a47 --- /dev/null +++ b/Lang/M2000-Interpreter/Read-a-specific-line-from-a-file @@ -0,0 +1 @@ +../../Task/Read-a-specific-line-from-a-file/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Roots-of-a-quadratic-function b/Lang/M2000-Interpreter/Roots-of-a-quadratic-function new file mode 120000 index 0000000000..0f141b08fb --- /dev/null +++ b/Lang/M2000-Interpreter/Roots-of-a-quadratic-function @@ -0,0 +1 @@ +../../Task/Roots-of-a-quadratic-function/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Sort-an-integer-array b/Lang/M2000-Interpreter/Sort-an-integer-array new file mode 120000 index 0000000000..f409389d27 --- /dev/null +++ b/Lang/M2000-Interpreter/Sort-an-integer-array @@ -0,0 +1 @@ +../../Task/Sort-an-integer-array/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Sort-an-outline-at-every-level b/Lang/M2000-Interpreter/Sort-an-outline-at-every-level new file mode 120000 index 0000000000..b5c1e68e5d --- /dev/null +++ b/Lang/M2000-Interpreter/Sort-an-outline-at-every-level @@ -0,0 +1 @@ +../../Task/Sort-an-outline-at-every-level/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Taxicab-numbers b/Lang/M2000-Interpreter/Taxicab-numbers new file mode 120000 index 0000000000..6c7f58f7d6 --- /dev/null +++ b/Lang/M2000-Interpreter/Taxicab-numbers @@ -0,0 +1 @@ +../../Task/Taxicab-numbers/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Temperature-conversion b/Lang/M2000-Interpreter/Temperature-conversion new file mode 120000 index 0000000000..75d9db05ed --- /dev/null +++ b/Lang/M2000-Interpreter/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Terminal-control-Hiding-the-cursor b/Lang/M2000-Interpreter/Terminal-control-Hiding-the-cursor new file mode 120000 index 0000000000..7d9e8bacf5 --- /dev/null +++ b/Lang/M2000-Interpreter/Terminal-control-Hiding-the-cursor @@ -0,0 +1 @@ +../../Task/Terminal-control-Hiding-the-cursor/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Tree-datastructures b/Lang/M2000-Interpreter/Tree-datastructures new file mode 120000 index 0000000000..1fa6a47d52 --- /dev/null +++ b/Lang/M2000-Interpreter/Tree-datastructures @@ -0,0 +1 @@ +../../Task/Tree-datastructures/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Truth-table b/Lang/M2000-Interpreter/Truth-table new file mode 120000 index 0000000000..b77fe8354b --- /dev/null +++ b/Lang/M2000-Interpreter/Truth-table @@ -0,0 +1 @@ +../../Task/Truth-table/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Ultra-useful-primes b/Lang/M2000-Interpreter/Ultra-useful-primes new file mode 120000 index 0000000000..5330980a0e --- /dev/null +++ b/Lang/M2000-Interpreter/Ultra-useful-primes @@ -0,0 +1 @@ +../../Task/Ultra-useful-primes/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Video-display-modes b/Lang/M2000-Interpreter/Video-display-modes new file mode 120000 index 0000000000..39ee17dc2d --- /dev/null +++ b/Lang/M2000-Interpreter/Video-display-modes @@ -0,0 +1 @@ +../../Task/Video-display-modes/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Window-management b/Lang/M2000-Interpreter/Window-management new file mode 120000 index 0000000000..bb8ac9e26a --- /dev/null +++ b/Lang/M2000-Interpreter/Window-management @@ -0,0 +1 @@ +../../Task/Window-management/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Write-language-name-in-3D-ASCII b/Lang/M2000-Interpreter/Write-language-name-in-3D-ASCII new file mode 120000 index 0000000000..3ec6cbeb80 --- /dev/null +++ b/Lang/M2000-Interpreter/Write-language-name-in-3D-ASCII @@ -0,0 +1 @@ +../../Task/Write-language-name-in-3D-ASCII/M2000-Interpreter \ No newline at end of file diff --git a/Lang/MAD/Arithmetic-derivative b/Lang/MAD/Arithmetic-derivative new file mode 120000 index 0000000000..e7c006ae6c --- /dev/null +++ b/Lang/MAD/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/MAD \ No newline at end of file diff --git a/Lang/Miranda/Align-columns b/Lang/Miranda/Align-columns new file mode 120000 index 0000000000..ca88577a8d --- /dev/null +++ b/Lang/Miranda/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Miranda \ No newline at end of file diff --git a/Lang/Miranda/Arithmetic-derivative b/Lang/Miranda/Arithmetic-derivative new file mode 120000 index 0000000000..91683ddf96 --- /dev/null +++ b/Lang/Miranda/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/Miranda \ No newline at end of file diff --git a/Lang/Miranda/Bell-numbers b/Lang/Miranda/Bell-numbers new file mode 120000 index 0000000000..6635e596b0 --- /dev/null +++ b/Lang/Miranda/Bell-numbers @@ -0,0 +1 @@ +../../Task/Bell-numbers/Miranda \ No newline at end of file diff --git a/Lang/Miranda/Doomsday-rule b/Lang/Miranda/Doomsday-rule new file mode 120000 index 0000000000..91e25767d0 --- /dev/null +++ b/Lang/Miranda/Doomsday-rule @@ -0,0 +1 @@ +../../Task/Doomsday-rule/Miranda \ No newline at end of file diff --git a/Lang/Miranda/Isqrt-integer-square-root-of-X b/Lang/Miranda/Isqrt-integer-square-root-of-X new file mode 120000 index 0000000000..4b479d99e5 --- /dev/null +++ b/Lang/Miranda/Isqrt-integer-square-root-of-X @@ -0,0 +1 @@ +../../Task/Isqrt-integer-square-root-of-X/Miranda \ No newline at end of file diff --git a/Lang/Miranda/Leonardo-numbers b/Lang/Miranda/Leonardo-numbers new file mode 120000 index 0000000000..6f062a014a --- /dev/null +++ b/Lang/Miranda/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/Miranda \ No newline at end of file diff --git a/Lang/Miranda/Mutual-recursion b/Lang/Miranda/Mutual-recursion new file mode 120000 index 0000000000..42af709518 --- /dev/null +++ b/Lang/Miranda/Mutual-recursion @@ -0,0 +1 @@ +../../Task/Mutual-recursion/Miranda \ No newline at end of file diff --git a/Lang/Modula-2/Luhn-test-of-credit-card-numbers b/Lang/Modula-2/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..7ff802d85c --- /dev/null +++ b/Lang/Modula-2/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/Modula-2 \ No newline at end of file diff --git a/Lang/Modula-2/Nth-root b/Lang/Modula-2/Nth-root new file mode 120000 index 0000000000..0efaa69472 --- /dev/null +++ b/Lang/Modula-2/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/Modula-2 \ No newline at end of file diff --git a/Lang/Modula-2/Periodic-table b/Lang/Modula-2/Periodic-table new file mode 120000 index 0000000000..20953bda9a --- /dev/null +++ b/Lang/Modula-2/Periodic-table @@ -0,0 +1 @@ +../../Task/Periodic-table/Modula-2 \ No newline at end of file diff --git a/Lang/Modula-2/Temperature-conversion b/Lang/Modula-2/Temperature-conversion new file mode 120000 index 0000000000..fa236503d3 --- /dev/null +++ b/Lang/Modula-2/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/Modula-2 \ No newline at end of file diff --git a/Lang/Modula-2/Tic-tac-toe b/Lang/Modula-2/Tic-tac-toe new file mode 120000 index 0000000000..21b0370c7a --- /dev/null +++ b/Lang/Modula-2/Tic-tac-toe @@ -0,0 +1 @@ +../../Task/Tic-tac-toe/Modula-2 \ No newline at end of file diff --git a/Lang/Nascom-BASIC/Dragon-curve b/Lang/Nascom-BASIC/Dragon-curve new file mode 120000 index 0000000000..36b4172957 --- /dev/null +++ b/Lang/Nascom-BASIC/Dragon-curve @@ -0,0 +1 @@ +../../Task/Dragon-curve/Nascom-BASIC \ No newline at end of file diff --git a/Lang/Nascom-BASIC/Luhn-test-of-credit-card-numbers b/Lang/Nascom-BASIC/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..1d7e8b0698 --- /dev/null +++ b/Lang/Nascom-BASIC/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/Nascom-BASIC \ No newline at end of file diff --git a/Lang/NetRexx/00-LANG.txt b/Lang/NetRexx/00-LANG.txt index f110c9bdb8..3f624ad431 100644 --- a/Lang/NetRexx/00-LANG.txt +++ b/Lang/NetRexx/00-LANG.txt @@ -29,7 +29,7 @@ as languages such as Java, while preserving the low threshold to learning and th On the 8th of June 2011, IBM transferred ownership of the reference implementation of NetRexx to The Rexx Language Association (RexxLA) for administration under the [http://site.icu-project.org ICU - International Components for Unicode] open source license. -On September 12th 2022, NetRexx 4.04 was released +On March 3rd, 2024, NetRexx 4.06-GA was released. ==== Useful Links ==== * [http://www.netrexx.org The NetRexx Programming Language - www.netrexx.org] diff --git a/Lang/Object-Pascal/Sorting-algorithms-Shell-sort b/Lang/Object-Pascal/Sorting-algorithms-Shell-sort new file mode 120000 index 0000000000..6ae9067d88 --- /dev/null +++ b/Lang/Object-Pascal/Sorting-algorithms-Shell-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Shell-sort/Object-Pascal \ No newline at end of file diff --git a/Lang/Octave/Peripheral-drift-illusion b/Lang/Octave/Peripheral-drift-illusion new file mode 120000 index 0000000000..9bda77fd28 --- /dev/null +++ b/Lang/Octave/Peripheral-drift-illusion @@ -0,0 +1 @@ +../../Task/Peripheral-drift-illusion/Octave \ No newline at end of file diff --git a/Lang/Odin/Sieve-of-Eratosthenes b/Lang/Odin/Sieve-of-Eratosthenes new file mode 120000 index 0000000000..265789a7db --- /dev/null +++ b/Lang/Odin/Sieve-of-Eratosthenes @@ -0,0 +1 @@ +../../Task/Sieve-of-Eratosthenes/Odin \ No newline at end of file diff --git a/Lang/OoRexx/Nth-root b/Lang/OoRexx/Nth-root new file mode 120000 index 0000000000..05543d43a8 --- /dev/null +++ b/Lang/OoRexx/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/OoRexx \ No newline at end of file diff --git a/Lang/OoRexx/Sorting-algorithms-Merge-sort b/Lang/OoRexx/Sorting-algorithms-Merge-sort new file mode 120000 index 0000000000..ae6f4594d4 --- /dev/null +++ b/Lang/OoRexx/Sorting-algorithms-Merge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Merge-sort/OoRexx \ No newline at end of file diff --git a/Lang/OxygenBasic/Blum-integer b/Lang/OxygenBasic/Blum-integer new file mode 120000 index 0000000000..343ecf7af1 --- /dev/null +++ b/Lang/OxygenBasic/Blum-integer @@ -0,0 +1 @@ +../../Task/Blum-integer/OxygenBasic \ No newline at end of file diff --git a/Lang/OxygenBasic/Eban-numbers b/Lang/OxygenBasic/Eban-numbers new file mode 120000 index 0000000000..4b362db2df --- /dev/null +++ b/Lang/OxygenBasic/Eban-numbers @@ -0,0 +1 @@ +../../Task/Eban-numbers/OxygenBasic \ No newline at end of file diff --git a/Lang/PARI-GP/Achilles-numbers b/Lang/PARI-GP/Achilles-numbers new file mode 120000 index 0000000000..73f3f645b5 --- /dev/null +++ b/Lang/PARI-GP/Achilles-numbers @@ -0,0 +1 @@ +../../Task/Achilles-numbers/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Almkvist-Giullera-formula-for-pi b/Lang/PARI-GP/Almkvist-Giullera-formula-for-pi new file mode 120000 index 0000000000..53d950c5f0 --- /dev/null +++ b/Lang/PARI-GP/Almkvist-Giullera-formula-for-pi @@ -0,0 +1 @@ +../../Task/Almkvist-Giullera-formula-for-pi/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Bell-numbers b/Lang/PARI-GP/Bell-numbers new file mode 120000 index 0000000000..c0de777713 --- /dev/null +++ b/Lang/PARI-GP/Bell-numbers @@ -0,0 +1 @@ +../../Task/Bell-numbers/PARI-GP \ No newline at end of file diff --git a/Lang/PHP/Angle-difference-between-two-bearings b/Lang/PHP/Angle-difference-between-two-bearings new file mode 120000 index 0000000000..357602b50f --- /dev/null +++ b/Lang/PHP/Angle-difference-between-two-bearings @@ -0,0 +1 @@ +../../Task/Angle-difference-between-two-bearings/PHP \ No newline at end of file diff --git a/Lang/PHP/Horizontal-sundial-calculations b/Lang/PHP/Horizontal-sundial-calculations new file mode 120000 index 0000000000..a385f37a68 --- /dev/null +++ b/Lang/PHP/Horizontal-sundial-calculations @@ -0,0 +1 @@ +../../Task/Horizontal-sundial-calculations/PHP \ No newline at end of file diff --git a/Lang/PHP/Leonardo-numbers b/Lang/PHP/Leonardo-numbers new file mode 120000 index 0000000000..4b3cefd6f0 --- /dev/null +++ b/Lang/PHP/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/PHP \ No newline at end of file diff --git a/Lang/PL-I-80/Square-free-integers b/Lang/PL-I-80/Square-free-integers new file mode 120000 index 0000000000..6f8a00edb8 --- /dev/null +++ b/Lang/PL-I-80/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/PL-I-80 \ No newline at end of file diff --git a/Lang/PL-I/Arithmetic-derivative b/Lang/PL-I/Arithmetic-derivative new file mode 120000 index 0000000000..37f109623d --- /dev/null +++ b/Lang/PL-I/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/PL-I \ No newline at end of file diff --git a/Lang/PL-M/Arithmetic-derivative b/Lang/PL-M/Arithmetic-derivative new file mode 120000 index 0000000000..13f3e396fe --- /dev/null +++ b/Lang/PL-M/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/PL-M \ No newline at end of file diff --git a/Lang/PascalABC.NET/Babbage-problem b/Lang/PascalABC.NET/Babbage-problem new file mode 120000 index 0000000000..0c9b0d20ea --- /dev/null +++ b/Lang/PascalABC.NET/Babbage-problem @@ -0,0 +1 @@ +../../Task/Babbage-problem/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Catalan-numbers-Pascals-triangle b/Lang/PascalABC.NET/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..47a30d7f38 --- /dev/null +++ b/Lang/PascalABC.NET/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Dijkstras-algorithm b/Lang/PascalABC.NET/Dijkstras-algorithm new file mode 120000 index 0000000000..d9c1782412 --- /dev/null +++ b/Lang/PascalABC.NET/Dijkstras-algorithm @@ -0,0 +1 @@ +../../Task/Dijkstras-algorithm/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Fast-Fourier-transform b/Lang/PascalABC.NET/Fast-Fourier-transform new file mode 120000 index 0000000000..2ebeb31f36 --- /dev/null +++ b/Lang/PascalABC.NET/Fast-Fourier-transform @@ -0,0 +1 @@ +../../Task/Fast-Fourier-transform/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Gaussian-elimination b/Lang/PascalABC.NET/Gaussian-elimination new file mode 120000 index 0000000000..263ffc6099 --- /dev/null +++ b/Lang/PascalABC.NET/Gaussian-elimination @@ -0,0 +1 @@ +../../Task/Gaussian-elimination/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Generate-Chess960-starting-position b/Lang/PascalABC.NET/Generate-Chess960-starting-position new file mode 120000 index 0000000000..0f95aaeb00 --- /dev/null +++ b/Lang/PascalABC.NET/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Goldbachs-comet b/Lang/PascalABC.NET/Goldbachs-comet new file mode 120000 index 0000000000..01fcc2a336 --- /dev/null +++ b/Lang/PascalABC.NET/Goldbachs-comet @@ -0,0 +1 @@ +../../Task/Goldbachs-comet/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Haversine-formula b/Lang/PascalABC.NET/Haversine-formula new file mode 120000 index 0000000000..505d4c95b1 --- /dev/null +++ b/Lang/PascalABC.NET/Haversine-formula @@ -0,0 +1 @@ +../../Task/Haversine-formula/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Heronian-triangles b/Lang/PascalABC.NET/Heronian-triangles new file mode 120000 index 0000000000..38597384c9 --- /dev/null +++ b/Lang/PascalABC.NET/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Hex-words b/Lang/PascalABC.NET/Hex-words new file mode 120000 index 0000000000..487faee543 --- /dev/null +++ b/Lang/PascalABC.NET/Hex-words @@ -0,0 +1 @@ +../../Task/Hex-words/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Hickerson-series-of-almost-integers b/Lang/PascalABC.NET/Hickerson-series-of-almost-integers new file mode 120000 index 0000000000..8789a0cbe0 --- /dev/null +++ b/Lang/PascalABC.NET/Hickerson-series-of-almost-integers @@ -0,0 +1 @@ +../../Task/Hickerson-series-of-almost-integers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Hofstadter-Conway-$10-000-sequence b/Lang/PascalABC.NET/Hofstadter-Conway-$10-000-sequence new file mode 120000 index 0000000000..6f07522b20 --- /dev/null +++ b/Lang/PascalABC.NET/Hofstadter-Conway-$10-000-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Conway-$10-000-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Hofstadter-Figure-Figure-sequences b/Lang/PascalABC.NET/Hofstadter-Figure-Figure-sequences new file mode 120000 index 0000000000..658c56f7ad --- /dev/null +++ b/Lang/PascalABC.NET/Hofstadter-Figure-Figure-sequences @@ -0,0 +1 @@ +../../Task/Hofstadter-Figure-Figure-sequences/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Hofstadter-Q-sequence b/Lang/PascalABC.NET/Hofstadter-Q-sequence new file mode 120000 index 0000000000..454e935a80 --- /dev/null +++ b/Lang/PascalABC.NET/Hofstadter-Q-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Q-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Horizontal-sundial-calculations b/Lang/PascalABC.NET/Horizontal-sundial-calculations new file mode 120000 index 0000000000..6ab4227b2a --- /dev/null +++ b/Lang/PascalABC.NET/Horizontal-sundial-calculations @@ -0,0 +1 @@ +../../Task/Horizontal-sundial-calculations/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Humble-numbers b/Lang/PascalABC.NET/Humble-numbers new file mode 120000 index 0000000000..ee2cb9aa95 --- /dev/null +++ b/Lang/PascalABC.NET/Humble-numbers @@ -0,0 +1 @@ +../../Task/Humble-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/IBAN b/Lang/PascalABC.NET/IBAN new file mode 120000 index 0000000000..2a1610e29a --- /dev/null +++ b/Lang/PascalABC.NET/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/ISBN13-check-digit b/Lang/PascalABC.NET/ISBN13-check-digit new file mode 120000 index 0000000000..1cc5a9193a --- /dev/null +++ b/Lang/PascalABC.NET/ISBN13-check-digit @@ -0,0 +1 @@ +../../Task/ISBN13-check-digit/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Increasing-gaps-between-consecutive-Niven-numbers b/Lang/PascalABC.NET/Increasing-gaps-between-consecutive-Niven-numbers new file mode 120000 index 0000000000..cff91f6819 --- /dev/null +++ b/Lang/PascalABC.NET/Increasing-gaps-between-consecutive-Niven-numbers @@ -0,0 +1 @@ +../../Task/Increasing-gaps-between-consecutive-Niven-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Intersecting-number-wheels b/Lang/PascalABC.NET/Intersecting-number-wheels new file mode 120000 index 0000000000..5d79870677 --- /dev/null +++ b/Lang/PascalABC.NET/Intersecting-number-wheels @@ -0,0 +1 @@ +../../Task/Intersecting-number-wheels/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Isograms-and-heterograms b/Lang/PascalABC.NET/Isograms-and-heterograms new file mode 120000 index 0000000000..bf330eefcd --- /dev/null +++ b/Lang/PascalABC.NET/Isograms-and-heterograms @@ -0,0 +1 @@ +../../Task/Isograms-and-heterograms/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Isqrt-integer-square-root-of-X b/Lang/PascalABC.NET/Isqrt-integer-square-root-of-X new file mode 120000 index 0000000000..5e922bc6f6 --- /dev/null +++ b/Lang/PascalABC.NET/Isqrt-integer-square-root-of-X @@ -0,0 +1 @@ +../../Task/Isqrt-integer-square-root-of-X/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Iterated-digits-squaring b/Lang/PascalABC.NET/Iterated-digits-squaring new file mode 120000 index 0000000000..d26b072d9f --- /dev/null +++ b/Lang/PascalABC.NET/Iterated-digits-squaring @@ -0,0 +1 @@ +../../Task/Iterated-digits-squaring/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Jacobi-symbol b/Lang/PascalABC.NET/Jacobi-symbol new file mode 120000 index 0000000000..beae5f110d --- /dev/null +++ b/Lang/PascalABC.NET/Jacobi-symbol @@ -0,0 +1 @@ +../../Task/Jacobi-symbol/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Jacobsthal-numbers b/Lang/PascalABC.NET/Jacobsthal-numbers new file mode 120000 index 0000000000..876df13cd2 --- /dev/null +++ b/Lang/PascalABC.NET/Jacobsthal-numbers @@ -0,0 +1 @@ +../../Task/Jacobsthal-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Jensens-Device b/Lang/PascalABC.NET/Jensens-Device new file mode 120000 index 0000000000..b995733017 --- /dev/null +++ b/Lang/PascalABC.NET/Jensens-Device @@ -0,0 +1 @@ +../../Task/Jensens-Device/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/JortSort b/Lang/PascalABC.NET/JortSort new file mode 120000 index 0000000000..7235c60479 --- /dev/null +++ b/Lang/PascalABC.NET/JortSort @@ -0,0 +1 @@ +../../Task/JortSort/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Josephus-problem b/Lang/PascalABC.NET/Josephus-problem new file mode 120000 index 0000000000..b62f88327b --- /dev/null +++ b/Lang/PascalABC.NET/Josephus-problem @@ -0,0 +1 @@ +../../Task/Josephus-problem/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Juggler-sequence b/Lang/PascalABC.NET/Juggler-sequence new file mode 120000 index 0000000000..11d7432b3c --- /dev/null +++ b/Lang/PascalABC.NET/Juggler-sequence @@ -0,0 +1 @@ +../../Task/Juggler-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Julia-set b/Lang/PascalABC.NET/Julia-set new file mode 120000 index 0000000000..905a140bc7 --- /dev/null +++ b/Lang/PascalABC.NET/Julia-set @@ -0,0 +1 @@ +../../Task/Julia-set/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Kernighans-large-earthquake-problem b/Lang/PascalABC.NET/Kernighans-large-earthquake-problem new file mode 120000 index 0000000000..bfd99d6f53 --- /dev/null +++ b/Lang/PascalABC.NET/Kernighans-large-earthquake-problem @@ -0,0 +1 @@ +../../Task/Kernighans-large-earthquake-problem/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Knapsack-problem-0-1 b/Lang/PascalABC.NET/Knapsack-problem-0-1 new file mode 120000 index 0000000000..2fbfd42a60 --- /dev/null +++ b/Lang/PascalABC.NET/Knapsack-problem-0-1 @@ -0,0 +1 @@ +../../Task/Knapsack-problem-0-1/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Knuths-algorithm-S b/Lang/PascalABC.NET/Knuths-algorithm-S new file mode 120000 index 0000000000..5898ddfb2a --- /dev/null +++ b/Lang/PascalABC.NET/Knuths-algorithm-S @@ -0,0 +1 @@ +../../Task/Knuths-algorithm-S/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Knuths-power-tree b/Lang/PascalABC.NET/Knuths-power-tree new file mode 120000 index 0000000000..985187fb94 --- /dev/null +++ b/Lang/PascalABC.NET/Knuths-power-tree @@ -0,0 +1 @@ +../../Task/Knuths-power-tree/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Kolakoski-sequence b/Lang/PascalABC.NET/Kolakoski-sequence new file mode 120000 index 0000000000..141e5ac2f1 --- /dev/null +++ b/Lang/PascalABC.NET/Kolakoski-sequence @@ -0,0 +1 @@ +../../Task/Kolakoski-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Kosaraju b/Lang/PascalABC.NET/Kosaraju new file mode 120000 index 0000000000..b461c7f092 --- /dev/null +++ b/Lang/PascalABC.NET/Kosaraju @@ -0,0 +1 @@ +../../Task/Kosaraju/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Kronecker-product b/Lang/PascalABC.NET/Kronecker-product new file mode 120000 index 0000000000..d78d832294 --- /dev/null +++ b/Lang/PascalABC.NET/Kronecker-product @@ -0,0 +1 @@ +../../Task/Kronecker-product/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Kronecker-product-based-fractals b/Lang/PascalABC.NET/Kronecker-product-based-fractals new file mode 120000 index 0000000000..47d2054ae1 --- /dev/null +++ b/Lang/PascalABC.NET/Kronecker-product-based-fractals @@ -0,0 +1 @@ +../../Task/Kronecker-product-based-fractals/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/LZW-compression b/Lang/PascalABC.NET/LZW-compression new file mode 120000 index 0000000000..caca350ee1 --- /dev/null +++ b/Lang/PascalABC.NET/LZW-compression @@ -0,0 +1 @@ +../../Task/LZW-compression/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Lah-numbers b/Lang/PascalABC.NET/Lah-numbers new file mode 120000 index 0000000000..6d00cf7c92 --- /dev/null +++ b/Lang/PascalABC.NET/Lah-numbers @@ -0,0 +1 @@ +../../Task/Lah-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Langtons-ant b/Lang/PascalABC.NET/Langtons-ant new file mode 120000 index 0000000000..7c98b40d3c --- /dev/null +++ b/Lang/PascalABC.NET/Langtons-ant @@ -0,0 +1 @@ +../../Task/Langtons-ant/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Largest-int-from-concatenated-ints b/Lang/PascalABC.NET/Largest-int-from-concatenated-ints new file mode 120000 index 0000000000..97fdfc9525 --- /dev/null +++ b/Lang/PascalABC.NET/Largest-int-from-concatenated-ints @@ -0,0 +1 @@ +../../Task/Largest-int-from-concatenated-ints/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Largest-number-divisible-by-its-digits b/Lang/PascalABC.NET/Largest-number-divisible-by-its-digits new file mode 120000 index 0000000000..40a547007f --- /dev/null +++ b/Lang/PascalABC.NET/Largest-number-divisible-by-its-digits @@ -0,0 +1 @@ +../../Task/Largest-number-divisible-by-its-digits/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Largest-proper-divisor-of-n b/Lang/PascalABC.NET/Largest-proper-divisor-of-n new file mode 120000 index 0000000000..2988b13d98 --- /dev/null +++ b/Lang/PascalABC.NET/Largest-proper-divisor-of-n @@ -0,0 +1 @@ +../../Task/Largest-proper-divisor-of-n/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Last-Friday-of-each-month b/Lang/PascalABC.NET/Last-Friday-of-each-month new file mode 120000 index 0000000000..bcb04c8152 --- /dev/null +++ b/Lang/PascalABC.NET/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Last-letter-first-letter b/Lang/PascalABC.NET/Last-letter-first-letter new file mode 120000 index 0000000000..19b2a978ef --- /dev/null +++ b/Lang/PascalABC.NET/Last-letter-first-letter @@ -0,0 +1 @@ +../../Task/Last-letter-first-letter/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Law-of-cosines---triples b/Lang/PascalABC.NET/Law-of-cosines---triples new file mode 120000 index 0000000000..c3f4700866 --- /dev/null +++ b/Lang/PascalABC.NET/Law-of-cosines---triples @@ -0,0 +1 @@ +../../Task/Law-of-cosines---triples/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Leonardo-numbers b/Lang/PascalABC.NET/Leonardo-numbers new file mode 120000 index 0000000000..0895bc3d59 --- /dev/null +++ b/Lang/PascalABC.NET/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Levenshtein-distance b/Lang/PascalABC.NET/Levenshtein-distance new file mode 120000 index 0000000000..e32fc71042 --- /dev/null +++ b/Lang/PascalABC.NET/Levenshtein-distance @@ -0,0 +1 @@ +../../Task/Levenshtein-distance/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Literals-Integer b/Lang/PascalABC.NET/Literals-Integer new file mode 120000 index 0000000000..a9aac3cffe --- /dev/null +++ b/Lang/PascalABC.NET/Literals-Integer @@ -0,0 +1 @@ +../../Task/Literals-Integer/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Logistic-curve-fitting-in-epidemiology b/Lang/PascalABC.NET/Logistic-curve-fitting-in-epidemiology new file mode 120000 index 0000000000..9ae308e46e --- /dev/null +++ b/Lang/PascalABC.NET/Logistic-curve-fitting-in-epidemiology @@ -0,0 +1 @@ +../../Task/Logistic-curve-fitting-in-epidemiology/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Long-literals-with-continuations b/Lang/PascalABC.NET/Long-literals-with-continuations new file mode 120000 index 0000000000..cef817d9b6 --- /dev/null +++ b/Lang/PascalABC.NET/Long-literals-with-continuations @@ -0,0 +1 @@ +../../Task/Long-literals-with-continuations/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Long-multiplication b/Lang/PascalABC.NET/Long-multiplication new file mode 120000 index 0000000000..3da90eb79b --- /dev/null +++ b/Lang/PascalABC.NET/Long-multiplication @@ -0,0 +1 @@ +../../Task/Long-multiplication/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Long-primes b/Lang/PascalABC.NET/Long-primes new file mode 120000 index 0000000000..f90c1c5b51 --- /dev/null +++ b/Lang/PascalABC.NET/Long-primes @@ -0,0 +1 @@ +../../Task/Long-primes/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Long-year b/Lang/PascalABC.NET/Long-year new file mode 120000 index 0000000000..cfbd0a990c --- /dev/null +++ b/Lang/PascalABC.NET/Long-year @@ -0,0 +1 @@ +../../Task/Long-year/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Longest-common-substring b/Lang/PascalABC.NET/Longest-common-substring new file mode 120000 index 0000000000..c8e27105a8 --- /dev/null +++ b/Lang/PascalABC.NET/Longest-common-substring @@ -0,0 +1 @@ +../../Task/Longest-common-substring/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Longest-increasing-subsequence b/Lang/PascalABC.NET/Longest-increasing-subsequence new file mode 120000 index 0000000000..256a8afb28 --- /dev/null +++ b/Lang/PascalABC.NET/Longest-increasing-subsequence @@ -0,0 +1 @@ +../../Task/Longest-increasing-subsequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Look-and-say-sequence b/Lang/PascalABC.NET/Look-and-say-sequence new file mode 120000 index 0000000000..a23016f201 --- /dev/null +++ b/Lang/PascalABC.NET/Look-and-say-sequence @@ -0,0 +1 @@ +../../Task/Look-and-say-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Lucas-Lehmer-test b/Lang/PascalABC.NET/Lucas-Lehmer-test new file mode 120000 index 0000000000..bec917b045 --- /dev/null +++ b/Lang/PascalABC.NET/Lucas-Lehmer-test @@ -0,0 +1 @@ +../../Task/Lucas-Lehmer-test/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Ludic-numbers b/Lang/PascalABC.NET/Ludic-numbers new file mode 120000 index 0000000000..84c5abb4fd --- /dev/null +++ b/Lang/PascalABC.NET/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Luhn-test-of-credit-card-numbers b/Lang/PascalABC.NET/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..00804b09b8 --- /dev/null +++ b/Lang/PascalABC.NET/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Lychrel-numbers b/Lang/PascalABC.NET/Lychrel-numbers new file mode 120000 index 0000000000..c6935e364e --- /dev/null +++ b/Lang/PascalABC.NET/Lychrel-numbers @@ -0,0 +1 @@ +../../Task/Lychrel-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/M-bius-function b/Lang/PascalABC.NET/M-bius-function new file mode 120000 index 0000000000..e6445ec3ed --- /dev/null +++ b/Lang/PascalABC.NET/M-bius-function @@ -0,0 +1 @@ +../../Task/M-bius-function/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/MAC-vendor-lookup b/Lang/PascalABC.NET/MAC-vendor-lookup new file mode 120000 index 0000000000..d35cdd8c9b --- /dev/null +++ b/Lang/PascalABC.NET/MAC-vendor-lookup @@ -0,0 +1 @@ +../../Task/MAC-vendor-lookup/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/MD5 b/Lang/PascalABC.NET/MD5 new file mode 120000 index 0000000000..375523a297 --- /dev/null +++ b/Lang/PascalABC.NET/MD5 @@ -0,0 +1 @@ +../../Task/MD5/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Magic-constant b/Lang/PascalABC.NET/Magic-constant new file mode 120000 index 0000000000..822ebb4fb2 --- /dev/null +++ b/Lang/PascalABC.NET/Magic-constant @@ -0,0 +1 @@ +../../Task/Magic-constant/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Magic-squares-of-doubly-even-order b/Lang/PascalABC.NET/Magic-squares-of-doubly-even-order new file mode 120000 index 0000000000..b8c93bc64a --- /dev/null +++ b/Lang/PascalABC.NET/Magic-squares-of-doubly-even-order @@ -0,0 +1 @@ +../../Task/Magic-squares-of-doubly-even-order/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Magnanimous-numbers b/Lang/PascalABC.NET/Magnanimous-numbers new file mode 120000 index 0000000000..0a895d4414 --- /dev/null +++ b/Lang/PascalABC.NET/Magnanimous-numbers @@ -0,0 +1 @@ +../../Task/Magnanimous-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Map-range b/Lang/PascalABC.NET/Map-range new file mode 120000 index 0000000000..2c5d9ac526 --- /dev/null +++ b/Lang/PascalABC.NET/Map-range @@ -0,0 +1 @@ +../../Task/Map-range/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Maximum-triangle-path-sum b/Lang/PascalABC.NET/Maximum-triangle-path-sum new file mode 120000 index 0000000000..d476233920 --- /dev/null +++ b/Lang/PascalABC.NET/Maximum-triangle-path-sum @@ -0,0 +1 @@ +../../Task/Maximum-triangle-path-sum/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Maze-generation b/Lang/PascalABC.NET/Maze-generation new file mode 120000 index 0000000000..147e928cb8 --- /dev/null +++ b/Lang/PascalABC.NET/Maze-generation @@ -0,0 +1 @@ +../../Task/Maze-generation/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/McNuggets-problem b/Lang/PascalABC.NET/McNuggets-problem new file mode 120000 index 0000000000..ceb4630090 --- /dev/null +++ b/Lang/PascalABC.NET/McNuggets-problem @@ -0,0 +1 @@ +../../Task/McNuggets-problem/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Meissel-Mertens-constant b/Lang/PascalABC.NET/Meissel-Mertens-constant new file mode 120000 index 0000000000..96e15ce1b8 --- /dev/null +++ b/Lang/PascalABC.NET/Meissel-Mertens-constant @@ -0,0 +1 @@ +../../Task/Meissel-Mertens-constant/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Mertens-function b/Lang/PascalABC.NET/Mertens-function new file mode 120000 index 0000000000..f3e21033e6 --- /dev/null +++ b/Lang/PascalABC.NET/Mertens-function @@ -0,0 +1 @@ +../../Task/Mertens-function/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Metallic-ratios b/Lang/PascalABC.NET/Metallic-ratios new file mode 120000 index 0000000000..1f47416b87 --- /dev/null +++ b/Lang/PascalABC.NET/Metallic-ratios @@ -0,0 +1 @@ +../../Task/Metallic-ratios/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Metered-concurrency b/Lang/PascalABC.NET/Metered-concurrency new file mode 120000 index 0000000000..925b288d53 --- /dev/null +++ b/Lang/PascalABC.NET/Metered-concurrency @@ -0,0 +1 @@ +../../Task/Metered-concurrency/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Mian-Chowla-sequence b/Lang/PascalABC.NET/Mian-Chowla-sequence new file mode 120000 index 0000000000..8a0250e208 --- /dev/null +++ b/Lang/PascalABC.NET/Mian-Chowla-sequence @@ -0,0 +1 @@ +../../Task/Mian-Chowla-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Middle-three-digits b/Lang/PascalABC.NET/Middle-three-digits new file mode 120000 index 0000000000..5e135c1794 --- /dev/null +++ b/Lang/PascalABC.NET/Middle-three-digits @@ -0,0 +1 @@ +../../Task/Middle-three-digits/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Miller-Rabin-primality-test b/Lang/PascalABC.NET/Miller-Rabin-primality-test new file mode 120000 index 0000000000..629803a659 --- /dev/null +++ b/Lang/PascalABC.NET/Miller-Rabin-primality-test @@ -0,0 +1 @@ +../../Task/Miller-Rabin-primality-test/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Minimum-multiple-of-m-where-digital-sum-equals-m b/Lang/PascalABC.NET/Minimum-multiple-of-m-where-digital-sum-equals-m new file mode 120000 index 0000000000..97c186fb9d --- /dev/null +++ b/Lang/PascalABC.NET/Minimum-multiple-of-m-where-digital-sum-equals-m @@ -0,0 +1 @@ +../../Task/Minimum-multiple-of-m-where-digital-sum-equals-m/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Modified-random-distribution b/Lang/PascalABC.NET/Modified-random-distribution new file mode 120000 index 0000000000..0b45ed8c91 --- /dev/null +++ b/Lang/PascalABC.NET/Modified-random-distribution @@ -0,0 +1 @@ +../../Task/Modified-random-distribution/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Modular-inverse b/Lang/PascalABC.NET/Modular-inverse new file mode 120000 index 0000000000..cf592b925c --- /dev/null +++ b/Lang/PascalABC.NET/Modular-inverse @@ -0,0 +1 @@ +../../Task/Modular-inverse/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Monty-Hall-problem b/Lang/PascalABC.NET/Monty-Hall-problem new file mode 120000 index 0000000000..194ee5c033 --- /dev/null +++ b/Lang/PascalABC.NET/Monty-Hall-problem @@ -0,0 +1 @@ +../../Task/Monty-Hall-problem/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Morse-code b/Lang/PascalABC.NET/Morse-code new file mode 120000 index 0000000000..957358167f --- /dev/null +++ b/Lang/PascalABC.NET/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Motzkin-numbers b/Lang/PascalABC.NET/Motzkin-numbers new file mode 120000 index 0000000000..119a6ee6b9 --- /dev/null +++ b/Lang/PascalABC.NET/Motzkin-numbers @@ -0,0 +1 @@ +../../Task/Motzkin-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Move-to-front-algorithm b/Lang/PascalABC.NET/Move-to-front-algorithm new file mode 120000 index 0000000000..e365638bb3 --- /dev/null +++ b/Lang/PascalABC.NET/Move-to-front-algorithm @@ -0,0 +1 @@ +../../Task/Move-to-front-algorithm/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Multifactorial b/Lang/PascalABC.NET/Multifactorial new file mode 120000 index 0000000000..1a4d72f284 --- /dev/null +++ b/Lang/PascalABC.NET/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Multiple-regression b/Lang/PascalABC.NET/Multiple-regression new file mode 120000 index 0000000000..c2b1f827d2 --- /dev/null +++ b/Lang/PascalABC.NET/Multiple-regression @@ -0,0 +1 @@ +../../Task/Multiple-regression/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Munchausen-numbers b/Lang/PascalABC.NET/Munchausen-numbers new file mode 120000 index 0000000000..e5388bf0cf --- /dev/null +++ b/Lang/PascalABC.NET/Munchausen-numbers @@ -0,0 +1 @@ +../../Task/Munchausen-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Musical-scale b/Lang/PascalABC.NET/Musical-scale new file mode 120000 index 0000000000..33d370124c --- /dev/null +++ b/Lang/PascalABC.NET/Musical-scale @@ -0,0 +1 @@ +../../Task/Musical-scale/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/N-queens-problem b/Lang/PascalABC.NET/N-queens-problem new file mode 120000 index 0000000000..d0df5430cc --- /dev/null +++ b/Lang/PascalABC.NET/N-queens-problem @@ -0,0 +1 @@ +../../Task/N-queens-problem/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Named-parameters b/Lang/PascalABC.NET/Named-parameters new file mode 120000 index 0000000000..f91e295fc0 --- /dev/null +++ b/Lang/PascalABC.NET/Named-parameters @@ -0,0 +1 @@ +../../Task/Named-parameters/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Narcissistic-decimal-number b/Lang/PascalABC.NET/Narcissistic-decimal-number new file mode 120000 index 0000000000..6e25078669 --- /dev/null +++ b/Lang/PascalABC.NET/Narcissistic-decimal-number @@ -0,0 +1 @@ +../../Task/Narcissistic-decimal-number/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Next-highest-int-from-digits b/Lang/PascalABC.NET/Next-highest-int-from-digits new file mode 120000 index 0000000000..f57c5311ba --- /dev/null +++ b/Lang/PascalABC.NET/Next-highest-int-from-digits @@ -0,0 +1 @@ +../../Task/Next-highest-int-from-digits/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Nim-game b/Lang/PascalABC.NET/Nim-game new file mode 120000 index 0000000000..11fed8b04f --- /dev/null +++ b/Lang/PascalABC.NET/Nim-game @@ -0,0 +1 @@ +../../Task/Nim-game/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Non-continuous-subsequences b/Lang/PascalABC.NET/Non-continuous-subsequences new file mode 120000 index 0000000000..fb90313f8e --- /dev/null +++ b/Lang/PascalABC.NET/Non-continuous-subsequences @@ -0,0 +1 @@ +../../Task/Non-continuous-subsequences/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Nonoblock b/Lang/PascalABC.NET/Nonoblock new file mode 120000 index 0000000000..27ec8aac45 --- /dev/null +++ b/Lang/PascalABC.NET/Nonoblock @@ -0,0 +1 @@ +../../Task/Nonoblock/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Numbers-which-are-not-the-sum-of-distinct-squares b/Lang/PascalABC.NET/Numbers-which-are-not-the-sum-of-distinct-squares new file mode 120000 index 0000000000..11f633b289 --- /dev/null +++ b/Lang/PascalABC.NET/Numbers-which-are-not-the-sum-of-distinct-squares @@ -0,0 +1 @@ +../../Task/Numbers-which-are-not-the-sum-of-distinct-squares/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors b/Lang/PascalABC.NET/Numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors new file mode 120000 index 0000000000..3b98dabeae --- /dev/null +++ b/Lang/PascalABC.NET/Numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors @@ -0,0 +1 @@ +../../Task/Numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Numbers-with-equal-rises-and-falls b/Lang/PascalABC.NET/Numbers-with-equal-rises-and-falls new file mode 120000 index 0000000000..265a6e57f2 --- /dev/null +++ b/Lang/PascalABC.NET/Numbers-with-equal-rises-and-falls @@ -0,0 +1 @@ +../../Task/Numbers-with-equal-rises-and-falls/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Numeric-error-propagation b/Lang/PascalABC.NET/Numeric-error-propagation new file mode 120000 index 0000000000..b8b2e6d9b5 --- /dev/null +++ b/Lang/PascalABC.NET/Numeric-error-propagation @@ -0,0 +1 @@ +../../Task/Numeric-error-propagation/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Numerical-integration b/Lang/PascalABC.NET/Numerical-integration new file mode 120000 index 0000000000..dc5bfcc884 --- /dev/null +++ b/Lang/PascalABC.NET/Numerical-integration @@ -0,0 +1 @@ +../../Task/Numerical-integration/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Odd-word-problem b/Lang/PascalABC.NET/Odd-word-problem new file mode 120000 index 0000000000..b0936fb34b --- /dev/null +++ b/Lang/PascalABC.NET/Odd-word-problem @@ -0,0 +1 @@ +../../Task/Odd-word-problem/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/One-dimensional-cellular-automata b/Lang/PascalABC.NET/One-dimensional-cellular-automata new file mode 120000 index 0000000000..19b52c40ec --- /dev/null +++ b/Lang/PascalABC.NET/One-dimensional-cellular-automata @@ -0,0 +1 @@ +../../Task/One-dimensional-cellular-automata/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/One-of-n-lines-in-a-file b/Lang/PascalABC.NET/One-of-n-lines-in-a-file new file mode 120000 index 0000000000..6a1426ac8c --- /dev/null +++ b/Lang/PascalABC.NET/One-of-n-lines-in-a-file @@ -0,0 +1 @@ +../../Task/One-of-n-lines-in-a-file/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/OpenWebNet-password b/Lang/PascalABC.NET/OpenWebNet-password new file mode 120000 index 0000000000..41ce8aa36a --- /dev/null +++ b/Lang/PascalABC.NET/OpenWebNet-password @@ -0,0 +1 @@ +../../Task/OpenWebNet-password/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Operator-precedence b/Lang/PascalABC.NET/Operator-precedence new file mode 120000 index 0000000000..08a1b040c3 --- /dev/null +++ b/Lang/PascalABC.NET/Operator-precedence @@ -0,0 +1 @@ +../../Task/Operator-precedence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Order-two-numerical-lists b/Lang/PascalABC.NET/Order-two-numerical-lists new file mode 120000 index 0000000000..8f392c8ff3 --- /dev/null +++ b/Lang/PascalABC.NET/Order-two-numerical-lists @@ -0,0 +1 @@ +../../Task/Order-two-numerical-lists/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Padovan-n-step-number-sequences b/Lang/PascalABC.NET/Padovan-n-step-number-sequences new file mode 120000 index 0000000000..2e49ed2259 --- /dev/null +++ b/Lang/PascalABC.NET/Padovan-n-step-number-sequences @@ -0,0 +1 @@ +../../Task/Padovan-n-step-number-sequences/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Padovan-sequence b/Lang/PascalABC.NET/Padovan-sequence new file mode 120000 index 0000000000..c2c68fb6dd --- /dev/null +++ b/Lang/PascalABC.NET/Padovan-sequence @@ -0,0 +1 @@ +../../Task/Padovan-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Palindrome-dates b/Lang/PascalABC.NET/Palindrome-dates new file mode 120000 index 0000000000..09644b6a7c --- /dev/null +++ b/Lang/PascalABC.NET/Palindrome-dates @@ -0,0 +1 @@ +../../Task/Palindrome-dates/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Palindromic-gapful-numbers b/Lang/PascalABC.NET/Palindromic-gapful-numbers new file mode 120000 index 0000000000..532e5bda78 --- /dev/null +++ b/Lang/PascalABC.NET/Palindromic-gapful-numbers @@ -0,0 +1 @@ +../../Task/Palindromic-gapful-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Permutations-Derangements b/Lang/PascalABC.NET/Permutations-Derangements new file mode 120000 index 0000000000..4c7dd2b64b --- /dev/null +++ b/Lang/PascalABC.NET/Permutations-Derangements @@ -0,0 +1 @@ +../../Task/Permutations-Derangements/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Roots-of-unity b/Lang/PascalABC.NET/Roots-of-unity new file mode 120000 index 0000000000..31b7a73b39 --- /dev/null +++ b/Lang/PascalABC.NET/Roots-of-unity @@ -0,0 +1 @@ +../../Task/Roots-of-unity/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Totient-function b/Lang/PascalABC.NET/Totient-function new file mode 120000 index 0000000000..cbbd5dcdf5 --- /dev/null +++ b/Lang/PascalABC.NET/Totient-function @@ -0,0 +1 @@ +../../Task/Totient-function/PascalABC.NET \ No newline at end of file diff --git a/Lang/Plain-English/00-LANG.txt b/Lang/Plain-English/00-LANG.txt index 879e8b69bc..be0ed94cc3 100644 --- a/Lang/Plain-English/00-LANG.txt +++ b/Lang/Plain-English/00-LANG.txt @@ -244,6 +244,8 @@ https://forums.parallax.com/discussion/163792/plain-english-programming a long r * Complete IDE Download ** [http://www.Osmosian.com/cal-4700.zip cal-4700.zip] *** requires Microsoft Windows +* Plain English Compiler (CMD / Command Line) +** [https://github.com/elisson-zlq3x/Plain-English-Compiler GitHub repo] ==Discussion== * [https://forums.parallax.com/discussion/163792/plain-english-programming Plain English Programming] diff --git a/Lang/PureBasic/ASCII-art-diagram-converter b/Lang/PureBasic/ASCII-art-diagram-converter new file mode 120000 index 0000000000..33f4c7eea5 --- /dev/null +++ b/Lang/PureBasic/ASCII-art-diagram-converter @@ -0,0 +1 @@ +../../Task/ASCII-art-diagram-converter/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Blum-integer b/Lang/PureBasic/Blum-integer new file mode 120000 index 0000000000..d3f0a3d564 --- /dev/null +++ b/Lang/PureBasic/Blum-integer @@ -0,0 +1 @@ +../../Task/Blum-integer/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Generate-Chess960-starting-position b/Lang/PureBasic/Generate-Chess960-starting-position new file mode 120000 index 0000000000..d1a0ea8b2a --- /dev/null +++ b/Lang/PureBasic/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/PureBasic \ No newline at end of file diff --git a/Lang/Python/Compile-time-calculation b/Lang/Python/Compile-time-calculation new file mode 120000 index 0000000000..33879ac69d --- /dev/null +++ b/Lang/Python/Compile-time-calculation @@ -0,0 +1 @@ +../../Task/Compile-time-calculation/Python \ No newline at end of file diff --git a/Lang/Python/Constrained-genericity b/Lang/Python/Constrained-genericity new file mode 120000 index 0000000000..3ac238c57a --- /dev/null +++ b/Lang/Python/Constrained-genericity @@ -0,0 +1 @@ +../../Task/Constrained-genericity/Python \ No newline at end of file diff --git a/Lang/Python/Erd-s-Selfridge-categorization-of-primes b/Lang/Python/Erd-s-Selfridge-categorization-of-primes new file mode 120000 index 0000000000..fd2fdbcb3f --- /dev/null +++ b/Lang/Python/Erd-s-Selfridge-categorization-of-primes @@ -0,0 +1 @@ +../../Task/Erd-s-Selfridge-categorization-of-primes/Python \ No newline at end of file diff --git a/Lang/Python/Isograms-and-heterograms b/Lang/Python/Isograms-and-heterograms new file mode 120000 index 0000000000..f277330152 --- /dev/null +++ b/Lang/Python/Isograms-and-heterograms @@ -0,0 +1 @@ +../../Task/Isograms-and-heterograms/Python \ No newline at end of file diff --git a/Lang/Python/Multi-base-primes b/Lang/Python/Multi-base-primes new file mode 120000 index 0000000000..6190bc944f --- /dev/null +++ b/Lang/Python/Multi-base-primes @@ -0,0 +1 @@ +../../Task/Multi-base-primes/Python \ No newline at end of file diff --git a/Lang/Python/Numbers-which-are-not-the-sum-of-distinct-squares b/Lang/Python/Numbers-which-are-not-the-sum-of-distinct-squares new file mode 120000 index 0000000000..3a47a71cf2 --- /dev/null +++ b/Lang/Python/Numbers-which-are-not-the-sum-of-distinct-squares @@ -0,0 +1 @@ +../../Task/Numbers-which-are-not-the-sum-of-distinct-squares/Python \ No newline at end of file diff --git a/Lang/Python/Parametric-polymorphism b/Lang/Python/Parametric-polymorphism new file mode 120000 index 0000000000..b6d5668cdf --- /dev/null +++ b/Lang/Python/Parametric-polymorphism @@ -0,0 +1 @@ +../../Task/Parametric-polymorphism/Python \ No newline at end of file diff --git a/Lang/Python/Peripheral-drift-illusion b/Lang/Python/Peripheral-drift-illusion new file mode 120000 index 0000000000..4e0e7d7c77 --- /dev/null +++ b/Lang/Python/Peripheral-drift-illusion @@ -0,0 +1 @@ +../../Task/Peripheral-drift-illusion/Python \ No newline at end of file diff --git a/Lang/Python/Ramanujan-primes-twins b/Lang/Python/Ramanujan-primes-twins new file mode 120000 index 0000000000..8b76bc210b --- /dev/null +++ b/Lang/Python/Ramanujan-primes-twins @@ -0,0 +1 @@ +../../Task/Ramanujan-primes-twins/Python \ No newline at end of file diff --git a/Lang/Python/Untouchable-numbers b/Lang/Python/Untouchable-numbers new file mode 120000 index 0000000000..c4bd0ba9e1 --- /dev/null +++ b/Lang/Python/Untouchable-numbers @@ -0,0 +1 @@ +../../Task/Untouchable-numbers/Python \ No newline at end of file diff --git a/Lang/QB64/Blum-integer b/Lang/QB64/Blum-integer new file mode 120000 index 0000000000..6d55cd1ae1 --- /dev/null +++ b/Lang/QB64/Blum-integer @@ -0,0 +1 @@ +../../Task/Blum-integer/QB64 \ No newline at end of file diff --git a/Lang/QBasic/00-LANG.txt b/Lang/QBasic/00-LANG.txt index 4ab26db45d..66c4f1d834 100644 --- a/Lang/QBasic/00-LANG.txt +++ b/Lang/QBasic/00-LANG.txt @@ -1,3 +1,4 @@ {{language}} +{{implementation|BASIC}} QBasic is a BASIC that was written by Microsoft and normally executes under Windows. \ No newline at end of file diff --git a/Lang/QBasic/15-puzzle-game b/Lang/QBasic/15-puzzle-game new file mode 120000 index 0000000000..4cdffaba3f --- /dev/null +++ b/Lang/QBasic/15-puzzle-game @@ -0,0 +1 @@ +../../Task/15-puzzle-game/QBasic \ No newline at end of file diff --git a/Lang/QBasic/ASCII-art-diagram-converter b/Lang/QBasic/ASCII-art-diagram-converter new file mode 120000 index 0000000000..75bc551903 --- /dev/null +++ b/Lang/QBasic/ASCII-art-diagram-converter @@ -0,0 +1 @@ +../../Task/ASCII-art-diagram-converter/QBasic \ No newline at end of file diff --git a/Lang/QBasic/Horizontal-sundial-calculations b/Lang/QBasic/Horizontal-sundial-calculations new file mode 120000 index 0000000000..48a7ed5986 --- /dev/null +++ b/Lang/QBasic/Horizontal-sundial-calculations @@ -0,0 +1 @@ +../../Task/Horizontal-sundial-calculations/QBasic \ No newline at end of file diff --git a/Lang/Quackery/00-LANG.txt b/Lang/Quackery/00-LANG.txt index e36ac3a936..c6437e7156 100644 --- a/Lang/Quackery/00-LANG.txt +++ b/Lang/Quackery/00-LANG.txt @@ -1,9 +1,9 @@ {{language|Quackery}} {{language programming paradigm|Concatenative}} {{language programming paradigm|Imperative}} -Quackery is an open-source, lightweight, entry-level concatenative language for educational and recreational programming. +Quackery is an open-source, lightweight, entry-level concatenative language for educational and recreational programming, and an extensible compiler for a hypothetical processor, the Quackery Engine. -It is coded as a Python 3 function in under 48k of Pythonscript, about half of which is a string of Quackery code. +It is coded as a Python 3 function in about 48k of Pythonscript, about half of which is a string of Quackery code. The Quackery GitHub repository, which includes the Quackery manual "The Book of Quackery" as a pdf, is at [https://github.com/GordonCharlton/Quackery github.com/GordonCharlton/Quackery]. @@ -27,8 +27,6 @@ Everything is code except when it is data. When do does a number, t Conceptually, the Quackery engine is a stack based processor which does not have direct access to physical memory but has a memory management co-processor that intermediates, that takes care of the nests and bignums, provides pointers to the Quackery engine CPU on request, and garbage collects continuously. -Quackery is not intended to be a super-fast enterprise-level language; it is intended as a fun programming project straight out of a textbook. (The textbook is included in the download.) +Quackery is not intended to be a super-fast enterprise-level language; it is intended as an exploration of a novel architecture, and a fun programming project straight out of a textbook. (The textbook is included in the download.) -If your language supports bignums, first-class functions and dynamic arrays of bignums, functions and dynamic arrays, and has automatic garbage collection, and if you can code depth-first traversal of a tree you can implement Quackery in your preferred language with reasonable ease, and modify it as you please. - -Or try your hand at one of the [[Tasks not implemented in Quackery]]. \ No newline at end of file +Why not try your hand at one of the [[Tasks not implemented in Quackery]]. \ No newline at end of file diff --git a/Lang/Quackery/4-rings-or-4-squares-puzzle b/Lang/Quackery/4-rings-or-4-squares-puzzle new file mode 120000 index 0000000000..786cc93b7f --- /dev/null +++ b/Lang/Quackery/4-rings-or-4-squares-puzzle @@ -0,0 +1 @@ +../../Task/4-rings-or-4-squares-puzzle/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Benfords-law b/Lang/Quackery/Benfords-law new file mode 120000 index 0000000000..83c8fdffec --- /dev/null +++ b/Lang/Quackery/Benfords-law @@ -0,0 +1 @@ +../../Task/Benfords-law/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Chowla-numbers b/Lang/Quackery/Chowla-numbers new file mode 120000 index 0000000000..017749c553 --- /dev/null +++ b/Lang/Quackery/Chowla-numbers @@ -0,0 +1 @@ +../../Task/Chowla-numbers/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Combinations-and-permutations b/Lang/Quackery/Combinations-and-permutations new file mode 120000 index 0000000000..fc6f331f4d --- /dev/null +++ b/Lang/Quackery/Combinations-and-permutations @@ -0,0 +1 @@ +../../Task/Combinations-and-permutations/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Cuban-primes b/Lang/Quackery/Cuban-primes new file mode 120000 index 0000000000..8c512d4853 --- /dev/null +++ b/Lang/Quackery/Cuban-primes @@ -0,0 +1 @@ +../../Task/Cuban-primes/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Doomsday-rule b/Lang/Quackery/Doomsday-rule new file mode 120000 index 0000000000..f3df2f0b9b --- /dev/null +++ b/Lang/Quackery/Doomsday-rule @@ -0,0 +1 @@ +../../Task/Doomsday-rule/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Execute-Computer-Zero b/Lang/Quackery/Execute-Computer-Zero new file mode 120000 index 0000000000..bffceead11 --- /dev/null +++ b/Lang/Quackery/Execute-Computer-Zero @@ -0,0 +1 @@ +../../Task/Execute-Computer-Zero/Quackery \ No newline at end of file diff --git a/Lang/Quackery/First-class-functions-Use-numbers-analogously b/Lang/Quackery/First-class-functions-Use-numbers-analogously new file mode 120000 index 0000000000..c8416f6780 --- /dev/null +++ b/Lang/Quackery/First-class-functions-Use-numbers-analogously @@ -0,0 +1 @@ +../../Task/First-class-functions-Use-numbers-analogously/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Golden-ratio-Convergence b/Lang/Quackery/Golden-ratio-Convergence new file mode 120000 index 0000000000..177994dc3e --- /dev/null +++ b/Lang/Quackery/Golden-ratio-Convergence @@ -0,0 +1 @@ +../../Task/Golden-ratio-Convergence/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Menu b/Lang/Quackery/Menu new file mode 120000 index 0000000000..07087595bc --- /dev/null +++ b/Lang/Quackery/Menu @@ -0,0 +1 @@ +../../Task/Menu/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Old-lady-swallowed-a-fly b/Lang/Quackery/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..0d6823a2fd --- /dev/null +++ b/Lang/Quackery/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Pseudo-random-numbers-Xorshift-star b/Lang/Quackery/Pseudo-random-numbers-Xorshift-star new file mode 120000 index 0000000000..0d802ea7eb --- /dev/null +++ b/Lang/Quackery/Pseudo-random-numbers-Xorshift-star @@ -0,0 +1 @@ +../../Task/Pseudo-random-numbers-Xorshift-star/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Sleep b/Lang/Quackery/Sleep new file mode 120000 index 0000000000..7cd0464b5f --- /dev/null +++ b/Lang/Quackery/Sleep @@ -0,0 +1 @@ +../../Task/Sleep/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Square-free-integers b/Lang/Quackery/Square-free-integers new file mode 120000 index 0000000000..1d2a5a3f4e --- /dev/null +++ b/Lang/Quackery/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Ultra-useful-primes b/Lang/Quackery/Ultra-useful-primes new file mode 120000 index 0000000000..d6fc3551e1 --- /dev/null +++ b/Lang/Quackery/Ultra-useful-primes @@ -0,0 +1 @@ +../../Task/Ultra-useful-primes/Quackery \ No newline at end of file diff --git a/Lang/Quackery/Universal-Turing-machine b/Lang/Quackery/Universal-Turing-machine new file mode 120000 index 0000000000..9346211d7e --- /dev/null +++ b/Lang/Quackery/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/Quackery \ No newline at end of file diff --git a/Lang/QuickBASIC/Nth-root b/Lang/QuickBASIC/Nth-root new file mode 120000 index 0000000000..db6d881466 --- /dev/null +++ b/Lang/QuickBASIC/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/QuickBASIC \ No newline at end of file diff --git a/Lang/R/Quickselect-algorithm b/Lang/R/Quickselect-algorithm new file mode 120000 index 0000000000..996073d670 --- /dev/null +++ b/Lang/R/Quickselect-algorithm @@ -0,0 +1 @@ +../../Task/Quickselect-algorithm/R \ No newline at end of file diff --git a/Lang/REXX/Legendre-prime-counting-function b/Lang/REXX/Legendre-prime-counting-function new file mode 120000 index 0000000000..74d1b424e1 --- /dev/null +++ b/Lang/REXX/Legendre-prime-counting-function @@ -0,0 +1 @@ +../../Task/Legendre-prime-counting-function/REXX \ No newline at end of file diff --git a/Lang/RTL-2/00-LANG.txt b/Lang/RTL-2/00-LANG.txt index da5b7b1776..1ed7c9f33f 100644 --- a/Lang/RTL-2/00-LANG.txt +++ b/Lang/RTL-2/00-LANG.txt @@ -52,6 +52,9 @@ While the specifics varied by operating system the following is an example of a This code insert moves the value of a variable passed into the RTL/2 procedure into a variable called COUNTER in a data brick called MYDATA. +== Design and Rationale == +J. G. P. Barnes describes RTL/2 and the reasons behind some of the design decisions made during its development in his 1976 book RTL/2 Design and Philosophy. + == Reserved Words == ABS AND diff --git a/Lang/Racket/Twos-complement b/Lang/Racket/Twos-complement new file mode 120000 index 0000000000..0d85b62ede --- /dev/null +++ b/Lang/Racket/Twos-complement @@ -0,0 +1 @@ +../../Task/Twos-complement/Racket \ No newline at end of file diff --git a/Lang/Raku/Dominoes b/Lang/Raku/Dominoes new file mode 120000 index 0000000000..48ba3c99bf --- /dev/null +++ b/Lang/Raku/Dominoes @@ -0,0 +1 @@ +../../Task/Dominoes/Raku \ No newline at end of file diff --git a/Lang/RapidQ/Nth-root b/Lang/RapidQ/Nth-root new file mode 120000 index 0000000000..f4c270323f --- /dev/null +++ b/Lang/RapidQ/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/RapidQ \ No newline at end of file diff --git a/Lang/RapidQ/Temperature-conversion b/Lang/RapidQ/Temperature-conversion new file mode 120000 index 0000000000..757db1c288 --- /dev/null +++ b/Lang/RapidQ/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/RapidQ \ No newline at end of file diff --git a/Lang/Red/Rosetta-Code-Find-unimplemented-tasks b/Lang/Red/Rosetta-Code-Find-unimplemented-tasks new file mode 120000 index 0000000000..53726178b5 --- /dev/null +++ b/Lang/Red/Rosetta-Code-Find-unimplemented-tasks @@ -0,0 +1 @@ +../../Task/Rosetta-Code-Find-unimplemented-tasks/Red \ No newline at end of file diff --git a/Lang/Refal/Align-columns b/Lang/Refal/Align-columns new file mode 120000 index 0000000000..8c214d7af1 --- /dev/null +++ b/Lang/Refal/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Refal \ No newline at end of file diff --git a/Lang/Refal/Arithmetic-derivative b/Lang/Refal/Arithmetic-derivative new file mode 120000 index 0000000000..c88f60d44d --- /dev/null +++ b/Lang/Refal/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/Refal \ No newline at end of file diff --git a/Lang/Refal/Bell-numbers b/Lang/Refal/Bell-numbers new file mode 120000 index 0000000000..a73ced2740 --- /dev/null +++ b/Lang/Refal/Bell-numbers @@ -0,0 +1 @@ +../../Task/Bell-numbers/Refal \ No newline at end of file diff --git a/Lang/Refal/Doomsday-rule b/Lang/Refal/Doomsday-rule new file mode 120000 index 0000000000..87fb488eaa --- /dev/null +++ b/Lang/Refal/Doomsday-rule @@ -0,0 +1 @@ +../../Task/Doomsday-rule/Refal \ No newline at end of file diff --git a/Lang/Refal/Duffinian-numbers b/Lang/Refal/Duffinian-numbers new file mode 120000 index 0000000000..7aec5bb21b --- /dev/null +++ b/Lang/Refal/Duffinian-numbers @@ -0,0 +1 @@ +../../Task/Duffinian-numbers/Refal \ No newline at end of file diff --git a/Lang/Refal/Horners-rule-for-polynomial-evaluation b/Lang/Refal/Horners-rule-for-polynomial-evaluation new file mode 120000 index 0000000000..29b0a0f26a --- /dev/null +++ b/Lang/Refal/Horners-rule-for-polynomial-evaluation @@ -0,0 +1 @@ +../../Task/Horners-rule-for-polynomial-evaluation/Refal \ No newline at end of file diff --git a/Lang/Refal/Isqrt-integer-square-root-of-X b/Lang/Refal/Isqrt-integer-square-root-of-X new file mode 120000 index 0000000000..812b5e86d3 --- /dev/null +++ b/Lang/Refal/Isqrt-integer-square-root-of-X @@ -0,0 +1 @@ +../../Task/Isqrt-integer-square-root-of-X/Refal \ No newline at end of file diff --git a/Lang/Refal/Lah-numbers b/Lang/Refal/Lah-numbers new file mode 120000 index 0000000000..a761f59719 --- /dev/null +++ b/Lang/Refal/Lah-numbers @@ -0,0 +1 @@ +../../Task/Lah-numbers/Refal \ No newline at end of file diff --git a/Lang/Refal/Roman-numerals-Encode b/Lang/Refal/Roman-numerals-Encode new file mode 120000 index 0000000000..a35e7a2ee0 --- /dev/null +++ b/Lang/Refal/Roman-numerals-Encode @@ -0,0 +1 @@ +../../Task/Roman-numerals-Encode/Refal \ No newline at end of file diff --git a/Lang/Retro/Sieve-of-Eratosthenes b/Lang/Retro/Sieve-of-Eratosthenes new file mode 120000 index 0000000000..d5617b7054 --- /dev/null +++ b/Lang/Retro/Sieve-of-Eratosthenes @@ -0,0 +1 @@ +../../Task/Sieve-of-Eratosthenes/Retro \ No newline at end of file diff --git a/Lang/Retro/String-append b/Lang/Retro/String-append new file mode 120000 index 0000000000..db032f3f0a --- /dev/null +++ b/Lang/Retro/String-append @@ -0,0 +1 @@ +../../Task/String-append/Retro \ No newline at end of file diff --git a/Lang/Retro/Sum-multiples-of-3-and-5 b/Lang/Retro/Sum-multiples-of-3-and-5 new file mode 120000 index 0000000000..cb0c42540d --- /dev/null +++ b/Lang/Retro/Sum-multiples-of-3-and-5 @@ -0,0 +1 @@ +../../Task/Sum-multiples-of-3-and-5/Retro \ No newline at end of file diff --git a/Lang/Ring/Special-characters b/Lang/Ring/Special-characters new file mode 120000 index 0000000000..0dd3c257c9 --- /dev/null +++ b/Lang/Ring/Special-characters @@ -0,0 +1 @@ +../../Task/Special-characters/Ring \ No newline at end of file diff --git a/Lang/Ring/Wieferich-primes b/Lang/Ring/Wieferich-primes new file mode 120000 index 0000000000..4a7c97a04d --- /dev/null +++ b/Lang/Ring/Wieferich-primes @@ -0,0 +1 @@ +../../Task/Wieferich-primes/Ring \ No newline at end of file diff --git a/Lang/S-BASIC/00-LANG.txt b/Lang/S-BASIC/00-LANG.txt index 7e71ba9085..cb4f4a5c14 100644 --- a/Lang/S-BASIC/00-LANG.txt +++ b/Lang/S-BASIC/00-LANG.txt @@ -1,4 +1,5 @@ {{stub}}{{language|S-BASIC}} +{{implementation|BASIC}} S-BASIC (the S stands for "structured") was a native-code compiler for an ALGOL-like dialect of the BASIC programming language, and ran on 8-bit microcomputers using the Z80 CPU and diff --git a/Lang/S-BASIC/Square-free-integers b/Lang/S-BASIC/Square-free-integers new file mode 120000 index 0000000000..d6296e2f26 --- /dev/null +++ b/Lang/S-BASIC/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/S-BASIC \ No newline at end of file diff --git a/Lang/S-BASIC/String-interpolation-included- b/Lang/S-BASIC/String-interpolation-included- new file mode 120000 index 0000000000..c71873859b --- /dev/null +++ b/Lang/S-BASIC/String-interpolation-included- @@ -0,0 +1 @@ +../../Task/String-interpolation-included-/S-BASIC \ No newline at end of file diff --git a/Lang/SETL/Arithmetic-derivative b/Lang/SETL/Arithmetic-derivative new file mode 120000 index 0000000000..56f987cef7 --- /dev/null +++ b/Lang/SETL/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/SETL \ No newline at end of file diff --git a/Lang/SETL/Bell-numbers b/Lang/SETL/Bell-numbers new file mode 120000 index 0000000000..32b1473efe --- /dev/null +++ b/Lang/SETL/Bell-numbers @@ -0,0 +1 @@ +../../Task/Bell-numbers/SETL \ No newline at end of file diff --git a/Lang/SETL/Doomsday-rule b/Lang/SETL/Doomsday-rule new file mode 120000 index 0000000000..b9fa54eb7b --- /dev/null +++ b/Lang/SETL/Doomsday-rule @@ -0,0 +1 @@ +../../Task/Doomsday-rule/SETL \ No newline at end of file diff --git a/Lang/SETL/Duffinian-numbers b/Lang/SETL/Duffinian-numbers new file mode 120000 index 0000000000..93694a20c6 --- /dev/null +++ b/Lang/SETL/Duffinian-numbers @@ -0,0 +1 @@ +../../Task/Duffinian-numbers/SETL \ No newline at end of file diff --git a/Lang/SETL/Horners-rule-for-polynomial-evaluation b/Lang/SETL/Horners-rule-for-polynomial-evaluation new file mode 120000 index 0000000000..c30c2e1637 --- /dev/null +++ b/Lang/SETL/Horners-rule-for-polynomial-evaluation @@ -0,0 +1 @@ +../../Task/Horners-rule-for-polynomial-evaluation/SETL \ No newline at end of file diff --git a/Lang/SETL/Old-lady-swallowed-a-fly b/Lang/SETL/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..948ed47605 --- /dev/null +++ b/Lang/SETL/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/SETL \ No newline at end of file diff --git a/Lang/SETL/Partition-function-P b/Lang/SETL/Partition-function-P new file mode 120000 index 0000000000..f47b3bd593 --- /dev/null +++ b/Lang/SETL/Partition-function-P @@ -0,0 +1 @@ +../../Task/Partition-function-P/SETL \ No newline at end of file diff --git a/Lang/SETL/Square-free-integers b/Lang/SETL/Square-free-integers new file mode 120000 index 0000000000..328ef78775 --- /dev/null +++ b/Lang/SETL/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/SETL \ No newline at end of file diff --git a/Lang/Scala/Additive-primes b/Lang/Scala/Additive-primes new file mode 120000 index 0000000000..ba2692b54f --- /dev/null +++ b/Lang/Scala/Additive-primes @@ -0,0 +1 @@ +../../Task/Additive-primes/Scala \ No newline at end of file diff --git a/Lang/Scala/Descending-primes b/Lang/Scala/Descending-primes new file mode 120000 index 0000000000..461c6bfefd --- /dev/null +++ b/Lang/Scala/Descending-primes @@ -0,0 +1 @@ +../../Task/Descending-primes/Scala \ No newline at end of file diff --git a/Lang/Scala/ISBN13-check-digit b/Lang/Scala/ISBN13-check-digit new file mode 120000 index 0000000000..b0dc1022b2 --- /dev/null +++ b/Lang/Scala/ISBN13-check-digit @@ -0,0 +1 @@ +../../Task/ISBN13-check-digit/Scala \ No newline at end of file diff --git a/Lang/Scala/Parallel-calculations b/Lang/Scala/Parallel-calculations new file mode 120000 index 0000000000..525e6ca1ba --- /dev/null +++ b/Lang/Scala/Parallel-calculations @@ -0,0 +1 @@ +../../Task/Parallel-calculations/Scala \ No newline at end of file diff --git a/Lang/Sidef/Arithmetic-derivative b/Lang/Sidef/Arithmetic-derivative new file mode 120000 index 0000000000..bdcd1874e7 --- /dev/null +++ b/Lang/Sidef/Arithmetic-derivative @@ -0,0 +1 @@ +../../Task/Arithmetic-derivative/Sidef \ No newline at end of file diff --git a/Lang/Sidef/Arithmetic-numbers b/Lang/Sidef/Arithmetic-numbers new file mode 120000 index 0000000000..672bca881d --- /dev/null +++ b/Lang/Sidef/Arithmetic-numbers @@ -0,0 +1 @@ +../../Task/Arithmetic-numbers/Sidef \ No newline at end of file diff --git a/Lang/Sidef/Binary-strings b/Lang/Sidef/Binary-strings new file mode 120000 index 0000000000..86bf141c80 --- /dev/null +++ b/Lang/Sidef/Binary-strings @@ -0,0 +1 @@ +../../Task/Binary-strings/Sidef \ No newline at end of file diff --git a/Lang/Sidef/Jordan-P-lya-numbers b/Lang/Sidef/Jordan-P-lya-numbers new file mode 120000 index 0000000000..b084543da1 --- /dev/null +++ b/Lang/Sidef/Jordan-P-lya-numbers @@ -0,0 +1 @@ +../../Task/Jordan-P-lya-numbers/Sidef \ No newline at end of file diff --git a/Lang/Sidef/Pell-numbers b/Lang/Sidef/Pell-numbers new file mode 120000 index 0000000000..af14680327 --- /dev/null +++ b/Lang/Sidef/Pell-numbers @@ -0,0 +1 @@ +../../Task/Pell-numbers/Sidef \ No newline at end of file diff --git a/Lang/Standard-ML/Knuth-shuffle b/Lang/Standard-ML/Knuth-shuffle new file mode 120000 index 0000000000..da7fa35b79 --- /dev/null +++ b/Lang/Standard-ML/Knuth-shuffle @@ -0,0 +1 @@ +../../Task/Knuth-shuffle/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Pseudo-random-numbers-Splitmix64 b/Lang/Standard-ML/Pseudo-random-numbers-Splitmix64 new file mode 120000 index 0000000000..bce7d31edd --- /dev/null +++ b/Lang/Standard-ML/Pseudo-random-numbers-Splitmix64 @@ -0,0 +1 @@ +../../Task/Pseudo-random-numbers-Splitmix64/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/URL-encoding b/Lang/Standard-ML/URL-encoding new file mode 120000 index 0000000000..f4e1b1b4e1 --- /dev/null +++ b/Lang/Standard-ML/URL-encoding @@ -0,0 +1 @@ +../../Task/URL-encoding/Standard-ML \ No newline at end of file diff --git a/Lang/Stax/00-LANG.txt b/Lang/Stax/00-LANG.txt index daeb2cc2d2..9436dc0940 100644 --- a/Lang/Stax/00-LANG.txt +++ b/Lang/Stax/00-LANG.txt @@ -1 +1,2 @@ -{{stub}}{{language|Stax}} \ No newline at end of file +[https://github.com/tomtheisen/stax Github] +{{language|site=https://staxlang.xyz/}} \ No newline at end of file diff --git a/Lang/Swift/M-bius-function b/Lang/Swift/M-bius-function new file mode 120000 index 0000000000..cd32d72e63 --- /dev/null +++ b/Lang/Swift/M-bius-function @@ -0,0 +1 @@ +../../Task/M-bius-function/Swift \ No newline at end of file diff --git a/Lang/TI-83-BASIC/00-LANG.txt b/Lang/TI-83-BASIC/00-LANG.txt index 571b0d2a73..a8830c103d 100644 --- a/Lang/TI-83-BASIC/00-LANG.txt +++ b/Lang/TI-83-BASIC/00-LANG.txt @@ -8,24 +8,24 @@ The language contains control flow for structured programming. The main control flow statements are: ====If==== -If condition +If condition Then ... Else ... -End +End ====For==== -For(variable,start,stop,step) +For(variable,start,stop,step) ... -End +End ====While==== -While condition +While condition ... -End +End ====Repeat==== -Repeat condition +Repeat condition ... -End +End ===Data types=== '''TI-BASIC''' is a strongly and dynamically-typed language Variables are global. There is no local variables. So programs cannot be recursive, even if a program can call itself. @@ -37,11 +37,11 @@ Variables are global. There is no local variables. So programs cannot be recursi ==Example== One popular example is the quadratic formula program. -Prompt A,B,C +Prompt A,B,C B²-4AC->D (-B-sqrt(D))/(2A)->Y (-B+sqrt(D))/(2A)->X -{Y,X} +{Y,X} As far there is a complex mode and variable can be real or complex, this program is very ubiquitous. diff --git a/Lang/Tiny-BASIC/Leonardo-numbers b/Lang/Tiny-BASIC/Leonardo-numbers new file mode 120000 index 0000000000..731e542c2f --- /dev/null +++ b/Lang/Tiny-BASIC/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/Tiny-BASIC \ No newline at end of file diff --git a/Lang/True-BASIC/00-LANG.txt b/Lang/True-BASIC/00-LANG.txt index 765d6ad0cc..7ebdbc548e 100644 --- a/Lang/True-BASIC/00-LANG.txt +++ b/Lang/True-BASIC/00-LANG.txt @@ -2,6 +2,7 @@ |exec=interpreted |tags=basic,TrueBasic |site=http://www.truebasic.com/}} +{{implementation|BASIC}} True BASIC is a variant of the BASIC programming language descended from Dartmouth BASIC, the original BASIC. It was invented by college professors John G. Kemeny and Thomas E. Kurtz. It is an interpreted, procedural language and sold as a commercial product. Versions have existed for Microsoft Windows, Apple Mac OS, MS-DOS, OS/2, and the Atari ST. The latest version of the language is 6.007 and currently only runs on Microsoft Windows. diff --git a/Lang/TypeScript/Leonardo-numbers b/Lang/TypeScript/Leonardo-numbers new file mode 120000 index 0000000000..501c953b40 --- /dev/null +++ b/Lang/TypeScript/Leonardo-numbers @@ -0,0 +1 @@ +../../Task/Leonardo-numbers/TypeScript \ No newline at end of file diff --git a/Lang/UNIX-Shell/Horners-rule-for-polynomial-evaluation b/Lang/UNIX-Shell/Horners-rule-for-polynomial-evaluation new file mode 120000 index 0000000000..18a4ccc4dc --- /dev/null +++ b/Lang/UNIX-Shell/Horners-rule-for-polynomial-evaluation @@ -0,0 +1 @@ +../../Task/Horners-rule-for-polynomial-evaluation/UNIX-Shell \ No newline at end of file diff --git a/Lang/Uiua/Arithmetic-Complex b/Lang/Uiua/Arithmetic-Complex new file mode 120000 index 0000000000..acbbaad1bb --- /dev/null +++ b/Lang/Uiua/Arithmetic-Complex @@ -0,0 +1 @@ +../../Task/Arithmetic-Complex/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Assertions b/Lang/Uiua/Assertions new file mode 120000 index 0000000000..b370cee8a3 --- /dev/null +++ b/Lang/Uiua/Assertions @@ -0,0 +1 @@ +../../Task/Assertions/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Associative-array-Creation b/Lang/Uiua/Associative-array-Creation new file mode 120000 index 0000000000..8f5e350a55 --- /dev/null +++ b/Lang/Uiua/Associative-array-Creation @@ -0,0 +1 @@ +../../Task/Associative-array-Creation/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Associative-array-Iteration b/Lang/Uiua/Associative-array-Iteration new file mode 120000 index 0000000000..5ba8f9745a --- /dev/null +++ b/Lang/Uiua/Associative-array-Iteration @@ -0,0 +1 @@ +../../Task/Associative-array-Iteration/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Associative-array-Merging b/Lang/Uiua/Associative-array-Merging new file mode 120000 index 0000000000..d769831c9b --- /dev/null +++ b/Lang/Uiua/Associative-array-Merging @@ -0,0 +1 @@ +../../Task/Associative-array-Merging/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Extreme-floating-point-values b/Lang/Uiua/Extreme-floating-point-values new file mode 120000 index 0000000000..05ab571554 --- /dev/null +++ b/Lang/Uiua/Extreme-floating-point-values @@ -0,0 +1 @@ +../../Task/Extreme-floating-point-values/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Halt-and-catch-fire b/Lang/Uiua/Halt-and-catch-fire new file mode 120000 index 0000000000..098009e021 --- /dev/null +++ b/Lang/Uiua/Halt-and-catch-fire @@ -0,0 +1 @@ +../../Task/Halt-and-catch-fire/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Hash-from-two-arrays b/Lang/Uiua/Hash-from-two-arrays new file mode 120000 index 0000000000..63b4a8d5f8 --- /dev/null +++ b/Lang/Uiua/Hash-from-two-arrays @@ -0,0 +1 @@ +../../Task/Hash-from-two-arrays/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Include-a-file b/Lang/Uiua/Include-a-file new file mode 120000 index 0000000000..2dd83554d2 --- /dev/null +++ b/Lang/Uiua/Include-a-file @@ -0,0 +1 @@ +../../Task/Include-a-file/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Infinity b/Lang/Uiua/Infinity new file mode 120000 index 0000000000..13e94dd0ff --- /dev/null +++ b/Lang/Uiua/Infinity @@ -0,0 +1 @@ +../../Task/Infinity/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Leap-year b/Lang/Uiua/Leap-year new file mode 120000 index 0000000000..526002b745 --- /dev/null +++ b/Lang/Uiua/Leap-year @@ -0,0 +1 @@ +../../Task/Leap-year/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Literals-Floating-point b/Lang/Uiua/Literals-Floating-point new file mode 120000 index 0000000000..47d46d3181 --- /dev/null +++ b/Lang/Uiua/Literals-Floating-point @@ -0,0 +1 @@ +../../Task/Literals-Floating-point/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Real-constants-and-functions b/Lang/Uiua/Real-constants-and-functions new file mode 120000 index 0000000000..fb71bc51b7 --- /dev/null +++ b/Lang/Uiua/Real-constants-and-functions @@ -0,0 +1 @@ +../../Task/Real-constants-and-functions/Uiua \ No newline at end of file diff --git a/Lang/Uiua/Trigonometric-functions b/Lang/Uiua/Trigonometric-functions new file mode 120000 index 0000000000..07a1fc051e --- /dev/null +++ b/Lang/Uiua/Trigonometric-functions @@ -0,0 +1 @@ +../../Task/Trigonometric-functions/Uiua \ No newline at end of file diff --git a/Lang/Ultimate++/00-LANG.txt b/Lang/Ultimate++/00-LANG.txt index b340f85de9..a819e23329 100644 --- a/Lang/Ultimate++/00-LANG.txt +++ b/Lang/Ultimate++/00-LANG.txt @@ -23,7 +23,7 @@ https://www.ultimatepp.org/www$uppweb$overview$en-us.html ==Language== This example is a hello world using the Upp namespace. - +
 #include 
 #include 
 
@@ -39,7 +39,7 @@ CONSOLE_APP_MAIN
 	for(int i = 0; i < cmdline.GetCount(); i++) {
 	}
 }
-
+
{{out}} @@ -51,7 +51,7 @@ and Hello World '''A+B B-A'''   - +
 #include 
 #include 
 #include 
@@ -69,7 +69,7 @@ CONSOLE_APP_MAIN
 	for(int i = 0; i < cmdline.GetCount(); i++) {
 	}
 }
-
+
{{out}} @@ -84,7 +84,7 @@ CONSOLE_APP_MAIN '''Conditional loop''' - +
 #include 
 #include 
 #include 
@@ -108,7 +108,7 @@ CONSOLE_APP_MAIN
 	for(int i = 0; i < cmdline.GetCount(); i++) {
 	}
 }
-
+
diff --git a/Lang/Ursalang/Averages-Arithmetic-mean b/Lang/Ursalang/Averages-Arithmetic-mean new file mode 120000 index 0000000000..47e790e66c --- /dev/null +++ b/Lang/Ursalang/Averages-Arithmetic-mean @@ -0,0 +1 @@ +../../Task/Averages-Arithmetic-mean/Ursalang \ No newline at end of file diff --git a/Lang/Ursalang/Averages-Mode b/Lang/Ursalang/Averages-Mode new file mode 120000 index 0000000000..3250a246da --- /dev/null +++ b/Lang/Ursalang/Averages-Mode @@ -0,0 +1 @@ +../../Task/Averages-Mode/Ursalang \ No newline at end of file diff --git a/Lang/Ursalang/Averages-Root-mean-square b/Lang/Ursalang/Averages-Root-mean-square new file mode 120000 index 0000000000..1acc742630 --- /dev/null +++ b/Lang/Ursalang/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/Ursalang \ No newline at end of file diff --git a/Lang/Wren/00-LANG.txt b/Lang/Wren/00-LANG.txt index ea9fd010ee..2d52115f0a 100644 --- a/Lang/Wren/00-LANG.txt +++ b/Lang/Wren/00-LANG.txt @@ -64,7 +64,11 @@ As a language mainly designed for embedding, Wren's standard library is (of nece |- | 43 || [[:Category:Wren-vector|vector]] || || 44 || [[:Category:Wren-ordered|ordered]] |- -| 45 || [[:Category:Wren-psieve|psieve]] || || || +| 45 || [[:Category:Wren-psieve|psieve]] || || 46 || [[:Category:Wren-hash|hash]] +|- +| 47 || [[:Category:Wren-roman|roman]] || || 48 || [[:Category:Wren-std|std]] +|- +| 49 || [[:Category:Wren-ansi|ansi]] || || || |}
To use a class or classes from a module (say ''fmt''), you need to import them into your script with Wren code such as the following. To use more than one class separate their names with commas: @@ -91,5 +95,7 @@ There are also a number of third-party modules available for Wren of which the f
For further information and licensing requirements, please consult their individual pages. +Finally, there are some RC tasks which require a special C executable to solve but where it is not worthwhile to create a dedicated module to house the Wren source code. See [[:Category:libwren|libwren]] for details. + ==Todo== * [[Tasks not implemented in Wren]] \ No newline at end of file diff --git a/Lang/X86-64-Assembly/Pseudo-random-numbers-Middle-square-method b/Lang/X86-64-Assembly/Pseudo-random-numbers-Middle-square-method new file mode 120000 index 0000000000..9ff7bee727 --- /dev/null +++ b/Lang/X86-64-Assembly/Pseudo-random-numbers-Middle-square-method @@ -0,0 +1 @@ +../../Task/Pseudo-random-numbers-Middle-square-method/X86-64-Assembly \ No newline at end of file diff --git a/Lang/X86-64-Assembly/Twos-complement b/Lang/X86-64-Assembly/Twos-complement new file mode 120000 index 0000000000..03daa00fb9 --- /dev/null +++ b/Lang/X86-64-Assembly/Twos-complement @@ -0,0 +1 @@ +../../Task/Twos-complement/X86-64-Assembly \ No newline at end of file diff --git a/Lang/XPL0/Determinant-and-permanent b/Lang/XPL0/Determinant-and-permanent new file mode 120000 index 0000000000..ffda863c8d --- /dev/null +++ b/Lang/XPL0/Determinant-and-permanent @@ -0,0 +1 @@ +../../Task/Determinant-and-permanent/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Display-a-linear-combination b/Lang/XPL0/Display-a-linear-combination new file mode 120000 index 0000000000..bd14d58a74 --- /dev/null +++ b/Lang/XPL0/Display-a-linear-combination @@ -0,0 +1 @@ +../../Task/Display-a-linear-combination/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/GUI-component-interaction b/Lang/XPL0/GUI-component-interaction new file mode 120000 index 0000000000..8745be4ca4 --- /dev/null +++ b/Lang/XPL0/GUI-component-interaction @@ -0,0 +1 @@ +../../Task/GUI-component-interaction/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Joystick-position b/Lang/XPL0/Joystick-position new file mode 120000 index 0000000000..0ba634deb3 --- /dev/null +++ b/Lang/XPL0/Joystick-position @@ -0,0 +1 @@ +../../Task/Joystick-position/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Magic-squares-of-doubly-even-order b/Lang/XPL0/Magic-squares-of-doubly-even-order new file mode 120000 index 0000000000..31327c15e8 --- /dev/null +++ b/Lang/XPL0/Magic-squares-of-doubly-even-order @@ -0,0 +1 @@ +../../Task/Magic-squares-of-doubly-even-order/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Primorial-numbers b/Lang/XPL0/Primorial-numbers new file mode 120000 index 0000000000..6512549f63 --- /dev/null +++ b/Lang/XPL0/Primorial-numbers @@ -0,0 +1 @@ +../../Task/Primorial-numbers/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Square-free-integers b/Lang/XPL0/Square-free-integers new file mode 120000 index 0000000000..791b667893 --- /dev/null +++ b/Lang/XPL0/Square-free-integers @@ -0,0 +1 @@ +../../Task/Square-free-integers/XPL0 \ No newline at end of file diff --git a/Lang/YAMLScript/00-LANG.txt b/Lang/YAMLScript/00-LANG.txt index 1df1514fb9..a35f9dca7d 100644 --- a/Lang/YAMLScript/00-LANG.txt +++ b/Lang/YAMLScript/00-LANG.txt @@ -4,11 +4,11 @@ {{language programming paradigm|hosted}} {{implementation|Lisp}} -'''[https://yamlscript.org YAMLScript]''' is a new programming language that uses [https://yaml.org/ YAML] as its syntax. It is a complete, functional, general purpose language, but can also be easily embedded in YAML files to make them dynamic at load time. Most existing YAML files and all JSON files are already valid YAMLScript programs. +'''[https://yamlscript.org YS (aka YAMLScript)]''' is a new programming language that uses [https://yaml.org/ YAML] as its syntax. It is a complete, functional, general purpose language, but can also be easily embedded in YAML files to make them dynamic at load time. Most existing YAML files and all JSON files are already valid YS programs. -You can learn YAMLScript for free (with help from experienced mentors) at [https://exercism.org/tracks/yamlscript Exercism]. +You can learn YS for free (with help from experienced mentors) at [https://exercism.org/tracks/yamlscript Exercism]. -YAMLScript has a compiler/interpreter CLI program called [https://github.com/yaml/yamlscript/releases ys] and is also available in several programming languages as a binding module to the [https://github.com/yaml/yamlscript/releases libyamlscript.so] shared library: +YS has a compiler/interpreter CLI program called [https://github.com/yaml/yamlscript/releases ys] and is also available in several programming languages as a binding module to the [https://github.com/yaml/yamlscript/releases libyamlscript.so] shared library: * [https://clojars.org/org.yamlscript/clj-yamlscript Clojure] * [https://github.com/yaml/yamlscript-go Go] @@ -21,9 +21,9 @@ YAMLScript has a compiler/interpreter CLI program called [https://github.c * [https://rubygems.org/gems/yamlscript Ruby] * [https://crates.io/crates/yamlscript Rust] -==Installing YAMLScript== +==Installing YS== -Run this command to install the ys command line YAMLScript runner/loader/compiler program. +Run this command to install the ys command line YS runner/loader/compiler binary. curl -s https://yamlscript.org/install | bash @@ -34,14 +34,14 @@ That will install $HOME/.local/bin/ys. If $HOME/.local/binnd door   (door #2, #4, #6, ...),   and toggle it. +The second time, only visit every 2nd door (door #2, #4, #6, ...), and toggle it. -The third time, visit every 3rd door   (door #3, #6, #9, ...), etc,   until you only visit the 100th door. +The third time, visit every 3rd door (door #3, #6, #9, ...), etc, until you only visit the 100th door. ;Task: -Answer the question:   what state are the doors in after the last pass?   Which are open, which are closed? +Answer the question: what state are the doors in after the last pass? Which are open, which are closed? '''[[task feature::Rosetta Code:extra credit|Alternate]]:''' -As noted in this page's   [[Talk:100 doors|discussion page]],   the only doors that remain open are those whose numbers are perfect squares. +As noted in this page's [[Talk:100 doors|discussion page]], the only doors that remain open are those whose numbers are perfect squares. -Opening only those doors is an   [[task feature::Rosetta Code:optimization|optimization]]   that may also be expressed; +Opening only those doors is an [[task feature::Rosetta Code:optimization|optimization]] that may also be expressed; however, as should be obvious, this defeats the intent of comparing implementations across programming languages.

diff --git a/Task/100-doors/8080-Assembly/100-doors.8080 b/Task/100-doors/8080-Assembly/100-doors-1.8080 similarity index 100% rename from Task/100-doors/8080-Assembly/100-doors.8080 rename to Task/100-doors/8080-Assembly/100-doors-1.8080 diff --git a/Task/100-doors/8080-Assembly/100-doors-2.8080 b/Task/100-doors/8080-Assembly/100-doors-2.8080 new file mode 100644 index 0000000000..48acc304f5 --- /dev/null +++ b/Task/100-doors/8080-Assembly/100-doors-2.8080 @@ -0,0 +1,92 @@ + ;------------------------------------------------------ + ; useful equates + ;------------------------------------------------------ +wboot equ 0 ; jump to BIOS warm boot routine +bdos equ 5 ; BDOS entry +conout equ 2 ; BDOS console output function +putstr equ 9 ; BDOS print string function +ndoors equ 100 + ; + org 100h + lxi sp,stack ; set our own stack + lxi d,signon ; print signon message + mvi c,putstr + call bdos + ; + ; generate sequence of squares from 1 to specified limit + ; +gensqr: + lxi h,1 ; starting value of square + lxi d,3 ; starting value of increment + lxi b,ndoors+1 +sqrs2: + call cmpbchl ; have we exceeded the limit? + jnc done ; we're finished + call putdec ; otherwise print current square + mvi a,' ' ; separate with a space + call putchr + dad d ; square += incrememnt + inx d ; increment += 2 + inx d + jmp sqrs2 ; repeat until finished + ; +done: jmp wboot ; exit to command prompt + ; + ;--------------------------------------------------- + ; 16-bit unsigned comparison of HL and BC + ; if HL = BC then Z flag set + ; if HL < BC then CY flag set (NC if HL >= BC) + ;------------------------------------------------------ +cmpbchl: + mov a,h + cmp b + rnz + mov a,l + cmp c + ret + ;--------------------------------------------------- + ; console output of char in A register + ;--------------------------------------------------- +putchr: push h + push d + push b + mov e,a + mvi c,conout + call bdos + pop b + pop d + pop h + ret + ;--------------------------------------------------- + ; Output decimal number to console + ; HL holds 16-bit unsigned binary number to print + ;--------------------------------------------------- +putdec: push b + push d + push h + lxi b,-10 + lxi d,-1 +putdec2: + dad b + inx d + jc putdec2 + lxi b,10 + dad b + xchg + mov a,h + ora l + cnz putdec ; recursive call + mov a,e + adi '0' + call putchr + pop h + pop d + pop b + ret + ;--------------------------------------------------- + ; data area and stack + ;--------------------------------------------------- +signon: db 'The open doors are: $' +stack equ $+128 ; 64-level stack + ; + end diff --git a/Task/100-doors/C-sharp/100-doors-1.cs b/Task/100-doors/C-sharp/100-doors-1.cs index d06413f95c..3e031cc721 100644 --- a/Task/100-doors/C-sharp/100-doors-1.cs +++ b/Task/100-doors/C-sharp/100-doors-1.cs @@ -5,11 +5,10 @@ namespace ConsoleApplication1 { static void Main(string[] args) { + // Arrays are initialized to their type default values; the default for bool is false + // Use false to indicate closed door bool[] doors = new bool[100]; - //Close all doors to start. - for (int d = 0; d < 100; d++) doors[d] = false; - //For each pass... for (int p = 0; p < 100; p++)//number of passes { @@ -24,7 +23,7 @@ namespace ConsoleApplication1 } //Output the results. - Console.WriteLine("Passes Completed!!! Here are the results: \r\n"); + Console.WriteLine("Passes Completed!!! Here are the results:"); for (int d = 0; d < 100; d++) { if (doors[d]) diff --git a/Task/100-doors/C/100-doors-3.c b/Task/100-doors/C/100-doors-3.c index fb7f7feb29..d8fed2c66e 100644 --- a/Task/100-doors/C/100-doors-3.c +++ b/Task/100-doors/C/100-doors-3.c @@ -1,19 +1,14 @@ #include +#include -int main() -{ - int square = 1, increment = 3, door; - for (door = 1; door <= 100; ++door) - { - printf("door #%d", door); - if (door == square) - { - printf(" is open.\n"); - square += increment; - increment += 2; - } - else - printf(" is closed.\n"); - } - return 0; +int main() { + uint32_t doorBytes[4] = {0}; + + for (uint32_t i = 1; i <= 100; ++i) + for (uint32_t j = i - 1; j <= 99; j += i) + doorBytes[j % 4] ^= (uint32_t)1 << j / 4; + + for (uint32_t i = 0; i <= 99; doorBytes[i++ % 4] >>= 1) + if (doorBytes[i % 4] & 1) + printf("door %d is open\n", i + 1); } diff --git a/Task/100-doors/C/100-doors-4.c b/Task/100-doors/C/100-doors-4.c index a1972a382b..fb7f7feb29 100644 --- a/Task/100-doors/C/100-doors-4.c +++ b/Task/100-doors/C/100-doors-4.c @@ -2,8 +2,18 @@ int main() { - int door, square, increment; - for (door = 1, square = 1, increment = 1; door <= 100; door++ == square && (square += increment += 2)) - printf("door #%d is %s.\n", door, (door == square? "open" : "closed")); + int square = 1, increment = 3, door; + for (door = 1; door <= 100; ++door) + { + printf("door #%d", door); + if (door == square) + { + printf(" is open.\n"); + square += increment; + increment += 2; + } + else + printf(" is closed.\n"); + } return 0; } diff --git a/Task/100-doors/C/100-doors-5.c b/Task/100-doors/C/100-doors-5.c index 4988099e36..a1972a382b 100644 --- a/Task/100-doors/C/100-doors-5.c +++ b/Task/100-doors/C/100-doors-5.c @@ -2,9 +2,8 @@ int main() { - int i; - for (i = 1; i * i <= 100; i++) - printf("door %d open\n", i * i); - - return 0; + int door, square, increment; + for (door = 1, square = 1, increment = 1; door <= 100; door++ == square && (square += increment += 2)) + printf("door #%d is %s.\n", door, (door == square? "open" : "closed")); + return 0; } diff --git a/Task/100-doors/C/100-doors-6.c b/Task/100-doors/C/100-doors-6.c new file mode 100644 index 0000000000..4988099e36 --- /dev/null +++ b/Task/100-doors/C/100-doors-6.c @@ -0,0 +1,10 @@ +#include + +int main() +{ + int i; + for (i = 1; i * i <= 100; i++) + printf("door %d open\n", i * i); + + return 0; +} diff --git a/Task/100-doors/Emacs-Lisp/100-doors.l b/Task/100-doors/Emacs-Lisp/100-doors-1.l similarity index 100% rename from Task/100-doors/Emacs-Lisp/100-doors.l rename to Task/100-doors/Emacs-Lisp/100-doors-1.l diff --git a/Task/100-doors/Emacs-Lisp/100-doors-2.l b/Task/100-doors/Emacs-Lisp/100-doors-2.l new file mode 100644 index 0000000000..66b2cff437 --- /dev/null +++ b/Task/100-doors/Emacs-Lisp/100-doors-2.l @@ -0,0 +1,16 @@ +(defun one-hundred-doors(initial-state) + "Turn doors in INITIAL-STATE according to 100 Doors problem." + (interactive "nEnter initial doors' state (as a number): ") + (cl-loop for x from 1 to 100 + do (cl-loop for y from (1- x) to 99 by x + do (setq initial-state (logxor initial-state (ash 1 y))))) + (let ((counter 1) + (open-doors nil)) + (while (> initial-state 0) + (when (eq (mod initial-state 2) 1) + (push counter open-doors)) + (cl-incf counter) + (setq initial-state (/ initial-state 2))) + (message "Open doors are %s" (reverse open-doors)))) + +(one-hundred-doors 0) diff --git a/Task/100-doors/Langur/100-doors-2.langur b/Task/100-doors/Langur/100-doors-2.langur index f0f96dadfb..9fbe548626 100644 --- a/Task/100-doors/Langur/100-doors-2.langur +++ b/Task/100-doors/Langur/100-doors-2.langur @@ -1 +1 @@ -writeln foldfrom(fn a, b, c: if(b: a~[c]; a), [], doors, series(1..len(doors))) +writeln fold(doors, series(1..len(doors)), by=fn a, b, c: if(b: a~[c]; a), init=[]) diff --git a/Task/100-doors/Langur/100-doors-3.langur b/Task/100-doors/Langur/100-doors-3.langur index 67108b6065..61d90f3fb8 100644 --- a/Task/100-doors/Langur/100-doors-3.langur +++ b/Task/100-doors/Langur/100-doors-3.langur @@ -1 +1 @@ -writeln map(fn{^2}, 1..10) +writeln map(1..10, by=fn{^2}) diff --git a/Task/100-doors/Plain-English/100-doors.plain b/Task/100-doors/Plain-English/100-doors.plain index 056c6f1ec1..2ebc38ce0b 100644 --- a/Task/100-doors/Plain-English/100-doors.plain +++ b/Task/100-doors/Plain-English/100-doors.plain @@ -1,14 +1,31 @@ +A flag list is a doubly linked list with a flag. +A door is a flag list. +A pass is a number. + +To run: + Start up. + Pass doors given 1000 and 1000 passes. + Shut down. + +To pass doors given a count and some passes: + Create some doors given the count. + Loop. + Add 1 to a counter. + If the counter is greater than the passes, break. + Go through the doors given the counter and the passes. + Repeat. + Output the states of the doors. + Destroy the doors. + To create some doors given a count: Loop. - If a counter is past the count, exit. + Add 1 to a counter. + If the counter is greater than the count, exit. Allocate memory for a door. 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: Put 0 into a counter. Loop. @@ -18,37 +35,23 @@ To go through some doors given a number and some passes: Invert the door's flag. Repeat. +To pick a door from some doors given a number: + Loop. + Add 1 to a counter. + If the counter is greater than the number, exit. + Get the door from the doors. + If the door is nil, exit. + Repeat. + To output the states of some doors: Loop. Bump a counter. Get a door from the doors. If the door is nil, exit. If the door's flag is set, - Write "Door " then the counter then " is open" to the output; + Write "Door " then the counter then " is open" + then the CRLF string to StdOut; Repeat. - Write "Door " then the counter then " is closed" to the output. + \Write "Door " then the counter then " is closed" + \then the CRLF string to StdOut. Repeat. - -To pass doors given a count and some passes: - Create some doors given the count. - Loop. - If a counter is past the passes, break. - Go through the doors given the counter and the passes. - Repeat. - Output the states of the doors. - Destroy the doors. - -A pass is a number. - -To pick a door from some doors given a number: - Loop. - If a counter is past the number, exit. - Get the door from the doors. - If the door is nil, exit. - Repeat. - -To run: - Start up. - Pass doors given 100 and 100 passes. - Wait for the escape key. - Shut down. diff --git a/Task/100-doors/V-(Vlang)/100-doors-3.v b/Task/100-doors/V-(Vlang)/100-doors-3.v index bce04b6c59..8f720ebff3 100644 --- a/Task/100-doors/V-(Vlang)/100-doors-3.v +++ b/Task/100-doors/V-(Vlang)/100-doors-3.v @@ -1,5 +1,11 @@ +import math + +const number_doors = 101 + fn main() { - for i in 1..11 { - print ( " Door ${i*i} is open.\n" ) - } + max_i := int(math.sqrt(f64(number_doors - 1))) + 1 + for i in 1..max_i { + door := i * i + println("Door ${door} open") + } } diff --git a/Task/100-doors/V-(Vlang)/100-doors-4.v b/Task/100-doors/V-(Vlang)/100-doors-4.v new file mode 100644 index 0000000000..bce04b6c59 --- /dev/null +++ b/Task/100-doors/V-(Vlang)/100-doors-4.v @@ -0,0 +1,5 @@ +fn main() { + for i in 1..11 { + print ( " Door ${i*i} is open.\n" ) + } +} diff --git a/Task/100-doors/YAMLScript/100-doors.ys b/Task/100-doors/YAMLScript/100-doors.ys index 23c45269c2..7e63c2a67d 100644 --- a/Task/100-doors/YAMLScript/100-doors.ys +++ b/Task/100-doors/YAMLScript/100-doors.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(): open =: diff --git a/Task/100-doors/Zig/100-doors-4.zig b/Task/100-doors/Zig/100-doors-4.zig index 53b792a533..14d911f591 100644 --- a/Task/100-doors/Zig/100-doors-4.zig +++ b/Task/100-doors/Zig/100-doors-4.zig @@ -1,8 +1,7 @@ pub fn main() !void { const stdout = @import("std").io.getStdOut().writer(); - var door: u8 = 1; - while (door * door <= 100) : (door += 1) { + for(1..11) |door| { try stdout.print("Door {d} is open\n", .{door * door}); } } diff --git a/Task/100-prisoners/ALGOL-68/100-prisoners.alg b/Task/100-prisoners/ALGOL-68/100-prisoners.alg new file mode 100644 index 0000000000..e8858ff506 --- /dev/null +++ b/Task/100-prisoners/ALGOL-68/100-prisoners.alg @@ -0,0 +1,66 @@ +BEGIN # 100 prisoners # + +CO begin code from the Knuth shuffle task CO +PROC between = (INT a, b)INT : +( + ENTIER (random * ABS (b-a+1) + (a 0 THEN r = z - 1 + CASE 4: IF z MOD 4 <> 0 THEN r = z + 1 + END SELECT + LOOP WHILE (r < 1) OR (r > 16) + d(z) = d(r) + z = r + d(z) = 0 + NEXT n + CLS +END SUB + +FUNCTION introAndLevel + CLS + sh(1) = 10 + sh(2) = 50 + sh(3) = 100 + PRINT "15 PUZZLE GAME": PRINT: PRINT + PRINT "Please enter level of difficulty," + DO + PRINT "1 (easy), 2 (medium) or 3 (hard): "; + INPUT level + LOOP WHILE (level < 1) OR (level > 3) + introAndLevel = level +END FUNCTION + +FUNCTION isMoveValid (piece AS INTEGER, piecePos AS INTEGER, emptyPos AS INTEGER) + mv = 0 + IF (piece >= 1) AND (piece <= 15) THEN + piecePos = piecePosition(piece) + emptyPos = piecePosition(0) + IF (piecePos - 4 = emptyPos) OR (piecePos + 4 = emptyPos) OR ((piecePos - 1 = emptyPos) AND (emptyPos MOD 4 <> 0)) OR ((piecePos + 1 = emptyPos) AND (piecePos MOD 4 <> 0)) THEN + mv = 1 + END IF + END IF + isMoveValid = mv +END FUNCTION + +FUNCTION isPuzzleComplete + pc = 0 + p = 1 + WHILE (p < 16) AND (d(p) = p) + p = p + 1 + WEND + IF p = 16 THEN pc = 1 + isPuzzleComplete = pc +END FUNCTION + +FUNCTION piecePosition (piece AS INTEGER) + p = 1 + WHILE d(p) <> piece + p = p + 1 + IF p > 16 THEN + PRINT "UH OH!" + STOP + END IF + WEND + piecePosition = p +END FUNCTION + +SUB printPuzzle + FOR p = 1 TO 16 + IF d(p) = 0 THEN + dbp$(p) = " " + ELSE + dbp$(p) = RIGHT$(" " + LTRIM$(STR$(d(p))), 3) + " " + END IF + NEXT p + + PRINT "+-----+-----+-----+-----+" + PRINT "|"; dbp$(1); "|"; dbp$(2); "|"; dbp$(3); "|"; dbp$(4); "|" + PRINT "+-----+-----+-----+-----+" + PRINT "|"; dbp$(5); "|"; dbp$(6); "|"; dbp$(7); "|"; dbp$(8); "|" + PRINT "+-----+-----+-----+-----+" + PRINT "|"; dbp$(9); "|"; dbp$(10); "|"; dbp$(11); "|"; dbp$(12); "|" + PRINT "+-----+-----+-----+-----+" + PRINT "|"; dbp$(13); "|"; dbp$(14); "|"; dbp$(15); "|"; dbp$(16); "|" + PRINT "+-----+-----+-----+-----+" +END SUB diff --git a/Task/2048/Guile/2048.guile b/Task/2048/Guile/2048.guile new file mode 100644 index 0000000000..f8b103f0d4 --- /dev/null +++ b/Task/2048/Guile/2048.guile @@ -0,0 +1,312 @@ +;;require-module (ice-9 format) +;;usage -> [~4d] print-board +;; +(use-modules (ice-9 format)) + +;;require-module (srfi srfi-64) +;;usage -> test-assert +;; +(use-modules (srfi srfi-64)) + +;;prodedure-name 2or4-generator +;;input -> <$:nil> +;;output -> _ (number) +;;note -> "it only generates 2 or 4, with a 10% of outputting 4" +;; +(define 2or4-generator + (lambda () + (let ([random-number (random 10)]) + (if (zero? random-number) + 4 + 2)))) + +;;procedure-name print-board +;;input -> board (array::4*4) +;;output -> <$:nil> +;; +(define print-board + (lambda (board) + (do ((i 0 (1+ i))) + ((> i 3)) + (do ((j 0 (1+ j))) + ((> j 3)) + (format #t "[~4d]" (array-ref board i j))) + (newline)))) + +;;procedure-name spawn! +;;input -> 4x4board (array::4*4) +;;output -> <$:nil> +;; +(define spawn! + (lambda (4x4board) + (let ([indexes '()]) + (do ((i 0 (1+ i))) + ((> i 3)) + (do ((j 0 (1+ j))) + ((> j 3)) + (when (zero? (array-ref 4x4board i j)) + (set! indexes (cons (cons i j) indexes))))) + (let* ([indexes-length (length indexes)] + [used-index-index (random indexes-length)] + [used-index-pair (list-ref indexes used-index-index)]) + (array-set! 4x4board (2or4-generator) (car used-index-pair) (cdr used-index-pair)))))) + +;;procedure-name ask-user +;;input -> valid-moves (list:symbol) +;;output -> _ (symbol) [(memq <$:self:_> (list 'up 'down 'left 'right)) => #t] +;;note -> "this procedure assumes there is at least one valid move" +;; +(define ask-user + (lambda (valid-moves) + (let loop () + (let ([option (read)]) + (if (memq option valid-moves) + (case option + [(up) 'up] + [(down) 'down] + [(left) 'left] + [(right) 'right] + [else (begin + (display "wrong input! Please type up, down, left, or right only!") + (newline) + (loop))]) + (begin + (display "please use valid moves!") + (newline) + (display "valid moves: ") + (display valid-moves) + (newline) + (loop))))))) + +;;procedure-name update-row! +;;input -> row (array::1*4) +;;output -> <$:nil> +;; +(define update-row! + (lambda (row) + (unless (array-equal? row #(0 0 0 0)) + (let ([lst '()] [l 0]) + (when (not (zero? (array-ref row 3))) (set! l (1+ l)) (set! lst (cons (array-ref row 3) lst))) + (when (not (zero? (array-ref row 2))) (set! l (1+ l)) (set! lst (cons (array-ref row 2) lst))) + (when (not (zero? (array-ref row 1))) (set! l (1+ l)) (set! lst (cons (array-ref row 1) lst))) + (when (not (zero? (array-ref row 0))) (set! l (1+ l)) (set! lst (cons (array-ref row 0) lst))) + (do ((i 0 (1+ i))) + ((>= i (- 4 l))) + (array-set! row 0 i)) + (do ((i (- 4 l) (1+ i)) (j 0 (1+ j))) + ((>= i 4)) + (array-set! row (list-ref lst j) i))) + (if (= (array-ref row 3) (array-ref row 2)) + (begin (array-set! row (+ (array-ref row 3) (array-ref row 2)) 3) + (array-set! row (array-ref row 1) 2) + (array-set! row (array-ref row 0) 1) + (array-set! row 0 0) + (when (= (array-ref row 2) (array-ref row 1)) + (array-set! row (+ (array-ref row 2) (array-ref row 1)) 2) + (array-set! row 0 1))) + (if (= (array-ref row 2) (array-ref row 1)) + (begin (array-set! row (+ (array-ref row 2) (array-ref row 1)) 2) + (array-set! row (array-ref row 0) 1) + (array-set! row 0 0)) + (when (= (array-ref row 1) (array-ref row 0)) + (array-set! row (+ (array-ref row 1) (array-ref row 0)) 1) + (array-set! row 0 0))))))) + +;;procedure-name update-board! +;;input -> board (array::4*4) +;;output -> <$:nil> +;;note -> "this procedure can assume that the opertion is shifting the piles right" +;; +(define update-board! + (lambda (board) + (do ((i 0 (1+ i))) + ((>= i 4)) + (update-row! (array-cell-ref board i))))) + +;;procedure-name row-can-shift-qright? +;;input -> row (array::1*4) +;;output -> _ (#t or #f) +;; +(define row-can-shift-right? + (lambda (row) + (if (and (zero? (array-ref row 0)) + (zero? (array-ref row 1)) + (zero? (array-ref row 2))) + #f + (if (or (zero? (array-ref row 3)) + (and (not (zero? (array-ref row 0))) (member 0 (list + (array-ref row 1) + (array-ref row 2) + (array-ref row 3)))) + (and (not (zero? (array-ref row 1))) (member 0 (list + (array-ref row 2) + (array-ref row 3)))) + (and (not (zero? (array-ref row 2))) (member 0 (list + (array-ref row 3))))) + #t + (if (or (and (not (zero? (array-ref row 0))) (= (array-ref row 0) (array-ref row 1))) + (and (not (zero? (array-ref row 1))) (= (array-ref row 1) (array-ref row 2))) + (and (not (zero? (array-ref row 2))) (= (array-ref row 2) (array-ref row 3)))) + #t + #f))))) + +(define test-row-can-shift-right? + (lambda () + (test-begin "row-can-shift-right? test") + (test-assert (row-can-shift-right? #(2 0 0 0))) + (test-assert (row-can-shift-right? #(0 2 0 0))) + (test-assert (row-can-shift-right? #(0 0 2 0))) + (test-assert (not (row-can-shift-right? #(0 0 0 2)))) + (test-assert (row-can-shift-right? #(4 2 0 0))) + (test-assert (row-can-shift-right? #(2 0 0 2))) + (test-assert (row-can-shift-right? #(1024 8 2 2))) + (test-end "row-can-shift-right? test"))) + +;;procedure-name can-shift-right? +;;input -> board (array::4*4) +;;output -> _ (#t or #f) +;; +(define can-shift-right? + (lambda (board) + (or (row-can-shift-right? (array-cell-ref board 0)) + (row-can-shift-right? (array-cell-ref board 1)) + (row-can-shift-right? (array-cell-ref board 2)) + (row-can-shift-right? (array-cell-ref board 3))))) + +(define test-can-shift-right? + (lambda () + (test-begin "can-shift-right? test") + (test-assert (can-shift-right? #2((2 0 0 2) + (0 0 0 0) + (0 0 0 0) + (0 0 0 0)))) + (test-assert (can-shift-right? #2((2 0 0 0) + (0 0 0 0) + (0 0 0 0) + (2 0 0 0)))) + (test-assert (not (can-shift-right? #2((2 8 4 8) + (2 16 4 8) + (0 0 0 4) + (0 0 0 2))))) + (test-end "can-shift-right? test"))) + +;;procedure-name valid-move? +;;input -> board (array::4*4) +;;output -> _ (symbol) [(eq? 'gameover <$:self:_>) => #t] +;;output -> _ (list:symbol[1 or 2 or 3 or 4]) +;;note -> "the list symbol should only contain up, down, left, right" +;; +(define valid-move? + (lambda (board) + (let* ([output-lst '()] + [rows board] + [columns (make-shared-array rows + (lambda (i j) + (list j i)) + 4 4)] + [rows-reversed (make-shared-array rows + (lambda (i j) + (list i (- 3 j))) + 4 4)] + [columns-reversed (make-shared-array columns + (lambda (i j) + (list i (- 3 j))) + 4 4)]) + (when (can-shift-right? rows) (set! output-lst (append (list 'right) output-lst))) + (when (can-shift-right? rows-reversed) (set! output-lst (append (list 'left) output-lst))) + (when (can-shift-right? columns) (set! output-lst (append (list 'down) output-lst))) + (when (can-shift-right? columns-reversed) (set! output-lst (append (list 'up) output-lst))) + (if (null? output-lst) + 'gameover + output-lst)))) + +(define test-valid-move? + (lambda () + (test-begin "valid-move? test") + (test-assert (eq? 'gameover (valid-move? #2((8 4 2 16) + (2 8 4 32) + (4 2 8 16) + (128 4 16 64))))) + (test-assert (equal? (list 'up 'down 'left 'right) (valid-move? #2((0 0 0 0) + (0 2 0 0) + (0 0 0 0) + (0 0 0 2))))) + (test-end "valid-move? test"))) + +;;prodedure-name check-game-status! +;;input -> board (array::4*4) +;;output -> _ (symbol) +;;note -> "The thing this procedure should implement: 1.decide whether there is a 2048 tile on board, if so, return 'win 2.decide the valid moves next time and return them as a list like (list 'up 'down 'right) or anything equivalent (if there is no valid moves, just return 'gameover)" +;; +(define check-game-status! + (lambda (board) + (spawn! board) + (let ([all-tiles (list (array-ref board 0 0) + (array-ref board 0 1) + (array-ref board 0 2) + (array-ref board 0 3) + (array-ref board 1 0) + (array-ref board 1 1) + (array-ref board 1 2) + (array-ref board 1 3) + (array-ref board 2 0) + (array-ref board 2 1) + (array-ref board 2 2) + (array-ref board 2 3) + (array-ref board 3 0) + (array-ref board 3 1) + (array-ref board 3 2) + (array-ref board 3 3))]) + (if (member 2048 all-tiles) + 'win + (valid-move? board))))) + +;;procedure-name play +;;input -> <$:nil> +;;output -> _ (array:4*4) +;; +(define play + (lambda () + (set! *random-state* (random-state-from-platform)) + (let ([board (make-array 0 4 4)]) + (let* ([rows board] + [columns (make-shared-array rows + (lambda (i j) + (list j i)) + 4 4)] + [rows-reversed (make-shared-array rows + (lambda (i j) + (list i (- 3 j))) + 4 4)] + [columns-reversed (make-shared-array columns + (lambda (i j) + (list i (- 3 j))) + 4 4)]) + (spawn! rows) + (let loop ([turn 1] [available-moves (valid-move? rows)]) + (format #t "TURN ~d" turn) + (newline) + (print-board rows) + (case (ask-user available-moves) + [(up) (update-board! columns-reversed)] + [(down) (update-board! columns)] + [(left) (update-board! rows-reversed)] + [(right) (update-board! rows)] + [else (error "something went wrong! The return stuff from (ask-user availuable-moves) is not among 'up 'down 'left 'right! This normally should never be reached.")]) + (let ([symbols (check-game-status! rows)]) + (cond + [(symbol? symbols) (case symbols + [(win) (begin + (display "You win!") + (newline) + (print-board rows))] + [(gameover) (begin + (display "You lose!") + (newline) + (print-board rows))] + [else (error "While not intended, we named what the procedure (check-game-status rows) returned as symbols, checking it as a symbol which passed, then we get this. But we coded this to be 'win or 'gameover !")])] + [(list? symbols) (begin + (display "Valid moves: ") + (display symbols) + (newline) + (loop (1+ turn) symbols))]))))))) diff --git a/Task/24-game-Solve/FreeBASIC/24-game-solve.basic b/Task/24-game-Solve/FreeBASIC/24-game-solve.basic new file mode 100644 index 0000000000..4593f64cb2 --- /dev/null +++ b/Task/24-game-Solve/FreeBASIC/24-game-solve.basic @@ -0,0 +1,124 @@ +Type GameState + digitos(3) As Double + operaciones(2) As String +End Type + +Function randomDigits() As String + Dim As String resultado = "" + For i As Integer = 0 To 3 + resultado &= Str(Int(Rnd * 9) + 1) + Next + Return resultado +End Function + +Function evaluate(digitos() As Double, operaciones() As String) As Double + Dim As Double valor = digitos(0) + + For i As Integer = 0 To 2 + Select Case operaciones(i) + Case "+": valor += digitos(i +1) + Case "-": valor -= digitos(i +1) + Case "*": valor *= digitos(i +1) + Case "/": If digitos(i +1) <> 0 Then valor /= digitos(i +1) + End Select + Next + + Return valor +End Function + +Sub permute(digitos() As Double, soluciones() As GameState, Byref solutionCnt As Integer, k As Integer) + Dim As String*1 opChars(3) = {"+", "-", "*", "/"} + Dim As String ops(2) + Dim As Integer i, j, l, m + + If k = 4 Then + For i = 0 To 3 + ops(0) = opChars(i) + For j = 0 To 3 + ops(1) = opChars(j) + For l = 0 To 3 + ops(2) = opChars(l) + If Abs(evaluate(digitos(), ops()) - 24) < 0.001 Then + With soluciones(solutionCnt) + For m = 0 To 3: .digitos(m) = digitos(m): Next + For m = 0 To 2: .operaciones(m) = ops(m): Next + End With + solutionCnt += 1 + Exit For 'Stop after first solution + End If + Next + If solutionCnt Then Exit For + Next + If solutionCnt Then Exit For + Next + Else + For i = k To 3 + Swap digitos(i), digitos(k) + permute(digitos(), soluciones(), solutionCnt, k +1) + If solutionCnt Then Exit For + Swap digitos(k), digitos(i) + Next + End If +End Sub + +' Main program +Randomize Timer +Dim As Integer i +Dim As String cmd +Dim As Double digitos(3) +Dim As String operaciones(2) + +Do + Cls + Print "24 Game" + Print "Generating 4 digitos..." + + Dim As String inputDigits = randomDigits() + Print "Make 24 using these digitos: "; + For i = 1 To Len(inputDigits) + Print Mid(inputDigits, i, 1); " "; + Next + Print + + Line Input "Enter your expression (e.g. 4+5*3-2): ", cmd + + Dim As Integer digitCnt = 0, opCnt = 0 + ' Parse user input + For i = 1 To Len(cmd) + Select Case Mid(cmd, i, 1) + Case "1" To "9" + digitos(digitCnt) = Val(Mid(cmd, i, 1)) + digitCnt += 1 + Case "+", "-", "*", "/" + operaciones(opCnt) = Mid(cmd, i, 1) + opCnt += 1 + End Select + Next + + Dim As Double resultado = evaluate(digitos(), operaciones()) + Print "Your resultado: "; resultado + + If Abs(resultado - 24) < 0.001 Then + Print !"\nCongratulations, you found a solution!" + Else + Print !"\nThe valor of your expression is "; resultado; " instead of 24!" + + Dim As GameState soluciones(1000) + Dim As Integer solucCnt = 0 + + permute(digitos(), soluciones(), solucCnt, 0) + + If solucCnt > 0 Then + Print !"\nA possible solution could have been: "; + With soluciones(0) + Print .digitos(0) & .operaciones(0) & .digitos(1) & .operaciones(1) & .digitos(2) & .operaciones(2) & .digitos(3) + End With + Else + Print !"\nThere was no known solution for these digitos." + End If + End If + + Print !"\nDo you want to try again? (press N for exit, other key to continue)" +Loop Until (Ucase(Input(1)) = "N") + +Sleep diff --git a/Task/24-game/EasyLang/24-game.easy b/Task/24-game/EasyLang/24-game.easy index aa12c02486..812e03f085 100644 --- a/Task/24-game/EasyLang/24-game.easy +++ b/Task/24-game/EasyLang/24-game.easy @@ -1,6 +1,5 @@ -print "Enter an equation in RPN form using all of, and" -print "only the following single digits which evaluates" -print "to 24. Only '*', '/', '+' and '-' are allowed:" +print "Enter an equation in RPN form using all of, and only " +print "the following single digits which evaluates to 24:" func game . len cnt[] 9 write ">> " diff --git a/Task/24-game/J/24-game.j b/Task/24-game/J/24-game.j index 73034a24eb..928663b455 100644 --- a/Task/24-game/J/24-game.j +++ b/Task/24-game/J/24-game.j @@ -1,6 +1,6 @@ require'misc' -deal=: 1 + ? bind 9 9 9 9 -rules=: smoutput bind 'see http://en.wikipedia.org/wiki/24_Game' +deal=: 1 + ? @ 9 9 9 9 +rules=: echo @ 'see http://en.wikipedia.org/wiki/24_Game' input=: prompt @ ('enter 24 expression using ', ":, ': '"_) wellformed=: (' '<;._1@, ":@[) -:&(/:~) '(+-*%)' -.&;:~ ] diff --git a/Task/4-rings-or-4-squares-puzzle/Quackery/4-rings-or-4-squares-puzzle.quackery b/Task/4-rings-or-4-squares-puzzle/Quackery/4-rings-or-4-squares-puzzle.quackery new file mode 100644 index 0000000000..fd5fa00757 --- /dev/null +++ b/Task/4-rings-or-4-squares-puzzle/Quackery/4-rings-or-4-squares-puzzle.quackery @@ -0,0 +1,36 @@ + [ swap dip [ 1+ split drop ] + split nip ] is slice ( [ n n --> [ ) + + [ 0 swap witheach + ] is sum ( [ --> n ) + + [ slice sum join ] is square ( [ [ n n --> [ ) + + [ true swap + behead swap witheach + [ over = not if + [ dip not conclude ] ] + drop ] is same ( [ --> b ) + + [ [] temp put + over - 1+ times + [ dup i^ + temp gather ] + drop + temp take ] is low->high ( n n --> [ ) + + [ [] temp put + witheach + [ [] + over 0 1 square + over 1 3 square + over 3 5 square + over 5 6 square + same iff + [ nested temp gather ] + else drop ] + temp take ] is task ( [ n --> [ ) + + 1 7 low->high permutations task + witheach [ echo cr ] cr + 3 9 low->high permutations task + witheach [ echo cr ] cr + 0 9 low->high 7 arrangements task size echo diff --git a/Task/99-bottles-of-beer/Dart/99-bottles-of-beer.dart b/Task/99-bottles-of-beer/Dart/99-bottles-of-beer.dart index 3251bd7375..07a966aa75 100644 --- a/Task/99-bottles-of-beer/Dart/99-bottles-of-beer.dart +++ b/Task/99-bottles-of-beer/Dart/99-bottles-of-beer.dart @@ -57,5 +57,3 @@ class BeerSong extends Song { return theLyrics; } } - -} diff --git a/Task/99-bottles-of-beer/Elixir/99-bottles-of-beer.ex b/Task/99-bottles-of-beer/Elixir/99-bottles-of-beer-1.ex similarity index 100% rename from Task/99-bottles-of-beer/Elixir/99-bottles-of-beer.ex rename to Task/99-bottles-of-beer/Elixir/99-bottles-of-beer-1.ex diff --git a/Task/99-bottles-of-beer/Elixir/99-bottles-of-beer-2.ex b/Task/99-bottles-of-beer/Elixir/99-bottles-of-beer-2.ex new file mode 100644 index 0000000000..21f101524c --- /dev/null +++ b/Task/99-bottles-of-beer/Elixir/99-bottles-of-beer-2.ex @@ -0,0 +1,36 @@ +last = [ + """ + 2 bottles of beer on the wall + 2 bottles of beer + Take one down, pass it around + 1 bottle of beer on the wall + """, + """ + 1 bottle of beer on the wall + 1 bottle of beer + Take one down, pass it around + No bottles of beer on the wall + """, + """ + No more bottles of beer on the wall + No more bottles of beer + Go to the store and buy some more + 99 bottles of beer on the wall + """ +] + +skeleton = fn n -> + """ + #{n} bottles of beer on the wall + #{n} bottles of beer + Take one down, pass it around + #{n - 1} bottles of beer on the wall + """ +end + +99..3 +|> Stream.map(skeleton) +|> Stream.concat(last) +|> Enum.intersperse("\n") +|> IO.iodata_to_binary() +|> IO.puts() diff --git a/Task/99-bottles-of-beer/Java/99-bottles-of-beer-5.java b/Task/99-bottles-of-beer/Java/99-bottles-of-beer-5.java new file mode 100644 index 0000000000..394eb68af8 --- /dev/null +++ b/Task/99-bottles-of-beer/Java/99-bottles-of-beer-5.java @@ -0,0 +1,76 @@ +import java.util.Scanner; + +public class NineNineBottles { + static int bottlesOfBeer = 99; + static boolean hasBeer = true; + static Scanner keyboard = new Scanner(System.in); + + public static void main(String[] args) { + beerCheck(); + keyboard.close(); + } + + private static void beerCheck() { + if(hasBeer) { + party(bottlesOfBeer); + } + + if(!hasBeer) { + System.out.println("Your ran out of beer. Would you like to go to the store?: "); + String blurryVision, fallingOver, youAreDrunk; + youAreDrunk = keyboard.nextLine(); + fallingOver = "RUHFO" + youAreDrunk.toLowerCase() + "RUHFOISafhur"; + blurryVision = fallingOver.split("[a-zA-Z]", 2).toString(); + if(blurryVision.contains("y")) + blurryVision = blurryVision.substring(0, 1).toUpperCase(); + System.out.println("You entered: " + blurryVision.toString() + fallingOver); + System.out.println("Did you mean yes?: "); + blurryVision = keyboard.nextLine(); + if(blurryVision.contains("y") || blurryVision.contains("Y") || blurryVision.contains("8") + || blurryVision.contains("2") || blurryVision.equalsIgnoreCase(youAreDrunk)) + {String beRECcheeck = blurryVision.toLowerCase(); + if(beRECcheeck.equals("y")) { + goToStore(); + beerCheck(); + } + } + } + } + + private static void party(int bottlesOfBeer) { + while(bottlesOfBeer > 1) { + putOnWall(bottlesOfBeer); + bottlesOfBeer = takeOneDown(bottlesOfBeer); + } + putLastOnWall(bottlesOfBeer); + } + + private static void putOnWall(int bottlesOfBeer) { + System.out.printf("%d bottles of beer on the wall%n", bottlesOfBeer); + + } + + private static int takeOneDown(int bottlesOfBeer) { + System.out.printf("%d bottles of beer%n", bottlesOfBeer); + System.out.println("Take one down, pass it around"); + bottlesOfBeer--; + putOnWall(bottlesOfBeer); + System.out.println(); + return bottlesOfBeer; + + } + + private static void putLastOnWall(int bottleOfBeer) { + System.out.printf("%d bottle of beer on the wall%n", bottleOfBeer); + System.out.printf("%d bottle of beer%n", bottleOfBeer); + System.out.println("Take it down, pass it around"); + bottleOfBeer--; + System.out.println("No more bottles of beer on the wall."); + hasBeer = false; + } + + private static void goToStore() { + bottlesOfBeer = 99; + hasBeer = true; + } +} diff --git a/Task/99-bottles-of-beer/Nutt/99-bottles-of-beer.nutt b/Task/99-bottles-of-beer/Nutt/99-bottles-of-beer.nutt index ccd2ec6780..fcac676e27 100644 --- a/Task/99-bottles-of-beer/Nutt/99-bottles-of-beer.nutt +++ b/Task/99-bottles-of-beer/Nutt/99-bottles-of-beer.nutt @@ -1,8 +1,8 @@ -module main imports native.io.output.say +module main +import $native 'io' : output#sayn -for i|->{1,2..99;<|>) do - say(""+i+" bottles of beer on the wall, "+i+" bottles of beer") - say("Take one down and pass it around, "+(i-1)+" bottles of beer on the wall.") -done - -end +funct main () : () = + [1, 2; 99]#reverse#each { + sayn "\(it) bottles of beer on the wall, \(it) bottles of beer"; + sayn "Take one down and pass it around, \(it# - 1) bottles of beer on the wall." + } 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 2ad5b109ca..5dc37d24c9 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,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(number=99): each num (number .. 1): diff --git a/Task/A+B/Guile/a+b.guile b/Task/A+B/Guile/a+b.guile new file mode 100644 index 0000000000..d3ef4f223d --- /dev/null +++ b/Task/A+B/Guile/a+b.guile @@ -0,0 +1,3 @@ +;;;Actually, the solution is same as that of many other Lisp dialects here +(+ (read) (read)) +;;Yes, it is neat but not strong, error prone actually. Other than this walkaround, if you dislike fetching a line in string format then parse the chars one by one by hand or byte by byte from stdin, you can use one read and do the work, with the price of typing (1 2) instead of 1 2 at the prompt since read would treat the input as a symbolic expression. So.,.there is sadly no easy way like scanf and %d %d in c unless one is willing to type ()s! diff --git a/Task/A+B/LOLCODE/a+b.lol b/Task/A+B/LOLCODE/a+b.lol new file mode 100644 index 0000000000..711b24849b --- /dev/null +++ b/Task/A+B/LOLCODE/a+b.lol @@ -0,0 +1,9 @@ +HAI 1.2 + I HAS A VAR1 ITZ A YARN BTW DECLARE A VARIABLE FOR LATER USE + I HAS A VAR2 ITZ A YARN BTW DECLARE A VARIABLE FOR LATER USE + VISIBLE "NUMBAH 1?" + GIMMEH VAR1 BTW GET INPUT (NUMBER) INTO VARIABLE + VISIBLE "NUMBAH 2?" + GIMMEH VAR2 BTW GET INPUT (NUMBER) INTO VARIABLE + VISIBLE SUM OF VAR1 AN VAR2 +KTHXBYE diff --git a/Task/A+B/Nutt/a+b.nutt b/Task/A+B/Nutt/a+b.nutt index 50a609c5d5..5b0625667e 100644 --- a/Task/A+B/Nutt/a+b.nutt +++ b/Task/A+B/Nutt/a+b.nutt @@ -1,7 +1,8 @@ module main -imports native.io{input.hear,output.say} +import $native 'io' [input#hear output#sayn] -vals a=hear(Int),b=hear(Int) -say(a+b) - -end +funct main () : () = + val read_int = {(hear ())#to_int#fold {0} {it}}; + val a = read_int (); + val b = read_int (); + sayn (a# + b) diff --git a/Task/A+B/Plain-English/a+b.plain b/Task/A+B/Plain-English/a+b.plain index 01ffffe01a..4187b423eb 100644 --- a/Task/A+B/Plain-English/a+b.plain +++ b/Task/A+B/Plain-English/a+b.plain @@ -1,21 +1,42 @@ To run: Start up. - Read a number from the console. - Read another number from the console. - Output the sum of the number and the other number. - Wait for the escape key. + Set up the console. + Write "Type the first number: " to Stdout. + Read a buffer from stdin. + Trim the buffer. + If the buffer is not any integer, + Write "Invalid input. Aborting Operation." + then the CRLF string to StdOut; + Shut down; + Exit. + Write "Type the second number: " to Stdout. + Read a second buffer from stdin. + Trim the second buffer. + If the second buffer is not any integer, + Write "Invalid input. Aborting Operation." + then the CRLF string to StdOut; + Shut down; + Exit. + Convert the buffer to a number. + Convert the second buffer to a second number. + Output the sum of the number and the second number. Shut down. To output the sum of a number and another number: If the number is not valid, - Write "Invalid input" to the console; + Write "Invalid input. Aborting Operation." + then the CRLF string to StdOut; Exit. If the other number is not valid, - Write "Invalid input" to the console; + Write "Invalid input. Aborting Operation." + then the CRLF string to StdOut; Exit. - Write the number plus the other number then " is the sum." to the console. + Add the other number to the number. + Convert the number to a string called result. + Write "The sum is " then the result + then the CRLF string to StdOut. To decide if a number is valid: - If the number is not greater than or equal to -1000, say no. - If the number is not less than or equal to 1000, say no. + If the number is less than -1000, say no. + If the number is greater than 1000, say no. Say yes. diff --git a/Task/A+B/ZED/a+b.zed b/Task/A+B/ZED/a+b.zed index 6c28d79b86..b3605ef199 100644 --- a/Task/A+B/ZED/a+b.zed +++ b/Task/A+B/ZED/a+b.zed @@ -1,14 +1,14 @@ (A+B) -comment: +READ AND ADD #true (+) (read) (read) (+) one two -comment: +========= #true (003) "+" one two (read) -comment: +========= #true (001) "read" diff --git a/Task/A+B/Zig/a+b.zig b/Task/A+B/Zig/a+b.zig index fc0d17b9f6..378622f54f 100644 --- a/Task/A+B/Zig/a+b.zig +++ b/Task/A+B/Zig/a+b.zig @@ -1,25 +1,18 @@ const std = @import("std"); -const stdout = std.io.getStdOut().writer(); - -const Input = enum { a, b }; pub fn main() !void { var buf: [1024]u8 = undefined; const reader = std.io.getStdIn().reader(); + const stdout = std.io.getStdOut().writer(); + try stdout.writeAll("Enter two integers separated by a space: "); const input = try reader.readUntilDelimiter(&buf, '\n'); - const values = std.mem.trim(u8, input, "\x20"); + const text = std.mem.trimRight(u8, input, "\r\n"); - var count: usize = 0; - var split: usize = 0; - for (values, 0..) |c, i| { - if (!std.ascii.isDigit(c)) { - count += 1; - if (count == 1) split = i; - } - } + var it = std.mem.tokenizeScalar(u8, text, ' '); + + const a = try std.fmt.parseInt(i64, it.next().?, 10); + const b = try std.fmt.parseInt(i64, it.next().?, 10); - const a = try std.fmt.parseInt(u64, values[0..split], 10); - const b = try std.fmt.parseInt(u64, values[split + count ..], 10); try stdout.print("{d}\n", .{a + b}); } diff --git a/Task/AKS-test-for-primes/FutureBasic/aks-test-for-primes.basic b/Task/AKS-test-for-primes/FutureBasic/aks-test-for-primes.basic new file mode 100644 index 0000000000..c94e8f7494 --- /dev/null +++ b/Task/AKS-test-for-primes/FutureBasic/aks-test-for-primes.basic @@ -0,0 +1,102 @@ +// AKS Test for Primes task +// https://rosettacode.org/wiki/AKS_test_for_primes +// Translated from Yabasic to FutureBASIC + + +#build ShowMoreWarnings NO + +begin globals + sInt64 c(100) + //double n +end globals + +local fn coef(nx as short) + // out-by-1, ie coef(1)==^0, coef(2)==^1, coef(3)==^2 etc. + c(nx) = 1 + short i + for i = nx-1 to 2 step -1 + c(i) = c(i) + c(i-1) + next +end fn + +local fn is_prime(nx as short) as boolean + short i + bool result = _false + fn coef(nx+1) // (I said it was out-by-1) + for i = 2 to nx-1 // (technically "to n" is more correct) + if int(c(i)/nx) <> c(i)/nx + return _false + end if + next + + result = _true +end fn = result + +local fn show(nx as short) + // (As per coef, this is (working) out-by-1) + + double ci + str255 cix + short i + + for i = nx to 1 step -1 + ci = c(i) + if ci = 1 + if (nx-i) mod 2 = 0 + if i = 1 + if nx = 1 + cix = " 1" + else + cix = "+1" + end if + else + cix = "" + end if + else + cix = "-1" + end if + else + if (nx-i) mod 2 = 0 + cix = "+" + str$(ci) + else + cix = "-" + str$(ci) + end if + end if + + if i = 1 // ie ^0 + print cix; + else + if i = 2 then print cix, "x"; // ie ^1 + if i <> 2 then print cix, "x^", i-1; + end if + + next i +end fn + +local fn AKS_test_for_primes + short nx + + for nx = 1 to 10 // (0 to 9 really) + fn coef(nx) + print "(x-1)^" + str$(nx-1) + " = "; + fn show(nx) + print + next + + print + print "primes (<=53): "; + short n + c(2) = 1 // (this manages "", which is all that call did anyway...) + for n = 2 to 53 + if fn is_prime(n) + print " ", n; + end if + next + print +end fn + +window 1,@"AKS test for Primes",fn CGRectMake(0, 0, 850, 200) + +fn AKS_test_for_primes + +handleevents diff --git a/Task/AKS-test-for-primes/REXX/aks-test-for-primes-3.rexx b/Task/AKS-test-for-primes/REXX/aks-test-for-primes-3.rexx index 79dc451c4e..77862e7896 100644 --- a/Task/AKS-test-for-primes/REXX/aks-test-for-primes-3.rexx +++ b/Task/AKS-test-for-primes/REXX/aks-test-for-primes-3.rexx @@ -1,12 +1,14 @@ -parse version version; say version -say 'AKS-test for Primes'; say +include Settings + +say version +say 'AKS-test for primes'; say arg p if p = '' then p = 10 numeric digits Max(10,Abs(p)%3) call Combis p call Polynomials p -call ShowPrimes p +call Showprimes p exit Combis: @@ -17,7 +19,7 @@ if p > 0 then say 'Combinations up to' p'...' else say 'Combinations for' Abs(p)'...' -say Combinations(p) 'Combinations generated' +say Combinations(p) 'combinations generated' say Format(Time('e'),,3) 'seconds' say return @@ -33,9 +35,9 @@ else b = 0 p = Abs(p); prim. = 0; n = 0 do i = b to p - a = Ppower('1 -1',i) + a = Ppow('1 -1',i) if i < 11 then - say '(x-1)^'i '=' Parray2formula() + say '(x-1)^'i '=' Plst2form(Parr2lst()) s = 1 do j = 2 to poly.0-1 a = poly.coef.j @@ -56,7 +58,7 @@ say Format(Time('e'),,3) 'seconds' say return -ShowPrimes: +Showprimes: procedure expose prim. arg p call Time('r') @@ -64,9 +66,9 @@ say 'Primes...' if p < 0 then do p = Abs(p) if prim.0 > 0 then - say p 'is Prime' + say p 'is prime' else - say p 'is not Prime' + say p 'is not prime' end else do do i = 1 to prim.0 @@ -80,124 +82,8 @@ say Format(Time('e'),,3) 'seconds' say return -Combinations: -/* Combinations */ -procedure expose comb. -arg xx -/* Validate */ -if \ Whole(xx) then say abend -/* Recurring definition */ -comb. = 1 -if xx < 0 then do - xx = -xx; m = xx%2; a = 1 - do i = 1 to m - a = a*(xx-i+1)/i; comb.xx.i = a - end - do i = m+1 to xx-1 - j = xx-i; comb.xx.i = comb.xx.j - end - return xx+1 -end -else do - do i = 1 to xx - i1 = i-1 - do j = 1 to i1 - j1 = j-1; comb.i.j = comb.i1.j1+comb.i1.j - end - end - return (xx*xx+3*xx+2)/2 -end - -Ppower: -/* Exponentiation */ -procedure expose poly. comb. work. -arg x,y -/* Validate */ -if x = '' then say abend -if \ Whole(y) then say abend -if y < 0 then say abend -/* Exponentiate */ -numeric digits Digits()+2 -wx = Words(x); wm = wx*y-y+1 -poly. = 0; poly.0 = wm -select - when wx = 1 then -/* Power of a number */ - poly.coef.1 = x**y - when wx = 2 then do -/* Newton's binomial */ - a = Word(x,1); b = Word(x,2) - do i = 1 to wm - j = y-i+1; k = i-1 - poly.coef.i = comb.y.k*a**j*b**k - end - end - otherwise do -/* Repeated multiplication */ - do i = 1 to wx - poly.coef.1.i = Word(x,i) - poly.coef.2.i = poly.coef.1.i - end - wy = wx - do i = 2 to y - work. = 0 - do j = 1 to wx - do k = 1 to wy - l = j+k-1; work.coef.l = work.coef.l+poly.coef.1.j*poly.coef.2.k - end - end - if i = y then - leave i - wx = wx+wy-1 - do j = 1 to wx - poly.coef.1.j = work.coef.j - end - end - do i = 1 to wm - poly.coef.i = work.coef.i - end - end -end -numeric digits Digits()-2 -/* Normalize coefs */ -call Pnormalize -return wm - -Parray2formula: -/* Array -> Formula */ -procedure expose poly. -/* Generate formula */ -y = ''; wm = poly.0 -do i = 1 to wm - a = poly.coef.i - if a <> 0 then do - select - when a < 0 then - s = '-' - when i > 1 then - s = '+' - otherwise - s = '' - end - a = Abs(a); e = wm-i - if a = 1 & e > 0 then - a = '' - select - when e > 1 then - b = 'x^'e - when e = 1 then - b = 'x' - otherwise - b = '' - end - y = y||s||a||b - end -end -if y = '' then - y = 0 -return Strip(y) - include Functions include Numbers include Polynomial include Sequences +include Abend diff --git a/Task/ASCII-art-diagram-converter/Chipmunk-Basic/ascii-art-diagram-converter.basic b/Task/ASCII-art-diagram-converter/Chipmunk-Basic/ascii-art-diagram-converter.basic new file mode 100644 index 0000000000..54092c2681 --- /dev/null +++ b/Task/ASCII-art-diagram-converter/Chipmunk-Basic/ascii-art-diagram-converter.basic @@ -0,0 +1,84 @@ +100 cls +110 type tableentry +120 nombre as string *8 +130 bits as integer +140 startpos as integer +150 length as integer +160 end type +170 dim hexmap$(15) +180 hexmap$(0) = "0000" : hexmap$(1) = "0001" : hexmap$(2) = "0010" : hexmap$(3) = "0011" +190 hexmap$(4) = "0100" : hexmap$(5) = "0101" : hexmap$(6) = "0110" : hexmap$(7) = "0111" +200 hexmap$(8) = "1000" : hexmap$(9) = "1001" : hexmap$(10) = "1010" : hexmap$(11) = "1011" +210 hexmap$(12) = "1100" : hexmap$(13) = "1101" : hexmap$(14) = "1110" : hexmap$(15) = "1111" +220 dim fields(12) as tableentry +230 header$ = " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10) +240 header$ = header$+" | ID |"+chr$(10) +250 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10) +260 header$ = header$+" |QR| Opcode |AA|TC|RD|RA| Z | RCODE |"+chr$(10) +270 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10) +280 header$ = header$+" | QDCOUNT |"+chr$(10) +290 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10) +300 header$ = header$+" | ANCOUNT |"+chr$(10) +310 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10) +320 header$ = header$+" | NSCOUNT |"+chr$(10) +330 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+"+chr$(10) +340 header$ = header$+" | ARCOUNT |"+chr$(10) +350 header$ = header$+" +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" +360 fields(0).nombre = " ID " : fields(0).bits = 16 : fields(0).startpos = 0 : fields(0).length = 16 +370 fields(1).nombre = " QR " : fields(1).bits = 1 : fields(1).startpos = 16 : fields(1).length = 1 +380 fields(2).nombre = " Opcode " : fields(2).bits = 4 : fields(2).startpos = 17 : fields(2).length = 4 +390 fields(3).nombre = " AA " : fields(3).bits = 1 : fields(3).startpos = 21 : fields(3).length = 1 +400 fields(4).nombre = " TC " : fields(4).bits = 1 : fields(4).startpos = 22 : fields(4).length = 1 +410 fields(5).nombre = " RD " : fields(5).bits = 1 : fields(5).startpos = 23 : fields(5).length = 1 +420 fields(6).nombre = " RA " : fields(6).bits = 1 : fields(6).startpos = 24 : fields(6).length = 1 +430 fields(7).nombre = " Z " : fields(7).bits = 3 : fields(7).startpos = 25 : fields(7).length = 3 +440 fields(8).nombre = " RCODE " : fields(8).bits = 4 : fields(8).startpos = 28 : fields(8).length = 4 +450 fields(9).nombre = "QDCOUNT " : fields(9).bits = 16 : fields(9).startpos = 32 : fields(9).length = 16 +460 fields(10).nombre = "ANCOUNT " : fields(10).bits = 16 : fields(10).startpos = 48 : fields(10).length = 16 +470 fields(11).nombre = "NSCOUNT " : fields(11).bits = 16 : fields(11).startpos = 64 : fields(11).length = 16 +480 fields(12).nombre = "ARCOUNT " : fields(12).bits = 16 : fields(12).startpos = 80 : fields(12).length = 16 +490 hexstr$ = "78477bbf5496e12e1bf169a4" +500 binstr$ = hextobinary$(hexstr$) +510 print "RFC 1035 message diagram header:" +520 print header$ +530 print +540 print " Decoded:" +550 print " Name Bits Start End" +560 print " ======= ==== ===== ===" +570 for i = 0 to 12 +580 print " ";fields(i).nombre;" "; +581 print using "####";fields(i).bits;" "; +600 print using "#####";fields(i).startpos;" "; +601 print using "###";fields(i).startpos+fields(i).length-1 +610 next i +620 print +630 print " Test string in hex:" +640 print " ";hexstr$ +650 print +660 print " Test string in binary:" +670 print " ";binstr$ +680 print +690 print " Unpacked:" +700 print " Name Size Bit Pattern" +710 print " ======= ==== ================" +720 for i = 0 to 12 +730 bitpattern$ = mid$(binstr$,fields(i).startpos+1,fields(i).length) +740 bitpattern$ = left$(bitpattern$+" ",16) +760 print " ";fields(i).nombre;" "; +770 print using "####";fields(i).bits;" "; +780 print bitpattern$ +790 next i +800 end +810 sub hextobinary$(hexstring$) +820 result$ = "" +830 for i = 1 to len(hexstring$) +840 hexdigit$ = ucase$(mid$(hexstring$,i,1)) +850 if hexdigit$ >= "0" and hexdigit$ <= "9" then +860 idx = val(hexdigit$) +870 else +880 idx = asc(hexdigit$)-asc("A")+10 +890 endif +900 if idx >= 0 and idx <= 15 then result$ = result$+hexmap$(idx) +910 next i +920 hextobinary$ = result$ +930 end sub diff --git a/Task/ASCII-art-diagram-converter/FreeBASIC/ascii-art-diagram-converter.basic b/Task/ASCII-art-diagram-converter/FreeBASIC/ascii-art-diagram-converter.basic new file mode 100644 index 0000000000..6501672dfa --- /dev/null +++ b/Task/ASCII-art-diagram-converter/FreeBASIC/ascii-art-diagram-converter.basic @@ -0,0 +1,92 @@ +Type TableEntry + nombre As String * 8 + bits As Integer + startPos As Integer + length As Integer +End Type + +Function HexToBinary(hexString As String) As String + Dim As Integer i, idx + Dim As String hexDigit, result = "" + + ' Create hex to binary mapping + Dim As String hexMap(15) = { _ + "0000", "0001", "0010", "0011", "0100", "0101", "0110", "0111", _ + "1000", "1001", "1010", "1011", "1100", "1101", "1110", "1111" } + + For i = 0 To Len(hexString) - 1 + hexDigit = Ucase(Mid(hexString, i + 1, 1)) + ' Convert hex digit to index + idx = Iif(hexDigit >= "0" And hexDigit <= "9", Val(hexDigit), Asc(hexDigit) - Asc("A") + 10) + If idx >= 0 And idx <= 15 Then result &= hexMap(idx) + Next + Return result +End Function + +Sub ParseASCIIArt() + Dim As String header = _ + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _ + " | ID |" & Chr(10) & _ + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _ + " |QR| Opcode |AA|TC|RD|RA| Z | RCODE |" & Chr(10) & _ + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _ + " | QDCOUNT |" & Chr(10) & _ + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _ + " | ANCOUNT |" & Chr(10) & _ + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _ + " | NSCOUNT |" & Chr(10) & _ + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" & Chr(10) & _ + " | ARCOUNT |" & Chr(10) & _ + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + + Dim As TableEntry fields(12) = { _ + (" ID ", 16, 0, 16), _ + (" QR ", 1, 16, 1), _ + (" Opcode ", 4, 17, 4), _ + (" AA ", 1, 21, 1), _ + (" TC ", 1, 22, 1), _ + (" RD ", 1, 23, 1), _ + (" RA ", 1, 24, 1), _ + (" Z ", 3, 25, 3), _ + (" RCODE ", 4, 28, 4), _ + ("QDCOUNT ", 16, 32, 16), _ + ("ANCOUNT ", 16, 48, 16), _ + ("NSCOUNT ", 16, 64, 16), _ + ("ARCOUNT ", 16, 80, 16) } + + Dim As String hexStr = "78477bbf5496e12e1bf169a4" + Dim As String binStr = HexToBinary(hexStr) + Dim As Integer i + + ' Print header + Print "RFC 1035 message diagram header:" + Print header + + ' Print decoded fields + Print !"\n Decoded:" + Print !" Name Bits Start End\n ======= ==== ===== ===" + + For i = 0 To 12 + Print Using " \ \ #### ##### ###"; _ + fields(i).nombre; _ + fields(i).bits; _ + fields(i).startPos; _ + fields(i).startPos + fields(i).length - 1 + Next + + Print !"\n Test string in hex:\n " & hexStr + Print !"\n Test string in binary:\n " & binStr + Print !"\n Unpacked:" + Print !" Name Size Bit Pattern\n ======= ==== ===============" + + For i = 0 To 12 + Print Using " \ \ #### \ \"; _ + fields(i).nombre; _ + fields(i).bits; _ + Left(Mid(binStr, fields(i).startPos + 1, fields(i).length) + Space(16), 16) + Next +End Sub + +ParseASCIIArt() + +Sleep diff --git a/Task/ASCII-art-diagram-converter/PureBasic/ascii-art-diagram-converter.basic b/Task/ASCII-art-diagram-converter/PureBasic/ascii-art-diagram-converter.basic new file mode 100644 index 0000000000..b682c629b1 --- /dev/null +++ b/Task/ASCII-art-diagram-converter/PureBasic/ascii-art-diagram-converter.basic @@ -0,0 +1,94 @@ +Structure TableEntry + nombre.s + bits.i + startPos.i + length.i +EndStructure + +Procedure.s HexToBinary(hexString.s) + Dim hexMap.s(15) + hexMap(0) = "0000" : hexMap(1) = "0001" : hexMap(2) = "0010" : hexMap(3) = "0011" + hexMap(4) = "0100" : hexMap(5) = "0101" : hexMap(6) = "0110" : hexMap(7) = "0111" + hexMap(8) = "1000" : hexMap(9) = "1001" : hexMap(10) = "1010" : hexMap(11) = "1011" + hexMap(12) = "1100" : hexMap(13) = "1101" : hexMap(14) = "1110" : hexMap(15) = "1111" + + Protected.s result = "", hexDigit + Protected.i idx + + For i = 0 To Len(hexString) - 1 + hexDigit = UCase(Mid(hexString, i + 1, 1)) + If hexDigit >= "0" And hexDigit <= "9" + idx = Val(hexDigit) + Else + idx = Asc(hexDigit) - Asc("A") + 10 + EndIf + If idx >= 0 And idx <= 15 + result + hexMap(idx) + EndIf + Next + + ProcedureReturn result +EndProcedure + +Procedure ParseASCIIArt() + Protected header.s = " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ + + " | ID |" + #CRLF$ + + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ + + " |QR| Opcode |AA|TC|RD|RA| Z | RCODE |" + #CRLF$ + + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ + + " | QDCOUNT |" + #CRLF$ + + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ + + " | ANCOUNT |" + #CRLF$ + + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ + + " | NSCOUNT |" + #CRLF$ + + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + #CRLF$ + + " | ARCOUNT |" + #CRLF$ + + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + + Dim fields.TableEntry(12) + fields(0)\nombre = " ID " : fields(0)\bits = 16 : fields(0)\startPos = 0 : fields(0)\length = 16 + fields(1)\nombre = " QR " : fields(1)\bits = 1 : fields(1)\startPos = 16 : fields(1)\length = 1 + fields(2)\nombre = " Opcode " : fields(2)\bits = 4 : fields(2)\startPos = 17 : fields(2)\length = 4 + fields(3)\nombre = " AA " : fields(3)\bits = 1 : fields(3)\startPos = 21 : fields(3)\length = 1 + fields(4)\nombre = " TC " : fields(4)\bits = 1 : fields(4)\startPos = 22 : fields(4)\length = 1 + fields(5)\nombre = " RD " : fields(5)\bits = 1 : fields(5)\startPos = 23 : fields(5)\length = 1 + fields(6)\nombre = " RA " : fields(6)\bits = 1 : fields(6)\startPos = 24 : fields(6)\length = 1 + fields(7)\nombre = " Z " : fields(7)\bits = 3 : fields(7)\startPos = 25 : fields(7)\length = 3 + fields(8)\nombre = " RCODE " : fields(8)\bits = 4 : fields(8)\startPos = 28 : fields(8)\length = 4 + fields(9)\nombre = "QDCOUNT " : fields(9)\bits = 16 : fields(9)\startPos = 32 : fields(9)\length = 16 + fields(10)\nombre = "ANCOUNT " : fields(10)\bits = 16 : fields(10)\startPos = 48 : fields(10)\length = 16 + fields(11)\nombre = "NSCOUNT " : fields(11)\bits = 16 : fields(11)\startPos = 64 : fields(11)\length = 16 + fields(12)\nombre = "ARCOUNT " : fields(12)\bits = 16 : fields(12)\startPos = 80 : fields(12)\length = 16 + + Protected hexStr.s = "78477bbf5496e12e1bf169a4" + Protected binStr.s = HexToBinary(hexStr) + + PrintN("RFC 1035 message diagram header:") + PrintN(header) + PrintN(#CRLF$ + " Decoded:") + PrintN(" Name Bits Start End" + #CRLF$ + " ======= ==== ===== ===") + + For i = 0 To 12 + PrintN(RSet(fields(i)\nombre, 9) + " " + RSet(Str(fields(i)\bits), 4) + " " + + RSet(Str(fields(i)\startPos), 6) + " " + RSet(Str(fields(i)\startPos + fields(i)\length - 1), 4)) + Next + + PrintN(#CRLF$ + " Test string in hex:") + PrintN(" " + hexStr) + PrintN(#CRLF$ + " Test string in binary:") + PrintN(" " + binStr) + PrintN(#CRLF$ + " Unpacked:") + PrintN(" Name Size Bit Pattern" + #CRLF$ + " ======= ==== ================") + + For i = 0 To 12 + bitPattern.s = Mid(binStr, fields(i)\startPos + 1, fields(i)\length) + bitPattern = Left(bitPattern + Space(16), 16) + PrintN(RSet(fields(i)\nombre, 9) + " " + RSet(Str(fields(i)\bits), 4) + " " + bitPattern) + Next +EndProcedure + +OpenConsole() + +ParseASCIIArt() +PrintN(#CRLF$ + "Press ENTER to exit"): Input() +CloseConsole() diff --git a/Task/ASCII-art-diagram-converter/QBasic/ascii-art-diagram-converter.basic b/Task/ASCII-art-diagram-converter/QBasic/ascii-art-diagram-converter.basic new file mode 100644 index 0000000000..a5c32ea3b5 --- /dev/null +++ b/Task/ASCII-art-diagram-converter/QBasic/ascii-art-diagram-converter.basic @@ -0,0 +1,95 @@ +DECLARE SUB ParseASCIIArt () +DECLARE FUNCTION HexToBinary$ (hexString AS STRING) + +TYPE TableEntry + nombre AS STRING * 8 + bits AS INTEGER + startPos AS INTEGER + length AS INTEGER +END TYPE + +ParseASCIIArt +END + +FUNCTION HexToBinary$ (hexString AS STRING) + DIM hexMap(15) AS STRING + hexMap(0) = "0000": hexMap(1) = "0001": hexMap(2) = "0010": hexMap(3) = "0011" + hexMap(4) = "0100": hexMap(5) = "0101": hexMap(6) = "0110": hexMap(7) = "0111" + hexMap(8) = "1000": hexMap(9) = "1001": hexMap(10) = "1010": hexMap(11) = "1011" + hexMap(12) = "1100": hexMap(13) = "1101": hexMap(14) = "1110": hexMap(15) = "1111" + + result$ = "" + FOR i = 0 TO LEN(hexString) - 1 + hexDigit$ = UCASE$(MID$(hexString, i + 1, 1)) + IF hexDigit$ >= "0" AND hexDigit$ <= "9" THEN + idx = VAL(hexDigit$) + ELSE + idx = ASC(hexDigit$) - ASC("A") + 10 + END IF + IF idx >= 0 AND idx <= 15 THEN result$ = result$ + hexMap(idx) + NEXT + HexToBinary$ = result$ +END FUNCTION + +SUB ParseASCIIArt + DIM header AS STRING + header = " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10) + header = header + " | ID |" + CHR$(10) + header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10) + header = header + " |QR| Opcode |AA|TC|RD|RA| Z | RCODE |" + CHR$(10) + header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10) + header = header + " | QDCOUNT |" + CHR$(10) + header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10) + header = header + " | ANCOUNT |" + CHR$(10) + header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10) + header = header + " | NSCOUNT |" + CHR$(10) + header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + CHR$(10) + header = header + " | ARCOUNT |" + CHR$(10) + header = header + " +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+" + + DIM fields(12) AS TableEntry + fields(0).nombre = " ID ": fields(0).bits = 16: fields(0).startPos = 0: fields(0).length = 16 + fields(1).nombre = " QR ": fields(1).bits = 1: fields(1).startPos = 16: fields(1).length = 1 + fields(2).nombre = " Opcode ": fields(2).bits = 4: fields(2).startPos = 17: fields(2).length = 4 + fields(3).nombre = " AA ": fields(3).bits = 1: fields(3).startPos = 21: fields(3).length = 1 + fields(4).nombre = " TC ": fields(4).bits = 1: fields(4).startPos = 22: fields(4).length = 1 + fields(5).nombre = " RD ": fields(5).bits = 1: fields(5).startPos = 23: fields(5).length = 1 + fields(6).nombre = " RA ": fields(6).bits = 1: fields(6).startPos = 24: fields(6).length = 1 + fields(7).nombre = " Z ": fields(7).bits = 3: fields(7).startPos = 25: fields(7).length = 3 + fields(8).nombre = " RCODE ": fields(8).bits = 4: fields(8).startPos = 28: fields(8).length = 4 + fields(9).nombre = "QDCOUNT ": fields(9).bits = 16: fields(9).startPos = 32: fields(9).length = 16 + fields(10).nombre = "ANCOUNT ": fields(10).bits = 16: fields(10).startPos = 48: fields(10).length = 16 + fields(11).nombre = "NSCOUNT ": fields(11).bits = 16: fields(11).startPos = 64: fields(11).length = 16 + fields(12).nombre = "ARCOUNT ": fields(12).bits = 16: fields(12).startPos = 80: fields(12).length = 16 + + hexStr$ = "78477bbf5496e12e1bf169a4" + binStr$ = HexToBinary$(hexStr$) + + PRINT "RFC 1035 message diagram header:" + PRINT header + PRINT + PRINT " Decoded:" + PRINT " Name Bits Start End" + PRINT " ======= ==== ===== ===" + + FOR i = 0 TO 12 + PRINT USING " \ \ #### ##### ###"; fields(i).nombre; fields(i).bits; fields(i).startPos; fields(i).startPos + fields(i).length - 1 + NEXT + + PRINT + PRINT " Test string in hex:" + PRINT " "; hexStr$ + PRINT + PRINT " Test string in binary:" + PRINT " "; binStr$ + PRINT + PRINT " Unpacked:" + PRINT " Name Size Bit Pattern" + PRINT " ======= ==== ===============" + + FOR i = 0 TO 12 + bitPattern$ = MID$(binStr$, fields(i).startPos + 1, fields(i).length) + bitPattern$ = LEFT$(bitPattern$ + SPACE$(16), 16) + PRINT USING " \ \ #### \ \"; fields(i).nombre; fields(i).bits; bitPattern$ + NEXT +END SUB diff --git a/Task/Abbreviations-automatic/Crystal/abbreviations-automatic.cr b/Task/Abbreviations-automatic/Crystal/abbreviations-automatic.cr new file mode 100644 index 0000000000..fb78aea856 --- /dev/null +++ b/Task/Abbreviations-automatic/Crystal/abbreviations-automatic.cr @@ -0,0 +1,12 @@ +def auto_abbreviate (string) + words = string.split + return nil unless words.present? + (1..words.max_of(&.size)).each do |n| + return n if words.map(&.[0, n]).to_set.size == words.size + end + "∞" +end + +File.read_lines("weekdays.txt").each_with_index do |line, i| + puts "#{i+1}) #{auto_abbreviate(line)} #{line}" +end diff --git a/Task/Abbreviations-simple/M2000-Interpreter/abbreviations-simple-3.m2000 b/Task/Abbreviations-simple/M2000-Interpreter/abbreviations-simple-3.m2000 new file mode 100644 index 0000000000..e710dbc3c6 --- /dev/null +++ b/Task/Abbreviations-simple/M2000-Interpreter/abbreviations-simple-3.m2000 @@ -0,0 +1,71 @@ +Module Abbreviations_simple { + commands=list + a$="add 1 alter 3 backup 2 bottom 1 Cappend 2 change 1 Schange Cinsert 2 Clast 3 " + a$+="compress 4 copy 2 count 3 Coverlay 3 cursor 3 delete 3 Cdelete 2 down 1 duplicate " + a$+="3 xEdit 1 expand 3 extract 3 find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2 " + a$+="forward 2 get help 1 hexType 4 input 1 powerInput 3 join 1 split 2 spltJOIN load " + a$+="locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2 macro merge 2 modify 3 move 2 " + a$+="msg next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit read recover 3 " + a$+="refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left " + a$+="2 save set shift 2 si sort sos stack 3 status 4 top transfer 3 type 1 up 1" + gosub cleanspaces + gosub makelist + if not empty then gosub processstack + a$="riG rePEAT copies put mo rest types fup. 6 poweRin" + Print a$ + gosub cleanspaces + gosub findresult + a$="riG macro copies macr" + Print a$ + gosub cleanspaces + gosub findresult + End +processstack: + Read many, word$ + if many>0 and many"" then data 0, ucase$(w$):w$="" + end if + next + return +findresult: + dim a$() + a$()=piece$(ucase$(a$), " ") + flush + for i=0 to len(a$())-1 + if exist(commands, a$(i)) then + Data eval$(commands) + else + Data "*error*" + end if + next + Print Array([])#str$(" ") + Return +} +Abbreviations_simple diff --git a/Task/Abbreviations-simple/NewLISP/abbreviations-simple.l b/Task/Abbreviations-simple/NewLISP/abbreviations-simple.l index 2f137ce9e2..67b0ad7999 100644 --- a/Task/Abbreviations-simple/NewLISP/abbreviations-simple.l +++ b/Task/Abbreviations-simple/NewLISP/abbreviations-simple.l @@ -32,6 +32,6 @@ (push (or found? "*error*") result -1)) (join result " ")))) -(foo +(println (foo "riG rePEAT copies put mo rest types fup. 6 poweRin" -) +)) diff --git a/Task/Abstract-type/Arturo/abstract-type.arturo b/Task/Abstract-type/Arturo/abstract-type.arturo new file mode 100644 index 0000000000..ffff513cd7 --- /dev/null +++ b/Task/Abstract-type/Arturo/abstract-type.arturo @@ -0,0 +1,35 @@ +define :queue [ + init: method [][ + \items: [] + ] + + enqueue: method [item][ + panic "enqueue must be implemented by concrete type" + ] + + dequeue: method [][ + panic "dequeue must be implemented by concrete type" + ] +] + +define :simpleQueue is :queue [ + enqueue: method [item][ + \items: \items ++ item + ] + + dequeue: method [][ + if empty? \items -> return null + ret: first \items + \items: drop \items + return ret + ] +] + +q: to :simpleQueue []! + +q\enqueue "first" +q\enqueue "second" + +print q\dequeue +print q\dequeue +print q\dequeue diff --git a/Task/Achilles-numbers/FutureBasic/achilles-numbers.basic b/Task/Achilles-numbers/FutureBasic/achilles-numbers.basic new file mode 100644 index 0000000000..194d6b3e21 --- /dev/null +++ b/Task/Achilles-numbers/FutureBasic/achilles-numbers.basic @@ -0,0 +1,90 @@ +NSInteger local fn GCD( n as NSInteger, d as NSInteger ) + if ( d == 0 ) then return n else return fn GCD( d, n % d ) +end fn = 0 + +NSInteger local fn Totient( n as NSInteger ) + NSInteger tot = 0 + for NSInteger m = 1 to n + if fn GCD( m, n ) = 1 then tot++ + next + return tot +end fn = 0 + +BOOL local fn IsPowerful( m as NSInteger ) + int n = m + int f = 2 + double l = sqr(m) + + if m <= 1 then return NO + while ( YES ) + NSInteger q = n / f + if ( n % f ) == 0 + if ( m % (f * f) ) then return NO + n = q + if f > n then exit while + else + f++ + if ( f > l ) + if ( m % (n * n) ) then return NO + exit while + end if + end if + wend +end fn = YES + +BOOL local fn IsAchilles( n as NSInteger ) + if fn IsPowerful(n) == NO then return NO + NSInteger m = 2 + NSInteger a = m * m + do + do + if a == n then return NO + a *= m + until ( a > n ) + m++ + a = m * m + until ( a > n ) +end fn = YES + +local fn AchillesNumbers + print "First 50 Achilles numbers:" + NSInteger num = 0 + NSInteger n = 1 + + CFTimeInterval t : t = fn CACurrentMediaTime + do + if fn IsAchilles( n ) + printf @"%4d \b", n + num++ + if ( num % 10 ) != 0 then printf @" \b" else print + end if + n++ + until ( num >= 50 ) + + printf @"\n\nFirst 20 strong Achilles numbers:" + num = 0 + n = 1 + do + if fn IsAchilles(n) && fn IsAchilles( fn Totient(n) ) + printf @"%5d \b", n + num++ + if ( num % 5 ) != 0 then printf @" \b" else print + end if + n++ + until ( num >= 20 ) + + printf @"\n" + for NSInteger i = 2 to 6 + NSInteger inicio = fix( 10.0 ^ (i-1) ) + num = 0 + for n = inicio to inicio * 10 -1 + if fn IsAchilles(n) then num++ + next + printf @"Achilles numbers with %d digits: %d", i, num + next + printf @"\nCompute time: %.3f ms", (fn CACurrentMediaTime - t ) * 1000 +end fn + +fn AchillesNumbers + +HandleEvents diff --git a/Task/Achilles-numbers/PARI-GP/achilles-numbers.parigp b/Task/Achilles-numbers/PARI-GP/achilles-numbers.parigp new file mode 100644 index 0000000000..44391a9b19 --- /dev/null +++ b/Task/Achilles-numbers/PARI-GP/achilles-numbers.parigp @@ -0,0 +1,8 @@ +is(n,f=factor(n))=gcd(f[,2])==1 && vecmin(f[,2])>1 +first(n)=my(v=List()); forfactored(k=1,10^9, if(is(k[1],k[2]), listput(v,k[1]); if(#v==n, return(Vec(v))))) +firstStrong(n)=my(v=List()); forfactored(k=1,10^9, if(is(k[1],k[2]) && is(eulerphi(k)), listput(v,k[1]); if(#v==n, return(Vec(v))))) +countBetween(a,b)=my(s); forfactored(k=a,b, if(is(k[1],k[2]), s++)); s +countDigits(n)=countBetween(10^(n-1),10^n-1) +first(50) +firstStrong(20) +apply(countDigits, [2..5]) diff --git a/Task/Ackermann-function/ZED/ackermann-function.zed b/Task/Ackermann-function/ZED/ackermann-function.zed index a16fe385ad..af5d1c0f49 100644 --- a/Task/Ackermann-function/ZED/ackermann-function.zed +++ b/Task/Ackermann-function/ZED/ackermann-function.zed @@ -1,29 +1,29 @@ -(A) m n -comment: +(a) m n +M ZERO (=) m 0 (add1) n -(A) m n -comment: +(a) m n +N ZERO (=) n 0 -(A) (sub1) m 1 +(a) (sub1) m 1 -(A) m n -comment: +(a) m n +DEFAULT #true -(A) (sub1) m (A) m (sub1) n +(a) (sub1) m (a) m (sub1) n (add1) n -comment: +========= #true (003) "+" n 1 (sub1) n -comment: +========= #true (003) "-" n 1 (=) n1 n2 -comment: +========= #true (003) "=" n1 n2 diff --git a/Task/Additive-primes/Fortran/additive-primes.f b/Task/Additive-primes/Fortran/additive-primes.f new file mode 100644 index 0000000000..fe0cf1cf05 --- /dev/null +++ b/Task/Additive-primes/Fortran/additive-primes.f @@ -0,0 +1,66 @@ +program AdditivePrimes + implicit none + + integer :: i, j, digit_sum, count + logical :: is_prime + + ! Arrays to track prime numbers and additive primes + logical, dimension(500) :: prime_check + logical, dimension(500) :: additive_prime_check + + ! Initialize arrays + prime_check = .true. + prime_check(1) = .false. + additive_prime_check = .false. + + ! Sieve of Eratosthenes to find primes + do i = 2, int(sqrt(real(500))) + if (prime_check(i)) then + do j = i*i, 500, i + prime_check(j) = .false. + end do + end if + end do + + ! Find additive primes + count = 0 + do i = 2, 500 + if (prime_check(i)) then + ! Calculate digit sum + digit_sum = sum_digits(i) + + ! Check if digit sum is also prime + if (prime_check(digit_sum)) then + additive_prime_check(i) = .true. + count = count + 1 + end if + end if + end do + + ! Print results + print *, "Additive Primes less than 500:" + do i = 2, 500 + if (additive_prime_check(i)) then + print *, i + end if + end do + + print *, "Total number of additive primes:", count + + contains + + ! Function to calculate sum of digits + function sum_digits(num) result(total) + integer, intent(in) :: num + integer :: total, temp_num + + total = 0 + temp_num = num + + do while (temp_num > 0) + total = total + mod(temp_num, 10) + temp_num = temp_num / 10 + end do + end function sum_digits + + end program AdditivePrimes diff --git a/Task/Additive-primes/Langur/additive-primes.langur b/Task/Additive-primes/Langur/additive-primes.langur index 19042c8a58..70cff53c32 100644 --- a/Task/Additive-primes/Langur/additive-primes.langur +++ b/Task/Additive-primes/Langur/additive-primes.langur @@ -1,15 +1,15 @@ val isPrime = fn(i) { i == 2 or i > 2 and - not any(fn x: i div x, pseries(2 .. i ^/ 2)) + not any(series(2 .. i ^/ 2, asconly=true), by=fn x:i div x) } -val sumDigits = fn i: fold(fn{+}, s2n(string(i))) +val sumDigits = fn i: fold(s2n(string(i)), by=fn{+}) writeln "Additive primes less than 500:" var cnt = 0 -for i in [2] ~ series(3..500, 2) { +for i in [2] ~ series(3..500, inc=2) { if isPrime(i) and isPrime(sumDigits(i)) { write "{{i:3}} " cnt += 1 diff --git a/Task/Additive-primes/Scala/additive-primes.scala b/Task/Additive-primes/Scala/additive-primes.scala new file mode 100644 index 0000000000..447bb9eabb --- /dev/null +++ b/Task/Additive-primes/Scala/additive-primes.scala @@ -0,0 +1,26 @@ +def isPrime(n: Int): Boolean = { + @annotation.tailrec + def checkDivisor(d: Int): Boolean = { + if (d * d > n) true + else if (n % d == 0) false + else checkDivisor(d + 2) + } + + if (n < 2) false + else if (n == 2 || n == 3) true + else if (n % 2 == 0 || n % 3 == 0) false + else checkDivisor(5) +} + +private def digitSum(n: Int): Int = n.toString.map(_ - '0').sum + +private def additivePrime(n: Int): Boolean = isPrime(n) && isPrime(digitSum(n)) + +private def testAdditivePrime(max: Int): Unit = { + val result = (2 to max).filter(additivePrime) + println(result.mkString(", ")) + println(s"Found ${result.length} additive primes less than 500.") +} + +@main def main(): Unit = + testAdditivePrime(500) diff --git a/Task/Address-of-a-variable/Zig/address-of-a-variable.zig b/Task/Address-of-a-variable/Zig/address-of-a-variable.zig index 88fd6ff5ee..9012f0e79e 100644 --- a/Task/Address-of-a-variable/Zig/address-of-a-variable.zig +++ b/Task/Address-of-a-variable/Zig/address-of-a-variable.zig @@ -2,8 +2,9 @@ const std = @import("std"); pub fn main() !void { const stdout = std.io.getStdOut().writer(); - var i: i32 = undefined; - var address_of_i: *i32 = &i; - - try stdout.print("{x}\n", .{@intFromPtr(address_of_i)}); + const i: i32 = 76; + try stdout.print("{x} {*}\n", .{ + @intFromPtr(&i), + &i + }); } diff --git a/Task/Align-columns/8080-Assembly/align-columns.8080 b/Task/Align-columns/8080-Assembly/align-columns.8080 new file mode 100644 index 0000000000..2156a3485e --- /dev/null +++ b/Task/Align-columns/8080-Assembly/align-columns.8080 @@ -0,0 +1,212 @@ +putc equ 2 +puts equ 9 +fopen equ 15 +fclose equ 16 +fread equ 20 +FCB1 equ 5Ch +FCB2 equ 6Ch +DTA equ 80h +COLSEP equ '$' + org 100h + + ;;; Check arguments + lxi d,argmsg + lda FCB1+1 ; Check file argument + cpi ' ' + jz prmsg + lda FCB2+1 ; Check alignment argument + cpi 'L' + jz setal + cpi 'R' + jz setar + cpi 'C' + jnz prmsg + lxi h,center ; Set alignment function to run + jmp setfn +setal: lxi h,left + jmp setfn +setar: lxi h,right +setfn: shld alnfn+1 + + ;;; Initialize column lengths to 0 + xra a + lxi h,colw +inicol: mov m,a + inr l + jnz inicol + + ;;; Open file + lxi d,FCB1 + mvi c,fopen + call 5 + inr a + jz efile ; FF = error + + ;;; Process file + lxi h,maxw ; Find maximum widths + call rdlins + lxi h,alnlin ; Read lines and align columns + call rdlins + + ;;; Close file + lxi d,FCB1 + mvi c,fclose + jmp 5 + + ;;; Update maximum widths of columns, given line +maxw: lxi h,colw ; Column widths + lxi d,linbuf +mcol: mvi b,0FFh ; B = column width +mscan: inr b + ldax d ; Get current item + inx d ; Next item + call colend ; End of column? + jc mscan + push psw ; Keep column comparison + mov a,m ; Current width + cmp b ; Compare to new width + jnc mnxcol + mov m,b ; New one is bigger +mnxcol: inr l ; Next column + pop psw ; Restore column comparison + jz mcol ; Keep going if not end of line + ret + + ;;; Align and print columns of line +alnlin: lxi h,colw + lxi b,linbuf +alncol: lxi d,colbuf-1 +alnscn: inx d ; Copy current column to buffer + ldax b + stax d + inx b + call colend + jc alnscn + push psw + push h + push b +alncal: xra a ; Zero-terminate the buffer + stax d + mov a,m ; Current max column length + sub e ; Minus length of this column + mov b,a ; Set B = current padding needed +alnfn: call 0 ; Call selected alignment + pop b + pop h + inr l + pop psw + jz alncol ; Next column, if any + lxi d,newlin ; End line + mvi c,puts + jmp 5 + + ;;; Align column left and print +left: push b ; Save padding needed + lxi h,colbuf ; Print column + call print0 + pop b ; Restore padding + inr b ; Plus one, for separator between columns + + ;;; Print B spaces as padding +pad: xra a + ora b + rz ; No padding +padl: push b + mvi e,' ' + mvi c,putc + call 5 + pop b + dcr b + jnz padl + ret + + ;;; Align column right and print +right: call pad ; Padding first + lxi h,colbuf + call print0 ; Then column + mvi b,1 + jmp pad ; Separator space + + ;;; Align column in the center and print +center: mov a,b ; Split padding in half + rar + mov b,a + aci 0 + mov c,a + push b ; Keep both parts + call pad ; Left padding + lxi h,colbuf ; Print column + call print0 + pop b ; Restore padding + mov b,c ; Right padding + inr b ; Plus one for the separator + jmp pad + + ;;; Print 0-terminated string at HL +print0: mov a,m + ana a + rz + push h + mov e,m + mvi c,putc + call 5 + pop h + inx h + jmp print0 + + ;;; Does character in A end a column? + ;;; C clear if so. Z clear if also end of line. +colend: cpi 32 ; End of line? + cmc + rnc + cpi COLSEP ; Separator? + rz + stc ; If neither, set carry and return + ret + + ;;; Process file in FCB1 line by line + ;;; HL = line callback +rdlins: shld linecb+1 ; Set callback + xra a ; Start at beginning of file + sta FCB1+0Ch ; EX + sta FCB1+0Eh ; S2 + sta FCB1+0Fh ; RC + sta FCB1+20h ; AL + lxi d,linbuf ; Start write pointer at line buffer +rdrec: push d ; Keep write pointer + lxi d,FCB1 ; Read next record + mvi c,fread + call 5 + pop d ; Restore write pointer + dcr a ; 1 = EOF + rz + inr a + jnz efile ; Otherwise, <>0 = error + lxi h,DTA ; Reset read pointer to DTA +cpydat: mov a,m ; Copy byte to line buffer + stax d + inx d + cpi 26 ; EOF -> done + rz + cpi 10 ; (\r)\n -> EOL + jnz cnexb + push h ; Keep record pointer +linecb: call 0 ; Call callback routine + pop h ; Restore record pointer + lxi d,linbuf ; Reset line pointer +cnexb: inr l ; Next byte + jz rdrec ; Next record + jmp cpydat +efile: lxi d,filerr +prmsg: mvi c,puts + jmp 5 + + ;;; Messages +argmsg: db 'ALIGN FILE.TXT L/R/C$' +filerr: db 'FILE ERROR$' +newlin: db 13,10,'$' + + ;;; Variables +colw equ ($/256+1)*256 ; Column widths (page-aligned) +colbuf equ colw+256 ; Column buffer +linbuf equ colbuf+256 ; Line buffer diff --git a/Task/Align-columns/Cowgol/align-columns.cowgol b/Task/Align-columns/Cowgol/align-columns.cowgol new file mode 100644 index 0000000000..67428f2a4f --- /dev/null +++ b/Task/Align-columns/Cowgol/align-columns.cowgol @@ -0,0 +1,134 @@ +include "cowgol.coh"; +include "strings.coh"; +include "file.coh"; +include "argv.coh"; + +interface ColumnCb(colnum: uint8, col: [uint8], isLast: uint8); +sub ForEachColumn(fcb: [FCB], colfn: ColumnCb, colsep: uint8) is + var linebuf: uint8[256]; + var bufptr := &linebuf[0]; + + sub HandleColumns() is + var colbuf: uint8[256]; + var col: uint8 := 0; + var lineptr := &linebuf[0]; + var colptr := &colbuf[0]; + + while [lineptr] != 0 loop + if [lineptr] == colsep or [lineptr] == '\n' then + [colptr] := 0; + colptr := &colbuf[0]; + if [lineptr] == '\n' then + colfn(col, colptr, 1); + else + colfn(col, colptr, 0); + end if; + col := col + 1; + else + [colptr] := [lineptr]; + colptr := @next colptr; + end if; + lineptr := @next lineptr; + end loop; + end sub; + + var len := FCBExt(fcb); + FCBSeek(fcb, 0); + + while len > 0 loop + var ch := FCBGetChar(fcb); + [bufptr] := ch; + bufptr := @next bufptr; + len := len - 1; + + if ch == '\n' then + [bufptr] := 0; + HandleColumns(); + bufptr := &linebuf[0]; + end if; + end loop; +end sub; + +var columnWidths: uint8[256]; +sub FindColumnMaxWidths(fcb: [FCB], colsep: uint8) is + sub FindColumnMaxWidth implements ColumnCb is + var len := StrLen(col) as uint8; + if columnWidths[colnum] < len then + columnWidths[colnum] := len; + end if; + end sub; + + ForEachColumn(fcb, FindColumnMaxWidth, colsep); +end sub; + +sub Pad(padding: uint8) is + while padding > 0 loop + print_char(' '); + padding := padding - 1; + end loop; +end sub; + +interface Alignment(padding: uint8, string: [uint8]); +sub Left implements Alignment is + print(string); + Pad(padding); +end sub; + +sub Right implements Alignment is + Pad(padding); + print(string); +end sub; + +sub Center implements Alignment is + Pad(padding >> 1); + print(string); + Pad((padding >> 1) + (padding & 1)); +end sub; + +sub PrintColumnsAligned(fcb: [FCB], colsep: uint8, alignment: Alignment) is + sub PrintColumnAligned implements ColumnCb is + var len := StrLen(col) as uint8; + var padding := columnWidths[colnum] - len; + alignment(padding, col); + if isLast != 0 then + print_nl(); + else + print_char(' '); + end if; + end sub; + + ForEachColumn(fcb, PrintColumnAligned, colsep); +end sub; + +ArgvInit(); +var filename := ArgvNext(); +if filename == 0 as [uint8] then + print("No filename given\n"); + ExitWithError(); +end if; + +var align := ArgvNext(); +if align == 0 as [uint8] then + print("No alignment given\n"); + ExitWithError(); +end if; + +var alignment: Alignment; +case [align] & ~32 is + when 'L': alignment := Left; + when 'R': alignment := Right; + when 'C': alignment := Center; + when else: + print("Alignment must be L(eft), R(ight), or C(enter)\n"); + ExitWithError(); +end case; + +var file: FCB; +if FCBOpenIn(&file, filename) != 0 then + print("Cannot open file\n"); + ExitWithError(); +end if; + +const separator := '$'; +FindColumnMaxWidths(&file, separator); +PrintColumnsAligned(&file, separator, alignment); diff --git a/Task/Align-columns/Draco/align-columns.draco b/Task/Align-columns/Draco/align-columns.draco new file mode 100644 index 0000000000..3c5cfe9a9a --- /dev/null +++ b/Task/Align-columns/Draco/align-columns.draco @@ -0,0 +1,93 @@ +\util.g +char separator = '$'; + +type + colHandler = proc(byte n; *char col; bool last)void, + alignment = proc(byte padding; *char col)void; + +[256]byte ColWidths; +alignment Alignment; + +proc find_max_col_width(byte n; *char col; bool last) void: + if ColWidths[n] < CharsLen(col) then + ColWidths[n] := CharsLen(col) + fi +corp + +proc write_col_aligned(byte n; *char col; bool last) void: + byte padding; + padding := ColWidths[n] - CharsLen(col); + Alignment(padding, col); + if last then writeln() else write(' ') fi +corp + +proc pad(byte padding) void: + while padding>0 do write(' '); padding := padding-1 od +corp + +proc align_left(byte padding; *char col) void: write(col); pad(padding) corp +proc align_right(byte padding; *char col) void: pad(padding); write(col) corp +proc align_center(byte padding; *char col) void: + pad(padding>>1); + write(col); + pad((padding>>1) + (padding&1)) +corp + +proc do_line(*char line; colHandler handler) void: + byte col; + bool last; + char ch; + *char colstart; + col := 0; + colstart := line; + + while + ch := line*; + last := ch = '\e'; + if last or ch = separator then + line* := '\e'; + handler(col, colstart, last); + colstart := line+1; + col := col+1 + fi; + not last + do + line := line+1 + od +corp + +proc do_columns(*char filename; colHandler handler) void: + [256]char linebuf; + *char line; + channel input text in; + file(1024) infile; + + open(in, infile, filename); + line := &linebuf[0]; + while readln(in; line) do do_line(line, handler) od; + close(in); +corp + +proc ucase(char c) char: pretend(pretend(c, byte) & ~32, char) corp + +proc main() void: + *char filename, align; + word i; + for i from 0 upto 255 do ColWidths[i] := 0 od; + + filename := GetPar(); + if filename = nil then writeln("No filename given"); exit(1) fi; + + align := GetPar(); + if align = nil then writeln("No alignment given"); exit(1) fi; + + case ucase(align*) + incase 'L': Alignment := align_left + incase 'R': Alignment := align_right + incase 'C': Alignment := align_center + default: writeln("Alignment must be L/R/C"); exit(1) + esac; + + do_columns(filename, find_max_col_width); + do_columns(filename, write_col_aligned) +corp diff --git a/Task/Align-columns/Emacs-Lisp/align-columns.l b/Task/Align-columns/Emacs-Lisp/align-columns.l new file mode 100644 index 0000000000..a073ab13c1 --- /dev/null +++ b/Task/Align-columns/Emacs-Lisp/align-columns.l @@ -0,0 +1,251 @@ +(defun rob-even-p (integer) + "Test if INTEGER is even." + (= (% integer 2) 0)) + +(defun rob-odd-p (integer) + "Test if INTEGER is odd." + (not (rob-even-p integer))) + +(defun both-odd-or-both-even-p (x y) + "Test if X and Y are both even or both odd." + (or (and (rob-even-p x) (rob-even-p y)) + (and (rob-odd-p x) (rob-odd-p y)))) + +(defun word-lengths (words) + "Convert WORDS into list of lengths of each word." + (mapcar 'length words)) + +(defun get-one-row (row-number rows-columns-words) + "Get ROW-NUMBER row from ROWS-COLUMNS-WORDS. +ROWS-COLUMNS-WORDS is list of lists in form of row, column, word." + (seq-filter + (lambda (element) + (= row-number (car element))) + rows-columns-words)) + +(defun get-one-word (row-number column-number rows-columns-words) + "Get one word from ROWS-COLUMNS-WORDS at ROW-NUMBER and COLUMN-NUMBER. +ROWS-COLUMNS-WORDS is list of lists in form of row, column, word." + (delq nil + (mapcar + (lambda (element) + (when (= column-number (nth 1 element)) + (nth 2 element))) + (get-one-row row-number rows-columns-words)))) + +(defun get-last-row (rows-columns-words) + "Get the number of the last row of ROWS-COLUMNS-WORDS. +ROWS-COLUMNS-WORDS is a list of lists, each list in the form of +row, column, word." + (apply 'max (mapcar 'car rows-columns-words))) + +(defun list-nth-column (column rows-columns-words) + "List the words in column COLUMN of ROWS-COLUMNS-WORDS. +ROWS-COLUMNS-WORDS is a list of lists, each list in the form of row, column, +word." + (let ((row 1) + (column-word) + (last-row (get-last-row rows-columns-words )) + (matches nil)) + (while (and (<= row last-row) + (<= column (get-last-column rows-columns-words))) + (setq column-word (get-one-word row column rows-columns-words)) + (when (null column-word) + (setq column-word "")) + (push column-word matches) + (setq row (1+ row))) + (flatten-tree (nreverse matches)))) + +(defun get-widest-in-column (column) + "Get the widest word in COLUMN, which is a list of words." + (apply #'max (word-lengths column))) + +(defun get-column-width (column) + "Calculate the width of COLUMN, which is a list of words." + (+ (get-widest-in-column column) 2)) + +(defun get-column-widths (rows-columns-words) + "Make a list of the column widths in ROWS-COLUMNS-WORDS. +ROWS-COLUMNS-WORDS is list of lists, with each list in the form of row, column, +word." + (let ((last-column (get-last-column rows-columns-words)) + (column 1) + (columns)) + (while (<= column last-column) + (push (get-column-width (list-nth-column column rows-columns-words)) columns) + (setq column (1+ column))) + (reverse columns))) + +(defun add-column-widths (widths rows-columns-words) + "Add WIDTHS to ROWS-COLUMNS-WORDS. +ROWS-COLUMNS-WORDS is a list of lists, with each list in the form of row, +column, word. WIDTHS are the widths of each column. Output is a +list of lists, with each list in the form of column-width, row, +column, word." + (let ((new-data) + (new-database) + (column) + (width)) + (dolist (data rows-columns-words) + (setq column (cadr data)) + (setq width (nth (- column 1) widths)) + (setq new-data (push width data)) + (push new-data new-database)) + (nreverse new-database))) + +(defun get-last-column (rows-columns-words) + "Get the number of the last column in ROWS-COLUMNS-WORDS." + (apply 'max (mapcar 'cadr rows-columns-words))) + +(defun create-rows-columns-words () + "Put text from column-data.txt file in lists. +Each list consists of a row number, a column number, and a word." + (let ((lines) + (line-number 0) + (word-number) + (words)) + (with-temp-buffer + (insert-file-contents "~/Documents/Elisp/column_data.txt") + (beginning-of-buffer) + (dolist (line (split-string (buffer-string) "[\r\n]" :no-nulls)) + (push line lines)) + (setq lines (nreverse lines))) + (dolist (line lines) + (setq line-number (1+ line-number)) + (setq word-number 0) + (dolist (word (split-string line "\\$" :no-nulls)) + (setq word-number (1+ word-number)) + (push (list line-number word-number word) words))) + (setq words (nreverse words)))) + +(defun pad-for-center-align (column-width text) + "Pad TEXT to center in space of COLUMN-WIDTH." + (let* ((text-width (length text)) + (total-padding-length (- column-width text-width)) + (pre-padding-length) + (post-padding-length) + (pre-padding) + (post-padding)) + (if (both-odd-or-both-even-p text-width column-width) + (progn + (setq pre-padding-length (/ total-padding-length 2)) + (setq post-padding-length pre-padding-length)) + (setq pre-padding-length (+ (/ total-padding-length 2) 1)) + (setq post-padding-length (- pre-padding-length 1))) + (setq pre-padding (make-string pre-padding-length ? )) + (setq post-padding (make-string post-padding-length ? )) + (format "%s%s%s" pre-padding text post-padding))) + +(defun create-a-center-aligned-line (widths-1row-columns-words) + "Create a centered line based on WIDTHS-1ROW-COLUMNS-WORDS. +WIDTHS-1ROW-COLUMNS-WORDS is a list of lists. Each list consists +of the column-width, the row number, the column number, and the +word. The row number is the same in all lists." + (let ((full-line "") + (next-section)) + (insert "\n") + (dolist (word-data widths-1row-columns-words) + ;; below, nth 0 is the column width, nth 3 is the word + (setq next-section (pad-for-center-align (nth 0 word-data) (nth 3 word-data))) + (setq full-line (concat full-line next-section))) + (insert full-line))) + +(defun pad-for-left-align (column-width text) + "Pad TEXT to left-align in space of COLUMN-WIDTH." + (let* ((text-width (length text)) + (post-padding-length (- column-width text-width))) + (setq post-padding (make-string post-padding-length ? )) + (format "%s%s" text post-padding))) + +(defun create-a-left-aligned-line (widths-1row-columns-words) + "Create a left-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS. +Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column +width, the row number, the column number, and the word. The row +number is the same in every case." + (let ((full-line "") + (next-section)) + (insert "\n") + (dolist (one-item widths-1row-columns-words) + (setq next-section (pad-for-left-align (nth 0 one-item) (nth 3 one-item))) + (setq full-line (concat full-line next-section))) + (insert full-line))) + +(defun pad-for-right-align (column-width text) + "Pad TEXT to right-align in space of COLUMN-WIDTH." + (let* ((text-width (length text)) + (pre-padding-length (- column-width text-width))) + (setq pre-padding (make-string pre-padding-length ? )) + (format "%s%s" pre-padding text))) + +(defun create-a-right-aligned-line (widths-1row-columns-words) + "Create a right-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS. +Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column +width, the row number, the column number, and the word. The row +number is the same in every case." + (let ((full-line "") + (next-section)) + (insert "\n") + (dolist (one-item widths-1row-columns-words) + (setq next-section (pad-for-right-align (nth 0 one-item) (nth 3 one-item))) + (setq full-line (concat full-line next-section))) + (insert full-line))) + +(defun left-align-lines (rows-columns-words) + "Write ROWS-COLUMNS-WORDS in left-aligned columns. +ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the +row number, the column number, and the word." + (let* ((row-number 1) + (column-widths (get-column-widths rows-columns-words)) + (last-row (get-last-row rows-columns-words)) + (one-row) + (width-place 0)) + (while (<= row-number last-row) + (setq one-row (get-one-row row-number rows-columns-words)) + (setq one-row (add-column-widths column-widths one-row)) + (create-a-left-aligned-line one-row) + (setq row-number (1+ row-number)) + (setq width-place (1+ width-place))))) + +(defun right-align-lines (rows-columns-words) + "Write ROWS-COLUMNS-WORDS in right-aligned columns. +ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the +row number, the column number, and the word." + (let* ((row-number 1) + (column-widths (get-column-widths rows-columns-words)) + (last-row (get-last-row rows-columns-words)) + (one-row) + (width-place 0)) + (while (<= row-number last-row) + (setq one-row (get-one-row row-number rows-columns-words)) + (setq one-row (add-column-widths column-widths one-row)) + (create-a-right-aligned-line one-row) + (setq row-number (1+ row-number)) + (setq width-place (1+ width-place))))) + +(defun center-align-lines (rows-columns-words) + "Write ROWS-COLUMNS-WORDS in center-aligned columns. +ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the +row number, the column number, and the word." + (let* ((row-number 1) + (column-widths (get-column-widths rows-columns-words)) + (last-row (get-last-row rows-columns-words)) + (one-row) + (width-place 0)) + (while (<= row-number last-row) + (setq one-row (get-one-row row-number rows-columns-words)) + (setq one-row (add-column-widths column-widths one-row)) + (create-a-center-aligned-line one-row) + (setq row-number (1+ row-number)) + (setq width-place (1+ width-place))))) + +(defun align-lines (alignment rows-columns-words) + "Write ROWS-COLUMNS-WIDTHS with given ALIGNMENT. +ROWS-COLUMNS-WIDTHS consists of a list of lists. Each internal list contains width of column, row number, column number, and a word." + (let ((align-function (pcase alignment + ('left 'left-align-lines) + ("left" 'left-align-lines) + ('center 'center-align-lines) + ("center" 'center-align-lines) + ('right 'right-align-lines) + ("right" 'right-align-lines)))) + (funcall align-function rows-columns-words))) diff --git a/Task/Align-columns/Miranda/align-columns.miranda b/Task/Align-columns/Miranda/align-columns.miranda new file mode 100644 index 0000000000..f39cb05be0 --- /dev/null +++ b/Task/Align-columns/Miranda/align-columns.miranda @@ -0,0 +1,34 @@ +#! /usr/bin/mira -exec +main :: [sys_message] +main = [Stdout (align (alignment algm) '$' (read file))] + where [cmd, file, algm] = $* + +alignment :: [char]->num->[char]->[char] +alignment "left" = ljustify +alignment "center" = cjustify +alignment "right" = rjustify +alignment x = error "Alignment must be left, center, or right" + +align :: (num->[char]->[char])->char->[char]->[char] +align just sep text = (lay . map (alignline just sep cols) . lines) text + where cols = colwidths sep text + +split :: *->[*]->[[*]] +split sep = s [] + where s acc [] = [acc] + s acc (a:as) = acc:s [] as, if a==sep + = s (acc++[a]) as, otherwise + +colwidths :: char->[char]->[num] +colwidths sep text = (map max . transpose . map (extend maxwidth 0)) widths + where widths = map (map (#) . split sep) (lines text) + maxwidth = max (map (#) widths) + +alignline :: (num->[char]->[char])->char->[num]->[char]->[char] +alignline just sep cols = concat . map (++" ") . zipwith just cols . split sep + +zipwith :: (*->**->***)->[*]->[**]->[***] +zipwith f xs ys = map f' (zip2 xs ys) where f' (x,y) = f x y + +extend :: num->*->[*]->[*] +extend n k ls = ls ++ take (n-#ls) (repeat k) diff --git a/Task/Align-columns/Refal/align-columns.refal b/Task/Align-columns/Refal/align-columns.refal new file mode 100644 index 0000000000..19662f46b2 --- /dev/null +++ b/Task/Align-columns/Refal/align-columns.refal @@ -0,0 +1,71 @@ +$ENTRY Go { + , : e.File + , : e.Alignment + , : e.Lines + , : e.Parts + , >: e.Cols + = ; +}; + +ReadFile { + s.Chan e.File = + ; + (s.Chan), : { + 0 = ; + e.Line = (e.Line) ; + }; +}; + +Split { + (e.Sep) e.Part e.Sep e.Rest = (e.Part) ; + (e.Sep) e.Part = (e.Part); +}; + +Each { + (e.F) = ; + (e.F) (e.X) e.Xs = () ; +}; + +MaxWidth { + (Acc s.W) = s.W; + (Acc s.W) (e.P) e.X, : s.L, : { + '+' = ; + s.C = ; + }; + e.X = ; +}; + +Transpose { + e.X, : e.L, : { + True = ; + False = (e.L) >; + }; +}; + +ZipWith { + (e.F) () e.Ys = ; + (e.F) e.Xs () = ; + (e.F) (t.X e.Xs) (t.Y e.Ys) = ; +}; + +AlignCell { + ('left') (e.Cell) (s.Width), + : s.L = e.Cell ' '> ' '; + ('right') (e.Cell) (s.Width), + : s.L = ' '> e.Cell ' '; + ('center') (e.Cell) (s.Width), + > 2>: (s.P) s.V, + : e.LP, + ' '>: e.RP = e.LP e.Cell e.RP ' '; +}; + +AlignLine { + (e.Alignment) (e.Cols) e.Line = + >; +}; + +Rep { 0 s.C = ; s.N s.C = s.C s.C>; }; +Empty { = True; () e.X = ; e.X = False; }; +Len { e.X, : s.L e.X = s.L; }; +Head { = ; (e.X) e.Xs = e.X; }; +Tail { = ; (e.X) e.Xs = e.Xs; }; diff --git a/Task/Aliquot-sequence-classifications/FutureBasic/aliquot-sequence-classifications.basic b/Task/Aliquot-sequence-classifications/FutureBasic/aliquot-sequence-classifications.basic new file mode 100644 index 0000000000..663c14ccfa --- /dev/null +++ b/Task/Aliquot-sequence-classifications/FutureBasic/aliquot-sequence-classifications.basic @@ -0,0 +1,95 @@ +begin globals + short n + long arr(17) + bool gStop = _False +end globals + +local fn sumFactors(nx as long) as long + long i, sumFactor + sumFactor = 0 + for i = 1 to fix(nx / 2) + if (nx) mod i = 0 then sumFactor = sumFactor + i + next +end fn = sumFactor + +void local fn printSeries(arrx as short, size as short, type as str255) + short i = 0 + print + print "Integer" + str$(arrx) + ", Type: " + type + ", Series: "; + for i=0 to size - 2 + print str$(arr(i)) + " "; + next i +end fn + +local fn Aliquot(nx as long) + + short i, j + str255 type + + type = "Sociable" + arr(0) = nx + + for i = 1 to 15 + + arr(i) = fn sumFactors(arr(i-1)) + if (arr(i)=0 || arr(i)=nx || (arr(i) = arr(i-1)) && arr(i)<>nx) + if arr(i) = 0 + type = "Terminating" + else + if arr(i) = nx && i = 1 + type = "Perfect" + else + if arr(i) = nx && i = 2 + type = "Amicable" + else + if arr(i) = arr(i-1) && arr(i)<>nx + type = "Aspiring" + end if + end if + end if + end if + + fn printSeries(arr(0),i+1,type) + if type = "Terminating" + print " 0" + else + print + end if + + exit fn + end if + + + for j = 1 to i-1 + if arr(j) = arr(i) + fn printSeries(arr(0),i+1,"Cyclic") + print + exit fn + end if + next j + next i + fn printSeries(arr(i),i+1,"Non-Terminating") + print + +end fn + + +local fn DoAliquot + // declare and assign c-type array + long dataArray(30) = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 28, 496, 220, 1184,¬ + 12496, 1264460, 790, 909, 562, 1064, 1488, 0} + + short i + for i = 0 to 24 + if dataArray(i) = 0 then gStop = _True:exit fn + fn Aliquot(dataArray(i)) + next i + +end fn = gStop + +window 1,@"Aliquot sequence classifications",fn CGRectMake(0, 0, 1150, 700) +windowcenter(1) + +fn AppSetTimer( .000001, @Fn DoAliquot, _true ) + +handleevents diff --git a/Task/Almkvist-Giullera-formula-for-pi/PARI-GP/almkvist-giullera-formula-for-pi.parigp b/Task/Almkvist-Giullera-formula-for-pi/PARI-GP/almkvist-giullera-formula-for-pi.parigp new file mode 100644 index 0000000000..9761b3ae9b --- /dev/null +++ b/Task/Almkvist-Giullera-formula-for-pi/PARI-GP/almkvist-giullera-formula-for-pi.parigp @@ -0,0 +1,2 @@ +\p77 +sqrt(375/4/suminf(n=0,(6*n)!*(532*n^2+126*n+9.)/(n!*10^n)^6)) diff --git a/Task/Amb/Langur/amb.langur b/Task/Amb/Langur/amb.langur index 3adeaad38f..7f047193bb 100644 --- a/Task/Amb/Langur/amb.langur +++ b/Task/Amb/Langur/amb.langur @@ -10,6 +10,6 @@ val alljoin = fn words: for[=true] i of len(words)-1 { } # amb expects 2 or more arguments -val amb = fn ...[2..] words: if alljoin(words) { join " ", words } +val amb = fn ...[2..] words: if alljoin(words) { join words, by=" " } -writeln join("\n", filter(mapX(amb, wordsets...))) +writeln join(mapX(wordsets..., by=amb) -> filter, by="\n") diff --git a/Task/Amb/Scheme/amb-1.scm b/Task/Amb/Scheme/amb-1.scm index 951db6f220..825f13342c 100644 --- a/Task/Amb/Scheme/amb-1.scm +++ b/Task/Amb/Scheme/amb-1.scm @@ -13,7 +13,7 @@ (LAMBDA (K-SUCCESS) ; which we return possibles. (CALL-WITH-CURRENT-CONTINUATION (LAMBDA (K-FAILURE) ; K-FAILURE will try the next - (SET! FAIL K-FAILURE) ; possible expression. + (SET! FAIL (LAMBDA () (K-FAILURE 'anything-is-fine-here))) ; possible expression. (K-SUCCESS ; Note that the expression is (LAMBDA () ; evaluated in tail position expression)))) ; with respect to AMB. diff --git a/Task/Angle-difference-between-two-bearings/ANSI-BASIC/angle-difference-between-two-bearings.basic b/Task/Angle-difference-between-two-bearings/ANSI-BASIC/angle-difference-between-two-bearings.basic new file mode 100644 index 0000000000..9a7c6b0d99 --- /dev/null +++ b/Task/Angle-difference-between-two-bearings/ANSI-BASIC/angle-difference-between-two-bearings.basic @@ -0,0 +1,33 @@ +100 REM Angle difference between two bearings +110 DECLARE EXTERNAL FUNCTION GetDiff +120 REM +130 SUB PrintRow(B1, B2) +140 PRINT USING "#######.###### #######.###### #######.######": B1, B2, GetDiff(B1, B2) +150 END SUB +160 REM +170 print "Input in -180 to +180 range" +180 PRINT " Bearing 1 Bearing 2 Difference" +190 CALL PrintRow(20.0, 45.0) +200 CALL PrintRow(-45.0, 45.0) +210 CALL PrintRow(-85.0, 90.0) +220 CALL PrintRow(-95.0, 90.0) +230 CALL PrintRow(-45.0, 125.0) +240 CALL PrintRow(-45.0, 145.0) +250 CALL PrintRow(-45.0, 125.0) +260 CALL PrintRow(-45.0, 145.0) +270 CALL PrintRow(29.4803, -88.6381) +280 CALL PrintRow(-78.3251, -159.036) +290 PRINT +300 PRINT "Input in wider range" +310 PRINT " Bearing 1 Bearing 2 Difference" +320 CALL PrintRow(-70099.74233810938, 29840.67437876723) +330 CALL PrintRow(-165313.6666297357, 33693.9894517456) +340 CALL PrintRow(1174.8380510598456, -154146.66490124757) +350 CALL PrintRow(60175.77306795546, 42213.07192354373) +360 END +370 REM +380 EXTERNAL FUNCTION GetDiff (B1, B2) +390 LET R = MOD(B2 - B1, 360.0) +400 IF R >= 180.0 THEN LET R = R - 360.0 +410 LET GetDiff = R +420 END FUNCTION diff --git a/Task/Angle-difference-between-two-bearings/C++/angle-difference-between-two-bearings.cpp b/Task/Angle-difference-between-two-bearings/C++/angle-difference-between-two-bearings.cpp index af35a7815c..92cb3f68b7 100644 --- a/Task/Angle-difference-between-two-bearings/C++/angle-difference-between-two-bearings.cpp +++ b/Task/Angle-difference-between-two-bearings/C++/angle-difference-between-two-bearings.cpp @@ -2,34 +2,40 @@ #include using namespace std; -double getDifference(double b1, double b2) { - double r = fmod(b2 - b1, 360.0); - if (r < -180.0) - r += 360.0; - if (r >= 180.0) - r -= 360.0; - return r; +double getDifference(double b1, double b2) +{ + double r = fmod(b2 - b1, 360.0); + if (r < -180.0) + r += 360.0; + if (r >= 180.0) + r -= 360.0; + return r; +} + +inline void printRow(double b1, double b2) +{ + cout << getDifference(b1, b2) << endl; } int main() { - cout << "Input in -180 to +180 range" << endl; - cout << getDifference(20.0, 45.0) << endl; - cout << getDifference(-45.0, 45.0) << endl; - cout << getDifference(-85.0, 90.0) << endl; - cout << getDifference(-95.0, 90.0) << endl; - cout << getDifference(-45.0, 125.0) << endl; - cout << getDifference(-45.0, 145.0) << endl; - cout << getDifference(-45.0, 125.0) << endl; - cout << getDifference(-45.0, 145.0) << endl; - cout << getDifference(29.4803, -88.6381) << endl; - cout << getDifference(-78.3251, -159.036) << endl; - - cout << "Input in wider range" << endl; - cout << getDifference(-70099.74233810938, 29840.67437876723) << endl; - cout << getDifference(-165313.6666297357, 33693.9894517456) << endl; - cout << getDifference(1174.8380510598456, -154146.66490124757) << endl; - cout << getDifference(60175.77306795546, 42213.07192354373) << endl; + cout << "Input in -180 to +180 range" << endl; + printRow(20.0, 45.0); + printRow(-45.0, 45.0); + printRow(-85.0, 90.0); + printRow(-95.0, 90.0); + printRow(-45.0, 125.0); + printRow(-45.0, 145.0); + printRow(-45.0, 125.0); + printRow(-45.0, 145.0); + printRow(29.4803, -88.6381); + printRow(-78.3251, -159.036); - return 0; + cout << endl << "Input in wider range" << endl; + printRow(-70099.74233810938, 29840.67437876723); + printRow(-165313.6666297357, 33693.9894517456); + printRow(1174.8380510598456, -154146.66490124757); + printRow(60175.77306795546, 42213.07192354373); + + return 0; } diff --git a/Task/Angle-difference-between-two-bearings/PHP/angle-difference-between-two-bearings.php b/Task/Angle-difference-between-two-bearings/PHP/angle-difference-between-two-bearings.php new file mode 100644 index 0000000000..0cec699805 --- /dev/null +++ b/Task/Angle-difference-between-two-bearings/PHP/angle-difference-between-two-bearings.php @@ -0,0 +1,38 @@ + 180.0) + $r -= 360.0; + if ($r < -180.0) + $r += 360.0; + return $r; + } + + function echo_row($b1, $b2) { + echo str_pad(number_format($b1, 6, ".", ""), 14, " ", STR_PAD_LEFT).' '; + echo str_pad(number_format($b2, 6, ".", ""), 14, " ", STR_PAD_LEFT).' '; + echo str_pad(number_format(get_diff($b1, $b2), 6), 14, " ", STR_PAD_LEFT); + echo "\n"; + } + + echo "Input in -180 to +180 range\n"; + echo " Bearing 1 Bearing 2 Difference\n"; + echo_row(20.0, 45.0); + echo_row(-45.0, 45.0); + echo_row(-85.0, 90.0); + echo_row(-95.0, 90.0); + echo_row(-45.0, 125.0); + echo_row(-45.0, 145.0); + echo_row(-45.0, 125.0); + echo_row(-45.0, 145.0); + echo_row(29.4803, -88.6381); + echo_row(-78.3251, -159.036); + echo "\nInput in wider range\n"; + echo " Bearing 1 Bearing 2 Difference\n"; + echo_row(-70099.74233810938, 29840.67437876723); + echo_row(-165313.6666297357, 33693.9894517456); + echo_row(1174.8380510598456, -154146.66490124757); + echo_row(60175.77306795546, 42213.07192354373); +?> diff --git a/Task/Angles-geometric-normalization-and-conversion/FutureBasic/angles-geometric-normalization-and-conversion.basic b/Task/Angles-geometric-normalization-and-conversion/FutureBasic/angles-geometric-normalization-and-conversion.basic new file mode 100644 index 0000000000..df05b07e41 --- /dev/null +++ b/Task/Angles-geometric-normalization-and-conversion/FutureBasic/angles-geometric-normalization-and-conversion.basic @@ -0,0 +1,100 @@ +include "NSLog.incl" + +double local fn Normalize( f as double, n as double ) + double a = f + while ( a < -n ) : a += n : wend + while ( a >= n ) : a -= n : wend +end fn = a + +double local fn NormalizeToDegrees( f as double ) return fn Normalize( f, 360 ) end fn = 0.0 +double local fn NormalizeToGradians( f as double ) return fn Normalize( f, 400 ) end fn = 0.0 +double local fn NormalizeToMils( f as double ) return fn Normalize( f, 6400 ) end fn = 0.0 +double local fn NormalizeToRadians( f as double ) return fn Normalize( f, 2 * M_PI ) end fn = 0.0 + +double local fn d2g( f as double ) return f * 10 / 9 end fn = 0.0 +double local fn d2m( f as double ) return f * 160 / 9 end fn = 0.0 +double local fn d2r( f as double ) return f * M_PI / 180 end fn = 0.0 + +double local fn g2d( f as double ) return f * 9 / 10 end fn = 0.0 +double local fn g2m( f as double ) return f * 16 end fn = 0.0 +double local fn g2r( f as double ) return f * M_PI / 200 end fn = 0.0 + +double local fn m2d( f as double ) return f * 9 / 160 end fn = 0.0 +double local fn m2g( f as double ) return f / 16 end fn = 0.0 +double local fn m2r( f as double ) return f * M_PI / 3200 end fn = 0.0 + +double local fn r2d( f as double ) return f * 180 / M_PI end fn = 0.0 +double local fn r2g( f as double ) return f * 200 / M_PI end fn = 0.0 +double local fn r2m( f as double ) return f * 3200 / M_PI end fn = 0.0 + +local fn CalculateDegrees + CFArrayRef angles = @[@-2, @-1, @0, @1, @2, @6.2831853, @16, @57.2957795, @359, @6399, @1000000] + double angle, degrees, gradians, mils, radians + NSUInteger i + CFStringRef unit + CFStringRef dashpad = fn StringByPaddingToLength( @"", 73, @"-", 0 ) + + ptr anglePtr = fn StringUTF8String( @"Angle" ) + ptr unitPtr = fn StringUTF8String( @"Unit" ) + ptr normalPtr = fn StringUTF8String( @"Normalized" ) + ptr gradiansPtr = fn StringUTF8String( @"Gradians" ) + ptr milsPtr = fn StringUTF8String( @"Mils" ) + ptr radiansPtr = fn StringUTF8String( @"Radians" ) + + // Header + NSLog( @"\n%@", dashpad ) + NSLog( @"%13s %5s %15s %10s %7s %15s", anglePtr, unitPtr, normalPtr, gradiansPtr, milsPtr, radiansPtr ) + NSLog( @"%@", dashpad ) + + // Degrees + for i = 0 to fn ArrayCount( angles ) - 1 + angle = dblval( angles[i] ) + unit = @"Degrees" + degrees = fn NormalizeToDegrees( angle ) + gradians = fn NormalizeToGradians( fn d2g( degrees ) ) + mils = fn NormalizeToMils( fn d2m( degrees ) ) + radians = fn NormalizeToRadians( fn d2r( degrees ) ) + NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians ) + next + NSLog( @"" ) + + // Gradians + for i = 0 to fn ArrayCount( angles ) - 1 + angle = dblval( angles[i] ) + unit = @"Gradians" + gradians = fn NormalizeToGradians( angle ) + degrees = fn NormalizeToDegrees( fn g2d( gradians ) ) + mils = fn NormalizeToMils( fn g2m( gradians ) ) + radians = fn NormalizeToRadians( fn g2r( gradians ) ) + NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians ) + next + NSLog( @"" ) + + // Mils + for i = 0 to fn ArrayCount( angles ) - 1 + angle = dblval( angles[i] ) + unit = @"Mils" + mils = fn NormalizeToMils( angle ) + degrees = fn NormalizeToDegrees( fn m2d( mils ) ) + gradians = fn NormalizeToGradians( fn m2g( mils ) ) + radians = fn NormalizeToRadians( fn m2r( mils ) ) + NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians ) + next + NSLog( @"" ) + + // Radians + for i = 0 to fn ArrayCount( angles ) - 1 + angle = dblval( angles[i] ) + unit = @"Radians" + radians = fn NormalizeToRadians( angle ) + degrees = fn NormalizeToDegrees( fn r2d( radians ) ) + gradians = fn NormalizeToGradians( fn r2g( radians ) ) + mils = fn NormalizeToMils( fn r2m( radians ) ) + NSLog( @"%13.4f %-10s % -12.4f % -11.4f % -12.4f % -13.4f", angle, fn StringUTF8String( unit ), degrees, gradians, mils, radians ) + next + NSLog( @"%@", dashpad ) +end fn + +fn CalculateDegrees + +HandleEvents diff --git a/Task/Animate-a-pendulum/Locomotive-Basic/animate-a-pendulum.basic b/Task/Animate-a-pendulum/Locomotive-Basic/animate-a-pendulum.basic new file mode 100644 index 0000000000..151efccb41 --- /dev/null +++ b/Task/Animate-a-pendulum/Locomotive-Basic/animate-a-pendulum.basic @@ -0,0 +1,16 @@ +10 mode 1 +20 theta=pi/2 +30 g=9.81 +40 l=1 +50 sp=0 : px=320 : py=300 : bx=px : by=py +100 move bx-4,by+4:graphics pen 0:tag:print chr$(231);:tagoff +110 move px,py:draw bx,by +120 bx=px+l*250*sin(theta) +130 by=py+l*250*cos(theta) +140 move bx-4,by+4:graphics pen 1:tag:print chr$(231);:tagoff +150 move px,py:draw bx,by +160 accel=g*sin(theta)/l/100 +170 sp=sp+accel/100 +180 theta=theta+sp +190 frame +200 goto 100 diff --git a/Task/Animate-a-pendulum/Nim/animate-a-pendulum-2.nim b/Task/Animate-a-pendulum/Nim/animate-a-pendulum-2.nim index 106527b8c9..d21ca79c40 100644 --- a/Task/Animate-a-pendulum/Nim/animate-a-pendulum-2.nim +++ b/Task/Animate-a-pendulum/Nim/animate-a-pendulum-2.nim @@ -3,82 +3,74 @@ import math import times -import gintro/[gobject, gdk, gtk, gio, cairo] -import gintro/glib except Pi +import gtk2 except update +import gdk2, glib2, cairo type # Description of the simulation. - Simulation = ref object - area: DrawingArea # Drawing area. + Simulation = object + area: PDrawingArea # Drawing area. length: float # Pendulum length. g: float # Gravity (should be positive). time: Time # Current time. theta0: float # initial angle. - theta: float # Current angle. + theta: float # Current drawangle. omega: float # Angular velocity = derivative of theta. accel: float # Angular acceleration = derivative of omega. e: float # Total energy. -#--------------------------------------------------------------------------------------------------- -proc newSimulation(area: DrawingArea; length, g, theta0: float): Simulation {.noInit.} = - ## Allocate and initialize the simulation object. +proc initSimulation(area: PDrawingArea; length, g, theta0: float): Simulation {.noInit.} = + ## Initialize a simulation object. - new(result) - result.area = area - result.length = length - result.g = g - result.time = getTime() - result.theta0 = theta0 - result.theta = theta0 - result.omega = 0 - result.accel = -g / length * sin(theta0) - result.e = g * length * (1 - cos(theta0)) # Total energy = potential energy when starting. + result = Simulation( + area: area, length: length, g: g, time: getTime(), + theta0: theta0, theta: theta0, omega: 0, + accel: -g / length * sin(theta0), + e: g * length * (1 - cos(theta0))) # Total energy = potential energy when starting. -#--------------------------------------------------------------------------------------------------- template toFloat(dt: Duration): float = dt.inNanoseconds.float / 1e9 -#--------------------------------------------------------------------------------------------------- const Origin = (x: 320.0, y: 100.0) # Pivot coordinates. const Scale = 300 # Coordinates scaling constant. -proc draw(sim: Simulation; context: cairo.Context) = + +proc draw(sim: var Simulation; context: ptr Context) = ## Draw the pendulum. - # Compute coordinates in drawing area. + # Compute coordinates in drawing draw. let x = Origin.x + sin(sim.theta) * Scale let y = Origin.y + cos(sim.theta) * Scale - # Clear the region. + # Clear the region.draw context.moveTo(0, 0) - context.setSource(0.0, 0.0, 0.0) + context.setSourceRgb(0.0, 0.0, 0.0) context.paint() # Draw pendulum. context.moveTo(Origin.x, Origin.y) - context.setSource(0.3, 1.0, 0.3) + context.setSourceRgb(0.3, 1.0, 0.3) context.lineTo(x, y) context.stroke() # Draw pivot. - context.setSource(0.3, 0.3, 1.0) + context.setSourceRgb(0.3, 0.3, 1.0) context.arc(Origin.x, Origin.y, 8, 0, 2 * Pi) context.fill() # Draw mass. - context.setSource(1.0, 0.3, 0.3) + context.setSourceRgb(1.0, 0.3, 0.3) context.arc(x, y, 8, 0, 2 * Pi) context.fill() -#--------------------------------------------------------------------------------------------------- -proc update(sim: Simulation): gboolean = +proc update(sim: var Simulation): gboolean = ## Update the simulation state. - # compute time interval. + # Compute time interval. let nextTime = getTime() let dt = (nextTime - sim.time).toFloat sim.time = nextTime @@ -100,26 +92,25 @@ proc update(sim: Simulation): gboolean = sim.draw(sim.area.window.cairoCreate()) -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +proc onDestroyEvent(widget: PWidget; data: pointer): gboolean {.cdecl.} = + ## Quit the application. + mainQuit() - let window = app.newApplicationWindow() - window.setSizeRequest(640, 480) - window.setTitle("Pendulum simulation") - let area = newDrawingArea() - window.add(area) +nimInit() - let sim = newSimulation(area, length = 5, g = 9.81, theta0 = PI / 3) +let window = windowNew(WINDOW_TOPLEVEL) +window.setSizeRequest(640, 480) +window.setTitle("Pendulum simulation") - timeoutAdd(10, update, sim) +let area = drawingAreaNew() +window.add area +discard window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) - window.showAll() +var sim = initSimulation(area, length = 5, g = 9.81, theta0 = PI / 3) -#——————————————————————————————————————————————————————————————————————————————————————————————————— +discard timeoutAdd(10, cast[gtk2.TFunction](update), sim.addr) -let app = newApplication(Application, "Rosetta.pendulum") -discard app.connect("activate", activate) -discard app.run() +window.showAll() +main() diff --git a/Task/Animation/EasyLang/animation.easy b/Task/Animation/EasyLang/animation.easy index 93d6d938cc..82c5470808 100644 --- a/Task/Animation/EasyLang/animation.easy +++ b/Task/Animation/EasyLang/animation.easy @@ -1,5 +1,5 @@ s$ = "Hello world! " -textsize 16 +textsize 14 lg = len s$ on timer color 333 @@ -7,13 +7,13 @@ on timer rect 80 20 color 999 move 12 24 - text s$ - if forw = 0 + text substr s$ 1 9 + if forw = 1 s$ = substr s$ lg 1 & substr s$ 1 (lg - 1) else s$ = substr s$ 2 (lg - 1) & substr s$ 1 1 . - timer 0.2 + timer 0.4 . on mouse_down if mouse_x > 10 and mouse_x < 90 diff --git a/Task/Animation/Nim/animation.nim b/Task/Animation/Nim/animation.nim index bb2821a478..bbb4e4ecce 100644 --- a/Task/Animation/Nim/animation.nim +++ b/Task/Animation/Nim/animation.nim @@ -1,4 +1,4 @@ -import gintro/[glib, gobject, gdk, gtk, gio] +import gtk2, gdk2, glib2 type @@ -6,56 +6,56 @@ type ScrollDirection = enum toLeft, toRight # Data transmitted to update callback. - UpdateData = ref object - label: Label + UpdateData = object + label: PLabel scrollDir: ScrollDirection -#--------------------------------------------------------------------------------------------------- -proc update(data: UpdateData): gboolean = +proc update(data: var UpdateData): gboolean {.cdecl.} = ## Update the text, scrolling to the right or to the left according to "data.scrollDir". - - data.label.setText(if data.scrollDir == toRight: data.label.text[^1] & data.label.text[0..^2] - else: data.label.text[1..^1] & data.label.text[0]) + let text = $data.label.text # Get text as a Nim string. + let newText = if data.scrollDir == toRight: text[^1] & text[0..^2] + else: text[1..^1] & text[0] + data.label.setText(newText.cstring) result = gboolean(1) -#--------------------------------------------------------------------------------------------------- -proc changeScrollingDir(evtBox: EventBox; event: EventButton; data: UpdateData): bool = +proc changeScrollingDir(evtBox: PEventBox; event: PEventButton; data: ptr UpdateData): bool = ## Change scrolling direction. - data.scrollDir = ScrollDirection(1 - ord(data.scrollDir)) -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +proc onDestroyEvent(widget: PWidget; data: Pgpointer): gboolean {.cdecl.} = + ## Process the "destroy" event. + main_quit() - let window = app.newApplicationWindow() - window.setSizeRequest(150, 50) - window.setTitle("Animation") - # Create an event box to catch the button press event. - let evtBox = newEventBox() - window.add(evtBox) - # Create the label and add it to the event box. - let label = newLabel("Hello World! ") - evtBox.add(label) +nim_init() - # Create the update data. - let data = UpdateData(label: label, scrollDir: toRight) +let window = window_new(WINDOW_TOPLEVEL) +window.set_size_request(150, 50) +window.set_title("Animation") - # Connect the "button-press-event" to the callback to change scrolling direction. - discard evtBox.connect("button-press-event", changeScrollingDir, data) +# Create an event box to catch the button press event. +let evtBox = event_box_new() +window.add evtBox - # Create a timer to update the label and simulate scrolling. - timeoutAdd(200, update, data) +# Create the label and add it to the event box. +let label = label_new("Hello World! ") +evtBox.add label - window.showAll() +# Create the update data. +var data = UpdateData(label: label, scrollDir: toRight) -#——————————————————————————————————————————————————————————————————————————————————————————————————— +# Connect the "button-press-event" to the callback to change the scrolling direction. +discard evtBox.signal_connect("button-press-event", SIGNAL_FUNC(changeScrollingDir), data.addr) -let app = newApplication(Application, "Rosetta.animation") -discard app.connect("activate", activate) -discard app.run() +# Quit the application if the window is closed. +discard window.signal_connect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) + +# Create a timer to update the label and simulate scrolling. +discard timeout_add(200, cast[gtk2.TFunction](animation.update), data.addr) + +window.showAll() +main() diff --git a/Task/Apply-a-callback-to-an-array/Langur/apply-a-callback-to-an-array.langur b/Task/Apply-a-callback-to-an-array/Langur/apply-a-callback-to-an-array.langur index 67108b6065..61d90f3fb8 100644 --- a/Task/Apply-a-callback-to-an-array/Langur/apply-a-callback-to-an-array.langur +++ b/Task/Apply-a-callback-to-an-array/Langur/apply-a-callback-to-an-array.langur @@ -1 +1 @@ -writeln map(fn{^2}, 1..10) +writeln map(1..10, by=fn{^2}) diff --git a/Task/Arbitrary-precision-integers-included-/Langur/arbitrary-precision-integers-included-.langur b/Task/Arbitrary-precision-integers-included-/Langur/arbitrary-precision-integers-included-.langur index ac88ad929c..b7a153403f 100644 --- a/Task/Arbitrary-precision-integers-included-/Langur/arbitrary-precision-integers-included-.langur +++ b/Task/Arbitrary-precision-integers-included-/Langur/arbitrary-precision-integers-included-.langur @@ -2,8 +2,8 @@ val xs = string(5 ^ 4 ^ 3 ^ 2) writeln len(xs), " digits" -if len(xs) > 39 and s2s(xs, 1..20) == "62060698786608744707" and - s2s(xs, -20 .. -1) == "92256259918212890625" { +if len(xs) > 39 and s2s(xs, of=1..20) == "62060698786608744707" and + s2s(xs, of=-20 .. -1) == "92256259918212890625" { writeln "SUCCESS" } diff --git a/Task/Arbitrary-precision-integers-included-/M2000-Interpreter/arbitrary-precision-integers-included-.m2000 b/Task/Arbitrary-precision-integers-included-/M2000-Interpreter/arbitrary-precision-integers-included-.m2000 new file mode 100644 index 0000000000..5869a47e0f --- /dev/null +++ b/Task/Arbitrary-precision-integers-included-/M2000-Interpreter/arbitrary-precision-integers-included-.m2000 @@ -0,0 +1,17 @@ +module checkit { + z=4^(3^2) + z1=z/1024-1 + m=Biginteger("5") + with m, "ToString" as m.ToString + p=Biginteger("1024") + method m, "intpower", p as m1 + m=m1 + for i=1 to z1 + method m1, "multiply", m as m + ? len(m.tostring), i + refresh + next + a=m.tostring + Print left$(a, 20)+"..."+Right$(a,20) +} +checkit diff --git a/Task/Archimedean-spiral/Ada/archimedean-spiral.ada b/Task/Archimedean-spiral/Ada/archimedean-spiral.ada index 0cdfaae32f..e949fa2f1f 100644 --- a/Task/Archimedean-spiral/Ada/archimedean-spiral.ada +++ b/Task/Archimedean-spiral/Ada/archimedean-spiral.ada @@ -1,17 +1,18 @@ with Ada.Numerics.Elementary_Functions; with SDL.Video.Windows.Makers; +with SDL.Video.Rectangles; with SDL.Video.Renderers.Makers; with SDL.Events.Events; procedure Archimedean_Spiral is - Width : constant := 800; - Height : constant := 800; - A : constant := 4.2; - B : constant := 3.2; - T_First : constant := 4.0; - T_Last : constant := 100.0; + Width : constant := 800; + Height : constant := 800; + A : constant := 4.2; + B : constant := 3.2; + T_First : constant := 4.0; + T_Last : constant := 100.0; Window : SDL.Video.Windows.Window; Renderer : SDL.Video.Renderers.Renderer; @@ -29,8 +30,10 @@ procedure Archimedean_Spiral is loop R := A + B * T; Renderer.Draw - (Point => (X => Width / 2 + SDL.C.int (R * Cos (T, 2.0 * Pi)), - Y => Height / 2 - SDL.C.int (R * Sin (T, 2.0 * Pi)))); + (Point => + SDL.Video.Rectangles.Point' + (X => Width / 2 + SDL.C.int (R * Cos (T, 2.0 * Pi)), + Y => Height / 2 - SDL.C.int (R * Sin (T, 2.0 * Pi)))); exit when T >= T_Last; T := T + Step; end loop; @@ -53,14 +56,16 @@ begin return; end if; - SDL.Video.Windows.Makers.Create (Win => Window, - Title => "Archimedean spiral", - Position => SDL.Natural_Coordinates'(X => 10, Y => 10), - Size => SDL.Positive_Sizes'(Width, Height), - Flags => 0); + SDL.Video.Windows.Makers.Create + (Win => Window, + Title => "Archimedean spiral", + Position => SDL.Natural_Coordinates'(X => 10, Y => 10), + Size => SDL.Positive_Sizes'(Width, Height), + Flags => 0); SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface); Renderer.Set_Draw_Colour ((0, 0, 0, 255)); - Renderer.Fill (Rectangle => (0, 0, Width, Height)); + Renderer.Fill + (Rectangle => SDL.Video.Rectangles.Rectangle'(0, 0, Width, Height)); Renderer.Set_Draw_Colour ((0, 220, 0, 255)); Draw_Archimedean_Spiral; diff --git a/Task/Archimedean-spiral/Aquarius-BASIC/archimedean-spiral.basic b/Task/Archimedean-spiral/Aquarius-BASIC/archimedean-spiral.basic new file mode 100644 index 0000000000..fc325caa2a --- /dev/null +++ b/Task/Archimedean-spiral/Aquarius-BASIC/archimedean-spiral.basic @@ -0,0 +1,8 @@ +10 PRINT CHR$(11); +20 PI=3.141593 +30 FOR I=0 TO 1080 +40 R=I/42+2 +50 X=R*SIN(I*PI/180) +60 Y=R*COS(I*PI/180)*1.4 +70 PSET(39+X,33+Y) +80 NEXT diff --git a/Task/Archimedean-spiral/Atari-BASIC/archimedean-spiral.basic b/Task/Archimedean-spiral/Atari-BASIC/archimedean-spiral.basic new file mode 100644 index 0000000000..ff20bc9dcf --- /dev/null +++ b/Task/Archimedean-spiral/Atari-BASIC/archimedean-spiral.basic @@ -0,0 +1,9 @@ +10 GRAPHICS 8:COLOR 0:DEG +20 N=5.4 +30 FOR I=0 TO N*360 STEP 10 +40 R=I/24+4 +50 X=R*SIN(I) +60 Y=R*COS(I) +70 DRAWTO 160+X,80+Y +80 COLOR 1 +90 NEXT I diff --git a/Task/Archimedean-spiral/Crystal/archimedean-spiral.cr b/Task/Archimedean-spiral/Crystal/archimedean-spiral.cr new file mode 100644 index 0000000000..8644de1114 --- /dev/null +++ b/Task/Archimedean-spiral/Crystal/archimedean-spiral.cr @@ -0,0 +1,42 @@ +# output utilities -- solution starts after them +def print_line (line) + (0..line[0].size-1).step(2) do |i| + char = ((line[0][i] | line[1][i] << 1 | line[2][i] << 2 | + line[0][i+1] << 3 | line[1][i+1] << 4 | line[2][i+1] << 5 | + line[3][i] << 6 | line[3][i+1] << 7) + 0x2800).chr + print char + end + puts +end + +def print_dots (coords, screen_width) + coords = coords.sort_by {|x, y| y} + left, right = coords.map(&.first).minmax + if screen_width.odd? + screen_width -= 1 + end + factor = screen_width / (right - left + 1) + line = (0..3).map { Array(UInt32).new(screen_width, 0) } + row = (coords[0].last * factor).to_i + coords.map {|x, y| {((x - left) * factor).to_i, (y * factor).to_i} }.each do |x, y| + while y > row+3 + print_line line + line.each do |stripe| stripe.fill(0) end + row += 4 + end + line[y - row][x] = 1 + end + print_line line +end + +# actual solution starts here: + +def spiral (a, b, step_resolution, step_count) + start, stop = 0.0, step_count * step_resolution + (start..stop).step(step_resolution).map { |theta| + r = a + b * theta + { r * Math.cos(theta), r * Math.sin(theta) } + }.to_a +end + +print_dots(spiral(10, 10, 0.01, 4000), 60) diff --git a/Task/Archimedean-spiral/M2000-Interpreter/archimedean-spiral.m2000 b/Task/Archimedean-spiral/M2000-Interpreter/archimedean-spiral.m2000 index 5f9e9e7555..49b7017044 100644 --- a/Task/Archimedean-spiral/M2000-Interpreter/archimedean-spiral.m2000 +++ b/Task/Archimedean-spiral/M2000-Interpreter/archimedean-spiral.m2000 @@ -5,7 +5,7 @@ module Archimedean_spiral { pen #FFFF00 refresh 5000 every 1000 { - \\ redifine window (console width and height) and place it to center (symbol ;) + \\ redefine window (console width and height) and place it to center (symbol ;) Window 12, random(10, 18)*1000, random(8, 12)*1000; move scale.x/2, scale.y/2 let N=2, k1=pi/120, k=k1, op=5, op1=1 diff --git a/Task/Archimedean-spiral/Nim/archimedean-spiral.nim b/Task/Archimedean-spiral/Nim/archimedean-spiral.nim index 004dbe69f8..fec5dd2a2b 100644 --- a/Task/Archimedean-spiral/Nim/archimedean-spiral.nim +++ b/Task/Archimedean-spiral/Nim/archimedean-spiral.nim @@ -1,38 +1,38 @@ -import math - -import gintro/[glib, gobject, gtk, gio, cairo] +import std/math +import cairo const - Width = 601 - Height = 601 + Width = 400 + Height = 400 Limit = 12 * math.PI Origin = (x: float(Width div 2), y: float(Height div 2)) B = floor((Width div 2) / Limit) -#--------------------------------------------------------------------------------------------------- -proc draw(area: DrawingArea; context: Context) = +proc drawSpiral(surface: ptr Surface) = ## Draw the spiral. + let context = create(surface) + var theta = 0.0 var delta = 0.01 var (prevx, prevy) = Origin # Clear the region. context.moveTo(0, 0) - context.setSource(0.0, 0.0, 0.0) + context.setSourceRgb(0.0, 0.0, 0.0) context.paint() # Draw the spiral. - context.setSource(1.0, 1.0, 0.0) + context.setSourceRgb(1.0, 1.0, 0.0) context.moveTo(Origin.x, Origin.y) while theta < Limit: let r = B * theta - let x = Origin.x + r * cos(theta) # X-coordinate on drawing area. - let y = Origin.y + r * sin(theta) # Y-coordinate on drawing area. + let x = Origin.x + r * cos(theta) + let y = Origin.y + r * sin(theta) context.lineTo(x, y) context.stroke() # Set data for next round. @@ -41,34 +41,11 @@ proc draw(area: DrawingArea; context: Context) = prevy = y theta += delta -#--------------------------------------------------------------------------------------------------- + context.destroy() -proc onDraw(area: DrawingArea; context: Context; data: pointer): bool = - ## Callback to draw/redraw the drawing area contents. - area.draw(context) - result = true - -#--------------------------------------------------------------------------------------------------- - -proc activate(app: Application) = - ## Activate the application. - - let window = app.newApplicationWindow() - window.setSizeRequest(Width, Height) - window.setTitle("Archimedean spiral") - - # Create the drawing area. - let area = newDrawingArea() - window.add(area) - - # Connect the "draw" event to the callback to draw the spiral. - discard area.connect("draw", ondraw, pointer(nil)) - - window.showAll() - -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.spiral") -discard app.connect("activate", activate) -discard app.run() +let surface = imageSurfaceCreate(FormatRgb24, Width, Height) +surface.drawSpiral() +if surface.writeToPng("archimedean_spiral.png") != StatusSuccess: + quit "Error while saving file.", QuitFailure +surface.destroy() diff --git a/Task/Arithmetic-Complex/Langur/arithmetic-complex.langur b/Task/Arithmetic-Complex/Langur/arithmetic-complex.langur new file mode 100644 index 0000000000..07c6898485 --- /dev/null +++ b/Task/Arithmetic-Complex/Langur/arithmetic-complex.langur @@ -0,0 +1,22 @@ +val conjugate = fn(c) { + if c is not complex: throw "expected complex number" + return complex(c[1], -c[2]) +} + +val examples = { + "-(1+1i)": -(1+1i), + "abs(1+1i)": abs(1+1i), + "(2+2i) + (5+13.2i)": (2+2i) + (5+13.2i), + "5 + (2+2i)": 5 + (2+2i), + "5i + (2+2i)": 5i + (2+2i), + "5i - (2+2i)": 5i - (2+2i), + "(1+1i) * (3.141592653589793+1.2i)": (1+1i) * (3.141592653589793+1.2i), + "(5+3i) / (4-3i)": (5+3i) / (4-3i), + "1 / (4-3i)": 1 / (4-3i), + "(4-3i) ^ 3": (4-3i) ^ 3, + "conjugate(7+21.0i)": conjugate(7+21.0i), +} + +for e of examples { + writeln "{{e : 20}}: ", examples[e] +} diff --git a/Task/Arithmetic-Complex/M2000-Interpreter/arithmetic-complex.m2000 b/Task/Arithmetic-Complex/M2000-Interpreter/arithmetic-complex.m2000 new file mode 100644 index 0000000000..4d894f3c26 --- /dev/null +++ b/Task/Arithmetic-Complex/M2000-Interpreter/arithmetic-complex.m2000 @@ -0,0 +1,152 @@ +Class Complex { +private: + double vr, vi +public: + property real { + value {link parent vr to vr : value=vr} + } + property imaginary { + value {link parent vi to vi : value=vi} + } + property toString { + value { + clear + ' so default variable VALUE deleted and again defined it as string + link parent vr, vi to vr, vi + if vi then + if vr then + if vi>0 then + if vi==1 then + value="("+vr+"+i)" + else + value="("+vr+"+"+vi+"i)" + end if + else + if vi==-1 then + value="("+vr+"-i)" + else + value="("+vr+""+vi+"i)" + end if + end if + else + if vi=1 then + value="(i)" + else.if vi=-1 then + value="(-i)" + else + value="("+vi+"i)" + end if + end if + else + value="("+vr+")" + end if + } + } + function final Arg { + declare m math + Method m, "Atan2", .vi, .vr as ret + =ret + } + function final exp(rr=10) { + double exp = 2.71828182845905^.vr + c=this + th=.vi/1.74532925199433E-02 + c.vr<=round(exp * cos(th), rr) + c.vi<=round(exp * sin(th),rr) + =c + } + function final cabs { + if abs(.vr)=infinity or abs(.vi)=infinity then + =1.7976931348623157E+308 : break + end if + double c=abs(.vr), d=abs(.vi) + if c>d then + r=d/c : =c*sqrt(1+r*r) + else.if d==0 then + =c + else + r=c/d : =d*sqrt(1+r*r) + end if + } + function final clog { + c=this + c.vr<=ln(.cabs()) + c.vi<=.Arg() + =c + } + function final pow { + if match("G") then + read p as Complex + else + read p1 as double + p=this:p.vr=p1:p.vi=0 + end if + Read ? rr=10 + exp=.clog()*p + c=exp.exp(rr) + c.vr=round(c.vr, rr) + c.vi=round(c.vi, rr) + =c + } + function final inv { + if .vr==0 and .vi==0 then error "zero complex num" + acb=this.conj() + c=this*acb + c.vi <= acb.vi/c.vr + c.vr <= acb.vr/c.vr + =c + } + function final conj { + c=this : c.vi-! : =c + } + function final absc { + c=this*.conj() : =sqrt(c.vr) + } + operator final "+" { + read k as Complex : .vr+= k.vr : .vi+= k.vi + } + operator final "-" { + read k as Complex : .vr-= k.vr : .vi-= k.vi + } + operator final high "*" { + read k as Complex + double ivr = .vr*k.vr-.vi*k.vi + .vi <= .vi*k.vr+.vr*k.vi + .vr <= ivr + } + operator final high "/" { + read k as Complex + k1=k*k.conj() + acb = this*k.conj() + .vr <= acb.vr/k1.vr + .vi <= acb.vi/k1.vr + } + operator final unary { + .vr-! + .vi-! + } + +class: + module Complex (.vr, .vi) {} +} +Module Check (filename as string="") { + def f(x)=x.toString + a=Complex(8,-3) + b=a.inv() + open filename for wide output as #f + Print #f, "A="+a.toString + Print #f, " r=";a.cabs();" θ=";a.Arg();" rad" + Print #f, "B="+b.toString+" as 1/A" + Print #f, " r=";b.cabs();" θ=";b.Arg();" rad" + Print #f, a.toString+"*"+b.toString+"="+f(a*b) + Print #f, Complex(1).toString+"/"+b.toString+"="+f(Complex(1)/b) + Print #f, a.toString+"/"+a.toString+"="+f(a/a) + Print #f, a.toString+"+"+a.toString+"="+f(a+a) + Print #f, a.toString+"-"+a.toString+"="+f(a-a) + Print #f, "-"+a.toString+"="+f(-a) + Print #f, "e^(πi)+1="+f(Complex(2.71828182845905).pow(Complex(0,pi))+Complex(1)) + close #f + if filename<>"" then if exist(filename) then win "notepad", dir$+filename +} +Check "out.txt" +Check ' just show here diff --git a/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx b/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx index e58b2f326c..fd21689cfc 100644 --- a/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx +++ b/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx @@ -1,23 +1,38 @@ -/*REXX program demonstrates how to support some math functions for complex numbers. */ -x = '(5,3i)' /*define X ─── can use I i J or j */ -y = "( .5, 6j)" /*define Y " " " " " " " */ +include Settings -say ' addition: ' x " + " y ' = ' Cadd(x, y) -say ' subtraction: ' x " - " y ' = ' Csub(x, y) -say 'multiplication: ' x " * " y ' = ' Cmul(x, y) -say ' division: ' x " ÷ " y ' = ' Cdiv(x, y) -say ' inverse: ' x " = " Cinv(x, y) -say ' conjugate of: ' x " = " Conj(x, y) -say ' negation of: ' x " = " Cneg(x, y) -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -Conj: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a , -b ) -Cadd: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a+c , b+d ) -Csub: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a-c , b-d ) -Cmul: procedure; parse arg a ',' b,c ',' d; call C#; return C$( ac-bd , bc+ad) -Cdiv: procedure; parse arg a ',' b,c ',' d; call C#; return C$((ac+bd)/s, (bc-ad)/s) -Cinv: return Cdiv(1, arg(1)) -Cneg: return Cmul(arg(1), -1) -C_: return word(translate(arg(1), , '{[(JjIi)]}') 0, 1) /*get # or 0*/ -C#: a=C_(a); b=C_(b); c=C_(c); d=C_(d); ac=a*c; ad=a*d; bc=b*c; bd=b*d;s=c*c+d*d; return -C$: parse arg r,c; _='['r; if c\=0 then _=_","c'j'; return _"]" /*uses j */ +say version; say 'Arithmetic numbers'; say +numeric digits 9 +divi. = 0; a = 0; c = 0 +do i = 1 +/* Is the number arithmetic? */ + if Arithmetic(i) then do + a = a+1 +/* Is the number composite? */ + if divi.0 > 2 then + c = c+1 +/* Output control */ + if a <= 100 then do + if a = 1 then + say 'First 100 arithmetic numbers are' + call Charout ,Right(i,4) + if a//10 = 0 then + say + if a = 100 then + say + end + if a = 100 | a = 1000 | a = 10000 | a = 100000 | a = 1000000 then do + say 'The' a'th arithmetic number is' i + say 'Of the first' a 'numbers' c 'are composite' + say + end +/* Max 1m, higher takes too long */ + if a = 1000000 then + leave + end +end +say Format(Time('e'),,3) 'seconds' +exit + +include Numbers +include Functions +include Abend diff --git a/Task/Arithmetic-Complex/Uiua/arithmetic-complex.uiua b/Task/Arithmetic-Complex/Uiua/arithmetic-complex.uiua new file mode 100644 index 0000000000..411190a2d5 --- /dev/null +++ b/Task/Arithmetic-Complex/Uiua/arithmetic-complex.uiua @@ -0,0 +1,11 @@ +Za ← ℂ 3 1.5 # 1.5+3i +Zb ← ℂ 1.5 1.5 # 1.5+1.5i ++ Zb Za +- Zb Za +× Zb Za +÷ Zb Za +¯Za +ℂ¯ °ℂ Za +⌵ Za +ⁿ Zb Za +°ℂZa diff --git a/Task/Arithmetic-Integer/Zig/arithmetic-integer.zig b/Task/Arithmetic-Integer/Zig/arithmetic-integer.zig new file mode 100644 index 0000000000..564d8cc2b4 --- /dev/null +++ b/Task/Arithmetic-Integer/Zig/arithmetic-integer.zig @@ -0,0 +1,23 @@ +const std = @import("std"); + +pub fn main() !void { + var buf: [1024]u8 = undefined; + const reader = std.io.getStdIn().reader(); + const stdout = std.io.getStdOut().writer(); + try stdout.writeAll("Enter two integers separated by a space: "); + const input = try reader.readUntilDelimiter(&buf, '\n'); + const text = std.mem.trimRight(u8, input, "\r\n"); + + var it = std.mem.tokenizeScalar(u8, text, ' '); + + const a = try std.fmt.parseInt(i64, it.next().?, 10); + const b = try std.fmt.parseInt(i64, it.next().?, 10); + + try stdout.print("Values: a {d} b {d}\n", .{a, b}); + try stdout.print("Sum: a + b = {d}\n", .{a + b}); + try stdout.print("Difference: a - b = {d}\n", .{a - b}); + try stdout.print("Product: a * b = {d}\n", .{a * b}); + try stdout.print("Integer quotient: a / b = {d}\n", .{@divTrunc(a, b)}); //truncates towards 0 + try stdout.print("Remainder: a % b = {d}\n", .{@rem(a, b)}); // same sign as first operand + try stdout.print("Exponentiation: math.pow = {d}\n", .{std.math.pow(i64, a, b)}); //no exponentiation operator +} diff --git a/Task/Arithmetic-Rational/REXX/arithmetic-rational.rexx b/Task/Arithmetic-Rational/REXX/arithmetic-rational.rexx index 4d17ceb166..16e57b5dcc 100644 --- a/Task/Arithmetic-Rational/REXX/arithmetic-rational.rexx +++ b/Task/Arithmetic-Rational/REXX/arithmetic-rational.rexx @@ -1,87 +1,62 @@ -/*REXX program implements a reasonably complete rational arithmetic (using fractions).*/ -L=length(2**19 - 1) /*saves time by checking even numbers. */ - do j=2 by 2 to 2**19 - 1; s=0 /*ignore unity (which can't be perfect)*/ - mostDivs=eDivs(j); @= /*obtain divisors>1; zero sum; null @. */ - do k=1 for words(mostDivs) /*unity isn't return from eDivs here.*/ - r='1/'word(mostDivs, k); @=@ r; s=$fun(r, , s) - end /*k*/ - if s\==1 then iterate /*Is sum not equal to unity? Skip it.*/ - say 'perfect number:' right(j, L) " fractions:" @ - end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -$div: procedure; parse arg x; x=space(x,0); f= 'fractional division' - parse var x n '/' d; d=p(d 1) - if d=0 then call err 'division by zero:' x - if \datatype(n,'N') then call err 'a non─numeric numerator:' x - if \datatype(d,'N') then call err 'a non─numeric denominator:' x - return n/d -/*──────────────────────────────────────────────────────────────────────────────────────*/ -$fun: procedure; parse arg z.1,,z.2 1 zz.2; arg ,op; op=p(op '+') -F= 'fractionalFunction'; do j=1 for 2; z.j=translate(z.j, '/', "_"); end /*j*/ -if abbrev('ADD' , op) then op= "+" -if abbrev('DIVIDE' , op) then op= "/" -if abbrev('INTDIVIDE', op, 4) then op= "÷" -if abbrev('MODULUS' , op, 3) | abbrev('MODULO', op, 3) then op= "//" -if abbrev('MULTIPLY' , op) then op= "*" -if abbrev('POWER' , op) then op= "^" -if abbrev('SUBTRACT' , op) then op= "-" -if z.1=='' then z.1= (op\=="+" & op\=='-') -if z.2=='' then z.2= (op\=="+" & op\=='-') -z_=z.2 - /* [↑] verification of both fractions.*/ - do j=1 for 2 - if pos('/', z.j)==0 then z.j=z.j"/1"; parse var z.j n.j '/' d.j - if \datatype(n.j,'N') then call err 'a non─numeric numerator:' n.j - if \datatype(d.j,'N') then call err 'a non─numeric denominator:' d.j - if d.j=0 then call err 'a denominator of zero:' d.j - n.j=n.j/1; d.j=d.j/1 - do while \datatype(n.j,'W'); n.j=(n.j*10)/1; d.j=(d.j*10)/1 - end /*while*/ /* [↑] {xxx/1} normalizes a number. */ - g=gcd(n.j, d.j); if g=0 then iterate; n.j=n.j/g; d.j=d.j/g - end /*j*/ +include Settings - select - when op=='+' | op=='-' then do; l=lcm(d.1,d.2); do j=1 for 2; n.j=l*n.j/d.j; d.j=l - end /*j*/ - if op=='-' then n.2= -n.2; t=n.1 + n.2; u=l - end - when op=='**' | op=='↑' |, - op=='^' then do; if \datatype(z_,'W') then call err 'a non─integer power:' z_ - t=1; u=1; do j=1 for abs(z_); t=t*n.1; u=u*d.1 - end /*j*/ - if z_<0 then parse value t u with u t /*swap U and T */ - end - when op=='/' then do; if n.2=0 then call err 'a zero divisor:' zz.2 - t=n.1*d.2; u=n.2*d.1 - end - when op=='÷' then do; if n.2=0 then call err 'a zero divisor:' zz.2 - t=trunc($div(n.1 '/' d.1)); u=1 - end /* [↑] this is integer division. */ - when op=='//' then do; if n.2=0 then call err 'a zero divisor:' zz.2 - _=trunc($div(n.1 '/' d.1)); t=_ - trunc(_) * d.1; u=1 - end /* [↑] modulus division. */ - when op=='ABS' then do; t=abs(n.1); u=abs(d.1); end - when op=='*' then do; t=n.1 * n.2; u=d.1 * d.2; end - when op=='EQ' | op=='=' then return $div(n.1 '/' d.1) = fDiv(n.2 '/' d.2) - when op=='NE' | op=='\=' | op=='╪' | , - op=='¬=' then return $div(n.1 '/' d.1) \= fDiv(n.2 '/' d.2) - when op=='GT' | op=='>' then return $div(n.1 '/' d.1) > fDiv(n.2 '/' d.2) - when op=='LT' | op=='<' then return $div(n.1 '/' d.1) < fDiv(n.2 '/' d.2) - when op=='GE' | op=='≥' | op=='>=' then return $div(n.1 '/' d.1) >= fDiv(n.2 '/' d.2) - when op=='LE' | op=='≤' | op=='<=' then return $div(n.1 '/' d.1) <= fDiv(n.2 '/' d.2) - otherwise call err 'an illegal function:' op - end /*select*/ +say version; say 'Rational arithmetic'; say +a = '1 2'; b = '-3 4'; c = '5 -6'; d = '-7 -8'; e = 3; f = 1.666666666 +say 'VALUES' +say 'a =' Rlst2form(a) +say 'b =' Rlst2form(b) +say 'c =' Rlst2form(c) +say 'd =' Rlst2form(d) +say 'e =' e +say 'f =' f +say +say 'BASICS' +say 'a+b =' Rlst2form(Radd(a,b)) +say 'a+b+c+d =' Rlst2form(Radd(a,b,c,d)) +say 'a-b =' Rlst2form(Rsub(a,b)) +say 'a-b-c-d =' Rlst2form(Rsub(a,b,c,d)) +say 'a*b =' Rlst2form(Rmul(a,b)) +say 'a*b*c*d =' Rlst2form(Rmul(a,b,c,d)) +say 'a/b =' Rlst2form(Rdiv(a,b)) +say 'a/b/c/d =' Rlst2form(Rdiv(a,b,c,d)) +say '-a =' Rlst2form(Rneg(a)) +say '1/a =' Rlst2form(Rinv(a)) +say +say 'COMPARE' +say 'a=b =' Rge(a,b) +say 'a>b =' Rgt(a,b) +say 'a<>b =' Rne(a,b) +say +say 'BONUS' +say 'Abs(c) =' Rlst2form(Rabs(c)) +say 'Float(b) =' Rfloat(b) +say 'Neg(d) =' Rlst2form(Rneg(d)) +say 'Power(a,e) =' Rlst2form(Rpow(a,e)) +say 'Rational(f) =' Rlst2form(Rrat(f)) +say +say 'FORMULA' +say 'a^2-2ab+3c-4ad^4+5 = ', +Rlst2form(Radd(Rpow(a,2),Rmul(-2,a,b),Rmul(3,c),Rmul(-4,a,Rpow(d,4)),5)) +say +say 'PERFECT NUMBERS' +call time('r') +numeric digits 20 +do c = 6 to 2**19 + s = 1 c; m = Isqrt(c) + do f = 2 to m + if c//f = 0 then do + s = Radd(s,1 f,1 c/f) + end + end + if Req(s,1) then + say c 'is a perfect number' +end +say time('e')/1's' +exit -if t==0 then return 0; g=gcd(t, u); t=t/g; u=u/g -if u==1 then return t - return t'/'u -/*──────────────────────────────────────────────────────────────────────────────────────*/ -eDivs: procedure; parse arg x 1 b,a - do j=2 while j*j>6 + PUT col+1 IN col + IF col mod 10 = 0: WRITE/ + +FOR m IN {1..20}: + WRITE "D(10^`m>>2`) = `(lagarias (10**m))/7`"/ diff --git a/Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative.alg b/Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative-1.alg similarity index 100% rename from Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative.alg rename to Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative-1.alg diff --git a/Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative-2.alg b/Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative-2.alg new file mode 100644 index 0000000000..777a307ffd --- /dev/null +++ b/Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative-2.alg @@ -0,0 +1,12 @@ +FOR n FROM -99 TO 100 DO + INT l := 0, f := 3, z := ABS n; + WHILE z >= 2 DO + WHILE z MOD 2 = 0 DO l +:= n OVER 2; z OVERAB 2 OD; + IF f <= z THEN + WHILE z MOD f = 0 DO l +:= n OVER f; z OVERAB f OD; + f +:= 2 + FI + OD; + print( ( whole( l, -8 ) ) ); + IF ( n + 100 ) MOD 10 = 0 THEN print( ( newline ) ) FI +OD diff --git a/Task/Arithmetic-derivative/APL/arithmetic-derivative.apl b/Task/Arithmetic-derivative/APL/arithmetic-derivative.apl new file mode 100644 index 0000000000..1c399278d7 --- /dev/null +++ b/Task/Arithmetic-derivative/APL/arithmetic-derivative.apl @@ -0,0 +1,7 @@ +lagarias←{ + ⍵<0:-∇-⍵ + ⍵∊0 1:0 + 0=d←⊃1+⍸0=(1↓⍳⌊⍵*÷2)|⍵:1 + (n×∇d)+d×∇n←⍵÷d +} +lagarias¨ 20 10⍴¯100+⍳200 diff --git a/Task/Arithmetic-derivative/Action-/arithmetic-derivative.action b/Task/Arithmetic-derivative/Action-/arithmetic-derivative.action new file mode 100644 index 0000000000..11a719733d --- /dev/null +++ b/Task/Arithmetic-derivative/Action-/arithmetic-derivative.action @@ -0,0 +1,15 @@ +PROC Main() + INT n, f, l, z + FOR n = -99 TO 100 DO + l = 0 f = 3 IF n < 0 THEN z = - n ELSE z = n FI + WHILE z >= 2 DO + WHILE z MOD 2 = 0 DO l ==+ n / 2 z ==/ 2 OD + IF f <= z THEN + WHILE z MOD f = 0 DO l ==+ n / f z ==/ f OD + f ==+ 2 + FI + OD + PrintF( "%8I", l ) + IF ( n + 100 ) MOD 10 = 0 THEN PutE() FI + OD +RETURN diff --git a/Task/Arithmetic-derivative/Ada/arithmetic-derivative.ada b/Task/Arithmetic-derivative/Ada/arithmetic-derivative.ada new file mode 100644 index 0000000000..9e3a37edda --- /dev/null +++ b/Task/Arithmetic-derivative/Ada/arithmetic-derivative.ada @@ -0,0 +1,55 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Ada.Numerics.Big_Numbers.Big_Integers; use Ada.Numerics.Big_Numbers.Big_Integers; + +procedure Arithmetic_Derivative is + + function D (N : Big_Integer) return Big_Integer is + Inc : Constant array (1 .. 8) of Big_Integer := (4, 2, 4, 2, 4, 6, 2, 6); + I : Integer := 1; + Num : Big_Integer := N; + P : Big_Integer := 2; + PCount : Big_Integer; + Result : Big_Integer := 0; + begin + if N < 0 then return -D(-N); end if; + if N = 0 or N = 1 then return 0; end if; + + while P <= N / 2 loop + if Num mod P = 0 then + PCount := 0; + while Num mod P = 0 loop + Num := Num / P; + PCount := PCount + 1; + end loop; + Result := Result + (PCount * N) / P; + end if; + if Num = 1 then exit; end if; + if P >= 7 then + P := P + Inc(I); + I := (I mod 8) + 1; + end if; + if P = 3 or P = 5 then P := P + 2; end if; + if P = 2 then P := P + 1; end if; + end loop; + + if Num > 1 then return 1; end if; + + return result; + end D; + + P : Big_Integer; + +begin + for I in Integer range -99 .. 100 loop + P := To_Big_Integer(I); + Put(To_String(Arg => D(P), Width => 5)); + if I mod 10 = 0 then New_Line; end if; + end loop; + + for I in Integer range 1 .. 20 loop + P := 10 ** I; + Put("D(10^"); Put(Item => I, Width => 2); Put(") / 7 = "); + Put(Big_Integer'Image(D(P) / 7)); New_Line; + end loop; +end Arithmetic_Derivative; diff --git a/Task/Arithmetic-derivative/BASIC/arithmetic-derivative.basic b/Task/Arithmetic-derivative/BASIC/arithmetic-derivative.basic new file mode 100644 index 0000000000..1c7a401d8e --- /dev/null +++ b/Task/Arithmetic-derivative/BASIC/arithmetic-derivative.basic @@ -0,0 +1,12 @@ +10 DEFINT A-Z +20 FOR N=-99 TO 100 +30 GOSUB 100: PRINT USING "########";L; +40 NEXT +50 END +100 L=0: F=3: Z=ABS(N) +110 IF Z<2 THEN RETURN +120 IF Z MOD 2=0 THEN L=L+N\2: Z=Z\2: GOTO 120 +130 IF F>Z THEN RETURN +140 IF Z MOD F=0 THEN L=L+N\F: Z=Z\F: GOTO 140 +150 F=F+2 +160 GOTO 130 diff --git a/Task/Arithmetic-derivative/CLU/arithmetic-derivative.clu b/Task/Arithmetic-derivative/CLU/arithmetic-derivative.clu new file mode 100644 index 0000000000..15fbee5766 --- /dev/null +++ b/Task/Arithmetic-derivative/CLU/arithmetic-derivative.clu @@ -0,0 +1,44 @@ +factors = iter (n: bigint) yields (bigint) + own zero: bigint := bigint$i2bi(0) + own two: bigint := bigint$i2bi(2) + own three: bigint := bigint$i2bi(3) + + while n>zero cand n//two = zero do yield(two) n := n/two end + + fac: bigint := three + while fac<=n do + while n//fac = zero do yield(fac) n := n/fac end + fac := fac + two + end +end factors + +lagarias = proc (n: bigint) returns (bigint) + own zero: bigint := bigint$i2bi(0) + if n < zero then return(-lagarias(-n)) end + + sum: bigint := zero + for fac: bigint in factors(n) do + sum := sum + n / fac + end + return(sum) +end lagarias + +start_up = proc () + own po: stream := stream$primary_output() + own seven: bigint := bigint$i2bi(7) + own ten: bigint := bigint$i2bi(10) + + for n: int in int$from_to(-99, 100) do + stream$putright(po, bigint$unparse(lagarias(bigint$i2bi(n))), 7) + if (n + 100)//10 = 0 then stream$putl(po, "") end + end + + for m: int in int$from_to(1, 20) do + d: bigint := lagarias(ten ** bigint$i2bi(m)) / seven + stream$puts(po, "D(10^") + stream$putright(po, int$unparse(m), 2) + stream$puts(po, ") / 7 = ") + stream$putright(po, bigint$unparse(d), 25) + stream$putl(po, "") + end +end start_up diff --git a/Task/Arithmetic-derivative/Cowgol/arithmetic-derivative.cowgol b/Task/Arithmetic-derivative/Cowgol/arithmetic-derivative.cowgol new file mode 100644 index 0000000000..5a640ee1c3 --- /dev/null +++ b/Task/Arithmetic-derivative/Cowgol/arithmetic-derivative.cowgol @@ -0,0 +1,43 @@ +include "cowgol.coh"; + +sub abs(n: int32): (r: uint32) is + if n<0 then + r := (-n) as uint32; + else + r := n as uint32; + end if; +end sub; + +sub printcol(n: int32, s: uint8) is + var buf: uint8[12]; + var ptr := IToA(n, 10, &buf[0]); + s := s - (ptr - &buf[0]) as uint8; + while s>0 loop + print_char(' '); + s := s-1; + end loop; + print(&buf[0]); +end sub; + +sub lagarias(n: int32): (r: int32) is + var nn := abs(n); + r := 0; + if nn<2 then return; end if; + var f: uint32 := 2; + while f<=nn loop + while nn%f == 0 loop + r := r + n/f as int32; + nn := nn/f; + end loop; + f := f+1; + end loop; +end sub; + +var i: int32 := -99; +var c: uint8 := 0; +while i <= 100 loop + printcol(lagarias(i), 7); + i := i+1; + c := c+1; + if c%10 == 0 then print_nl(); end if; +end loop; diff --git a/Task/Arithmetic-derivative/Draco/arithmetic-derivative.draco b/Task/Arithmetic-derivative/Draco/arithmetic-derivative.draco new file mode 100644 index 0000000000..ae8d034c8c --- /dev/null +++ b/Task/Arithmetic-derivative/Draco/arithmetic-derivative.draco @@ -0,0 +1,32 @@ +proc lagarias(int n) int: + int f, r, s; + if n<0 then + -lagarias(-n) + elif n<2 then + 0 + else + s := 0; + r := n; + while r % 2 = 0 do + r := r / 2; + s := s + n / 2 + od; + f := 3; + while f <= r do + while r % f = 0 do + r := r / f; + s := s + n / f + od; + f := f + 2 + od; + s + fi +corp + +proc main() void: + int n; + for n from -99 upto 100 do + write(lagarias(n):7); + if (n+100) % 10=0 then writeln() fi + od +corp diff --git a/Task/Arithmetic-derivative/FreeBASIC/arithmetic-derivative.basic b/Task/Arithmetic-derivative/FreeBASIC/arithmetic-derivative.basic new file mode 100644 index 0000000000..5fa7e2e419 --- /dev/null +++ b/Task/Arithmetic-derivative/FreeBASIC/arithmetic-derivative.basic @@ -0,0 +1,46 @@ +Function aDerivative(Byval n As Longint) As Longint + If n < 0 Then Return -aDerivative(-n) + If n = 0 Or n = 1 Then Return 0 + If n = 2 Then Return 1 + + Dim As Longint q, d = 2 + Dim As Longint result = 1 + + While d * d <= n + If n Mod d = 0 Then + q = n \ d + result = q * aDerivative(d) + d * aDerivative(q) + Exit While + End If + d += 1 + Wend + + Return result +End Function + +'Main program +Print "Arithmetic derivatives for -99 through 100:" + +Dim As Integer col, n +col = 0 +For n = -99 To 100 + col += 1 + Print Using "####"; aDerivative(n); + If col = 10 Then + Print + col = 0 + Else + Print " "; + End If +Next + +'Stretch task +Print !"\n\nPowers of 10 derivatives divided by 7:" +Dim As Double m = 1 +For n = 1 To 18 ' LongInt limit in FreeBASIC + m *= 10 + Dim As Longint a = aDerivative(Clngint(m)) + Print Using "D(10^&) / 7 = &"; n; a \ 7 +Next + +Sleep diff --git a/Task/Arithmetic-derivative/FutureBasic/arithmetic-derivative.basic b/Task/Arithmetic-derivative/FutureBasic/arithmetic-derivative.basic new file mode 100644 index 0000000000..b54e9393bb --- /dev/null +++ b/Task/Arithmetic-derivative/FutureBasic/arithmetic-derivative.basic @@ -0,0 +1,30 @@ +// Arithmetic Derivative +// https://rosettacode.org/wiki/Arithmetic_derivative# + +local fn DoIt( N as short) as short + short L,F,Z + L = 0: F = 3: Z = ABS(N) + IF Z<2 THEN exit fn + + 1 IF Z MOD 2 = 0 THEN L=L+N\2: Z=Z\2: GOTO 1 + 2 IF F>Z THEN exit fn + 3 IF Z MOD F = 0 THEN L=L+N\F: Z=Z\F: GOTO 2 + + F=F+2 + goto 1 + +end fn = L + +_Window = 1 + +window _Window,@"Arithmetic Derivative",fn cgrectmake(0,0,640,400) +windowcenter(_Window) + +short N,L,LineCount +FOR N = -99 TO 100 +L = fn DoIt(N): PRINT USING "########";L; +LineCount ++ +if LineCount = 10 then print : LineCount = 0 +NEXT + +handleevents diff --git a/Task/Arithmetic-derivative/MAD/arithmetic-derivative.mad b/Task/Arithmetic-derivative/MAD/arithmetic-derivative.mad new file mode 100644 index 0000000000..dd608891dc --- /dev/null +++ b/Task/Arithmetic-derivative/MAD/arithmetic-derivative.mad @@ -0,0 +1,42 @@ + NORMAL MODE IS INTEGER + + INTERNAL FUNCTION(X,Y) + ENTRY TO REM. + FUNCTION RETURN X-(X/Y)*Y + END OF FUNCTION + + INTERNAL FUNCTION(N) + ENTRY TO DERIV. + R = N + WHENEVER R.L.0, R = -R + WHENEVER R.L.2, FUNCTION RETURN 0 + S = 0 +FAC2 WHENEVER REM.(R,2).E.0 + S = S + N/2 + R = R/2 + TRANSFER TO FAC2 + END OF CONDITIONAL + THROUGH FAC, FOR F=3, 2, F.G.R +FACF WHENEVER REM.(R,F).E.0 + S = S + N/F + R = R/F + TRANSFER TO FACF + END OF CONDITIONAL +FAC CONTINUE + FUNCTION RETURN S + END OF FUNCTION + + VECTOR VALUES LINEF = $10(I6)*$ + DIMENSION LINE(10) + C = 0 + THROUGH ITEM, FOR I=-99, 1, I.G.100 + LINE(C) = DERIV.(I) + C = C+1 + WHENEVER C.E.10 + PRINT FORMAT LINEF, + 0 LINE(0),LINE(1),LINE(2),LINE(3),LINE(4), + 1 LINE(5),LINE(6),LINE(7),LINE(8),LINE(9) + C = 0 + END OF CONDITIONAL +ITEM CONTINUE + END OF PROGRAM diff --git a/Task/Arithmetic-derivative/MiniScript/arithmetic-derivative.mini b/Task/Arithmetic-derivative/MiniScript/arithmetic-derivative.mini index 1c297bd18d..91af00f19b 100644 --- a/Task/Arithmetic-derivative/MiniScript/arithmetic-derivative.mini +++ b/Task/Arithmetic-derivative/MiniScript/arithmetic-derivative.mini @@ -37,7 +37,7 @@ for n in range( -99, 100 ) end if end for print() -for n in range( 1, 17 ) // 18, 19 and 20 would overflow ????? TODO: check +for n in range( 1, 17 ) m = 10 ^ n print( "D(" + str(m) + ") / 7 = " + str( floor (lagarias (m) / 7) ) ) end for diff --git a/Task/Arithmetic-derivative/Miranda/arithmetic-derivative.miranda b/Task/Arithmetic-derivative/Miranda/arithmetic-derivative.miranda new file mode 100644 index 0000000000..c4ecee4682 --- /dev/null +++ b/Task/Arithmetic-derivative/Miranda/arithmetic-derivative.miranda @@ -0,0 +1,24 @@ +main :: [sys_message] +main = [Stdout (table 10 7 (map (show . lagarias) [-99..100])), + Stdout (lay (map ten_pow_m_div_7 [1..20]))] + +ten_pow_m_div_7 :: num->[char] +ten_pow_m_div_7 m = "D(10^" ++ rjustify 2 (show m) ++ ") / 7 = " ++ + show (lagarias (10^m) div 7) + +table :: num->num->[[char]]->[char] +table w cw ls = lay [concat (map (rjustify cw) l) | l <- group w ls] + +group :: num->[*]->[[*]] +group n [] = [] +group n ls = take n ls : group n (drop n ls) + +lagarias :: num->num +lagarias n = -lagarias (-n), if n<0 + = sum [n div f | f <- factors n], otherwise + +factors :: num->[num] +factors n = f n 2 + where f n d = [], if d > n + = d : f (n div d) d, if n mod d = 0 + = f n (d+1), otherwise diff --git a/Task/Arithmetic-derivative/PL-I/arithmetic-derivative.pli b/Task/Arithmetic-derivative/PL-I/arithmetic-derivative.pli new file mode 100644 index 0000000000..179acc3c0a --- /dev/null +++ b/Task/Arithmetic-derivative/PL-I/arithmetic-derivative.pli @@ -0,0 +1,27 @@ +arithmeticDerivative: procedure options(main); + lagarias: procedure(n) returns(fixed); + declare (n, res, fac, rem) fixed; + rem = abs(n); + if rem<2 then return(0); + + res = 0; + do while(mod(rem,2) = 0); + res = res + n/2; + rem = rem/2; + end; + + do fac=3 repeat(fac+2) while(fac<=rem); + do while(mod(rem,fac) = 0); + res = res + n/fac; + rem = rem/fac; + end; + end; + return(res); + end lagarias; + + declare n fixed; + do n=-99 to 100; + put edit(lagarias(n)) (F(7)); + if mod(n+100, 10)=0 then put skip; + end; +end arithmeticDerivative; diff --git a/Task/Arithmetic-derivative/PL-M/arithmetic-derivative.plm b/Task/Arithmetic-derivative/PL-M/arithmetic-derivative.plm new file mode 100644 index 0000000000..d2e0a6eb98 --- /dev/null +++ b/Task/Arithmetic-derivative/PL-M/arithmetic-derivative.plm @@ -0,0 +1,66 @@ +100H: /* ARITHMETIC DERIVATIVE - BASED ON THE BASIC SAMPLE */ + + /* RETURNS TRUE IF A < B, FALSE OTHERWISE WITH A AND B TREATED AS SIGNED */ + SIGNED$LT: PROCEDURE( A, B )BYTE; + DECLARE ( A, B ) ADDRESS; + IF ( A + 32768 ) < ( B + 32768 ) THEN RETURN 0FFH; ELSE RETURN 0; + END SIGNED$LT ; + + /* RETURNS A / B WITH A AND B TREATED AS SIGNED */ + SIGNED$DIV: PROCEDURE( AIN, BIN )ADDRESS; + DECLARE ( AIN, BIN )ADDRESS; + DECLARE ( A, B, SIGN )ADDRESS; + SIGN = 1; + A = AIN; + B = BIN; + IF SIGNED$LT( A, 0 ) THEN DO; + SIGN = - SIGN; + A = - A; + END; + IF SIGNED$LT( B, 0 ) THEN DO; + SIGN = - SIGN; + B = - B; + END; + RETURN ( A / B ) * SIGN; + END SIGNED$DIV ; + + /* CP/M BDOS SYSTEM CALL AND I/O ROUTINES */ + BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END; + PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END; + PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END; + PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END; + + PR$SIGNED$NUMBER: PROCEDURE( N ); /* PRINTS A SIGNED NUMBER */ + DECLARE N ADDRESS; + DECLARE V ADDRESS, N$STR ( 9 )BYTE, W BYTE; + IF SIGNED$LT( N, 0 ) THEN V = - N; ELSE V = N; + DO W = 0 TO LAST( N$STR ); N$STR( W ) = ' '; END; + W = LAST( N$STR ); + N$STR( W ) = '$'; + N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); + DO WHILE( ( V := V / 10 ) > 0 ); + N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); + END; + IF SIGNED$LT( N, 0 ) THEN N$STR( W := W - 1 ) = '-'; + CALL PR$STRING( .N$STR ); + END PR$SIGNED$NUMBER; + + /* TASK */ + + DECLARE ( C, N, L, F, Z ) ADDRESS; + + DO C = 1 TO 200; + N = C - 100; + L = 0; F = 3; IF SIGNED$LT( N, 0 ) THEN Z = - N; ELSE Z = N; + DO WHILE Z >= 2; + DO WHILE Z MOD 2 = 0; L = L + SIGNED$DIV( N, 2 ); Z = Z / 2; END; + IF F <= Z THEN DO; + DO WHILE Z MOD F = 0; L = L + SIGNED$DIV( N, F ); Z = Z / F; END; + F = F + 2; + END; + END; + CALL PR$SIGNED$NUMBER( L ); + IF C MOD 10 = 0 THEN CALL PR$NL; + END; + +EOF diff --git a/Task/Arithmetic-derivative/Refal/arithmetic-derivative.refal b/Task/Arithmetic-derivative/Refal/arithmetic-derivative.refal new file mode 100644 index 0000000000..d124d001a8 --- /dev/null +++ b/Task/Arithmetic-derivative/Refal/arithmetic-derivative.refal @@ -0,0 +1,32 @@ +$ENTRY Go { + = >> +}; + +Lagarias { + '-' e.N = '-' ; + 0 = 0; + 1 = 0; + e.N, : { + e.N = 1; + e.F,
: e.R = + > + >>; + }; +}; + +Fac { + (e.F) e.N, : e.N2, + : '+' = e.N; + (e.F) e.N, : 0 = e.F; + (e.F) e.N = ) e.N>; + e.N = ; +}; + +Table { s.C s.W e.L = >>; }; +Line { s.W e.X = >; }; +Fmt { s.W e.X, >: (e.Z) e.C = e.C; }; +Rep { 0 s.C = ; s.N s.C = s.C s.C>; }; +Join { = ; (e.X) e.Y = e.X ; }; +Group { s.N = ; s.N e.X, : (e.G) e.R = (e.G) ; }; +Each { (e.F) = ; (e.F) (e.X) e.XS = () ; }; +Iota { (e.E) e.E = (e.E); (e.S) e.E = (e.S) ) e.E>; }; diff --git a/Task/Arithmetic-derivative/SETL/arithmetic-derivative.setl b/Task/Arithmetic-derivative/SETL/arithmetic-derivative.setl new file mode 100644 index 0000000000..e48e921bf7 --- /dev/null +++ b/Task/Arithmetic-derivative/SETL/arithmetic-derivative.setl @@ -0,0 +1,25 @@ +program arithmetic_derivative; + loop for n in [-99..100] do + nprint(lpad(str lagarias(n), 6)); + if (col +:= 1) mod 10 = 0 then + print; + end if; + end loop; + + loop for m in [1..20] do + nprint("D(10^" + lpad(str m, 2) + ") / 7 = "); + print(lagarias(10**m) div 7); + end loop; + + proc lagarias(n); + return if n<0 then + -lagarias(-n) + elseif n in {0,1} then + 0 + elseif forall d in {2..floor sqrt n} | n mod d /= 0 then + 1 + else + (n div d)*lagarias(d) + d*lagarias(n div d) + end; + end proc; +end program; diff --git a/Task/Arithmetic-derivative/Sidef/arithmetic-derivative-1.sidef b/Task/Arithmetic-derivative/Sidef/arithmetic-derivative-1.sidef new file mode 100644 index 0000000000..171928e84f --- /dev/null +++ b/Task/Arithmetic-derivative/Sidef/arithmetic-derivative-1.sidef @@ -0,0 +1,9 @@ +say "Arithmetic derivative for n in range [-99, 100]:" +-99 .. 100 -> map { .arithmetic_derivative }.each_slice(10, {|*a| + a.map { '%4s' % _ }.join(' ').say +}) + +say "\nArithmetic derivative D(10^n)/7 for n in range [1, 20]:" +for n in (1..20) { + say "D(10^#{n})/7 = #{arithmetic_derivative(10**n) / 7}" +} diff --git a/Task/Arithmetic-derivative/Sidef/arithmetic-derivative-2.sidef b/Task/Arithmetic-derivative/Sidef/arithmetic-derivative-2.sidef new file mode 100644 index 0000000000..d9d62d3285 --- /dev/null +++ b/Task/Arithmetic-derivative/Sidef/arithmetic-derivative-2.sidef @@ -0,0 +1,26 @@ +subset Integer < Number { .is_int } +subset Positive < Integer { .is_pos } +subset Negative < Integer { .is_neg } +subset Prime < Positive { .is_prime } + +func arithmetic_derivative((0)) { 0 } +func arithmetic_derivative((1)) { 0 } + +func arithmetic_derivative(Prime _) { 1 } + +func arithmetic_derivative(Negative n) { + -arithmetic_derivative(-n) +} + +func arithmetic_derivative(Positive n) is cached { + + var a = n.factor.rand + var b = n/a + + arithmetic_derivative(a)*b + a*arithmetic_derivative(b) +} + +func arithmetic_derivative(Number n) { + var (a, b) = n.nude + (arithmetic_derivative(a)*b - arithmetic_derivative(b)*a) / b**2 +} diff --git a/Task/Arithmetic-numbers/REXX/arithmetic-numbers-2.rexx b/Task/Arithmetic-numbers/REXX/arithmetic-numbers-2.rexx deleted file mode 100644 index cb506d1077..0000000000 --- a/Task/Arithmetic-numbers/REXX/arithmetic-numbers-2.rexx +++ /dev/null @@ -1,76 +0,0 @@ -parse Version version -say version; say 'Arithmetic numbers'; say -Call time 'R' -numeric digits 9 -a = 0; c = 0 -do i = 1 -/* Is the number arithmetic? */ - if Arithmetic(i) then do - a = a+1 -/* Is the number composite? */ - if divi.0 > 2 then - c = c+1 -/* Output control */ - if a <= 100 then do - if a = 1 then - say 'First 100 arithmetic numbers are' - call Charout ,Right(i,4) - if a//10 = 0 then - say - if a = 100 then - say - end - if a = 100 | a = 1000 | a = 10000 | a = 100000 | a = 1000000 then do - say 'The' a'th arithmetic number is' i - say 'Of the first' a 'numbers' c 'are composite' - say - end -/* Max 1m, higher takes too long */ - if a = 1000000 then - leave - end -end -say Format(Time('e'),,3) 'seconds' -exit - -Arithmetic: -/* Is a number arithmetic? function */ -procedure expose divi. -arg x -/* Cf definition */ -s = Sigma(x) -if Whole(s/divi.0) then - return 1 -else - return 0 - -Sigma: -/* Sigma = Sum of all divisors of x including 1 and x */ -procedure expose divi. -arg xx -/* Fast values */ -if xx = 1 then do - divi.0 = 1 - return 1 -end -/* Euclid's method */ -m = xx//2; yy = 1+xx; n = 2 -do j = 2+m by 1+m while j*j < xx - if xx//j = 0 then do - yy = yy+j+xx%j; n = n+2 - end -end -if j*j = xx then do - yy = yy+j; n = n+1 -end -/* Store number of divisors */ -divi.0 = n -/* Return sum */ -return yy - -Whole: -/* Is a number integer? */ -procedure -arg xx -/* Formula */ -return Datatype(xx,'w') diff --git a/Task/Arithmetic-numbers/REXX/arithmetic-numbers-1.rexx b/Task/Arithmetic-numbers/REXX/arithmetic-numbers.rexx similarity index 82% rename from Task/Arithmetic-numbers/REXX/arithmetic-numbers-1.rexx rename to Task/Arithmetic-numbers/REXX/arithmetic-numbers.rexx index 6094ba7514..fd21689cfc 100644 --- a/Task/Arithmetic-numbers/REXX/arithmetic-numbers-1.rexx +++ b/Task/Arithmetic-numbers/REXX/arithmetic-numbers.rexx @@ -2,7 +2,7 @@ include Settings say version; say 'Arithmetic numbers'; say numeric digits 9 -a = 0; c = 0 +divi. = 0; a = 0; c = 0 do i = 1 /* Is the number arithmetic? */ if Arithmetic(i) then do @@ -33,17 +33,6 @@ end say Format(Time('e'),,3) 'seconds' exit -Arithmetic: -/* Is a number arithmetic? function */ -procedure expose divi. -arg x -/* Cf definition */ -s = Sigma(x) -if Whole(s/divi.0) then - return 1 -else - return 0 - include Numbers include Functions include Abend diff --git a/Task/Arithmetic-numbers/Sidef/arithmetic-numbers.sidef b/Task/Arithmetic-numbers/Sidef/arithmetic-numbers.sidef new file mode 100644 index 0000000000..0530ed1c31 --- /dev/null +++ b/Task/Arithmetic-numbers/Sidef/arithmetic-numbers.sidef @@ -0,0 +1,14 @@ +func is_arithmetic(n) { + n.tau `divides` n.sigma +} + +say "The first one hundred arithmetic numbers:" +100.by(is_arithmetic).each_slice(10, {|*a| + a.map { '%3s' % _ }.join(' ').say +}) + +for x in (1e3, 1e4, 1e5, 1e6) { + var arr = x.by(is_arithmetic) + say "\n#{x}th arithmetic number is #{arr.last}." + say "There are #{arr.count{.is_composite}} composite arithmetic numbers <= #{arr.last}." +} diff --git a/Task/Assertions/FutureBasic/assertions.basic b/Task/Assertions/FutureBasic/assertions.basic new file mode 100644 index 0000000000..0572a113ad --- /dev/null +++ b/Task/Assertions/FutureBasic/assertions.basic @@ -0,0 +1 @@ +cln NSAssert(a == 42, @"Error message"); diff --git a/Task/Assertions/Uiua/assertions.uiua b/Task/Assertions/Uiua/assertions.uiua new file mode 100644 index 0000000000..582a84d525 --- /dev/null +++ b/Task/Assertions/Uiua/assertions.uiua @@ -0,0 +1,2 @@ +r ← 41 +⍤"r doesn't equal 42!" =42 r diff --git a/Task/Associative-array-Creation/Uiua/associative-array-creation.uiua b/Task/Associative-array-Creation/Uiua/associative-array-creation.uiua new file mode 100644 index 0000000000..eb353f2a2b --- /dev/null +++ b/Task/Associative-array-Creation/Uiua/associative-array-creation.uiua @@ -0,0 +1 @@ +map [1 2] {"foo" "bar"} diff --git a/Task/Associative-array-Iteration/Uiua/associative-array-iteration.uiua b/Task/Associative-array-Iteration/Uiua/associative-array-iteration.uiua new file mode 100644 index 0000000000..e93ccc48ba --- /dev/null +++ b/Task/Associative-array-Iteration/Uiua/associative-array-iteration.uiua @@ -0,0 +1,5 @@ +x ← .map [3 9 7] {"foo" "bar" "hey"} # Using the example from the 'Creation' page +.⊟°map x # Decouple the hashmap and put a copy of it on the stack +&p.⊢ # Get the keys as a new array and print them +&p⊣: # Get the values as a new array and print them +&p⧅◌ # Get keys mapped to values diff --git a/Task/Associative-array-Merging/Uiua/associative-array-merging.uiua b/Task/Associative-array-Merging/Uiua/associative-array-merging.uiua new file mode 100644 index 0000000000..a9f9bb2ba1 --- /dev/null +++ b/Task/Associative-array-Merging/Uiua/associative-array-merging.uiua @@ -0,0 +1,19 @@ +Base ← map {"name" "price" "color"} {"Rocket Skates" 12.75 "yellow"} +Update ← map {"price" "color" "year"} {15.25 "red" 1974} +&pBase +&pUpdate +UnmapAndPop ← ◌: °map +GetAndMap ← ˜map˜get + +°⊂ UnmapAndPop Base UnmapAndPop Update +Base. +GetAndMap +.:◌: +Update +GetAndMap +&p"\n" +&p⊂ +&p"\n" + +&pBase +&pUpdate diff --git a/Task/Average-loop-length/YAMLScript/average-loop-length.ys b/Task/Average-loop-length/YAMLScript/average-loop-length.ys index afb2ab3f81..4b3bde0c68 100644 --- a/Task/Average-loop-length/YAMLScript/average-loop-length.ys +++ b/Task/Average-loop-length/YAMLScript/average-loop-length.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 # Use *' (vs. *) to allow arbitrary length arithmetic: mul =: value("*'") diff --git a/Task/Averages-Arithmetic-mean/Langur/averages-arithmetic-mean.langur b/Task/Averages-Arithmetic-mean/Langur/averages-arithmetic-mean.langur index f313eb66b4..ad6e0ac086 100644 --- a/Task/Averages-Arithmetic-mean/Langur/averages-arithmetic-mean.langur +++ b/Task/Averages-Arithmetic-mean/Langur/averages-arithmetic-mean.langur @@ -1,4 +1,4 @@ -val umean = fn x:fold(fn{+}, x) / len(x) +val umean = fn x:fold(x, by=fn{+}) / len(x) writeln " custom: ", umean([7, 3, 12]) writeln "built-in: ", mean([7, 3, 12]) diff --git a/Task/Averages-Arithmetic-mean/Ursalang/averages-arithmetic-mean.ursa b/Task/Averages-Arithmetic-mean/Ursalang/averages-arithmetic-mean.ursa new file mode 100644 index 0000000000..f678c19151 --- /dev/null +++ b/Task/Averages-Arithmetic-mean/Ursalang/averages-arithmetic-mean.ursa @@ -0,0 +1,8 @@ +let mean = fn(l) { + var tot = 0 + for i in l.iter() { + tot := tot + i + } + return tot/l.len() +} +print(mean([10, 30, 50, 5, 5])) diff --git a/Task/Averages-Mean-angle/Julia/averages-mean-angle-2.jl b/Task/Averages-Mean-angle/Julia/averages-mean-angle-2.jl index cefb410d21..9bd21ffb79 100644 --- a/Task/Averages-Mean-angle/Julia/averages-mean-angle-2.jl +++ b/Task/Averages-Mean-angle/Julia/averages-mean-angle-2.jl @@ -1,8 +1,8 @@ julia> meandegrees([350, 10]) 0.0 -julia> meandegrees([90, 180, 270, 360]]) +julia> meandegrees([90, 180, 270, 360]) 0.0 -julia> meandegrees([10, 20, 30]]) +julia> meandegrees([10, 20, 30]) 19.999999999999996 diff --git a/Task/Averages-Mode/Ursalang/averages-mode.ursa b/Task/Averages-Mode/Ursalang/averages-mode.ursa new file mode 100644 index 0000000000..4201bfb04e --- /dev/null +++ b/Task/Averages-Mode/Ursalang/averages-mode.ursa @@ -0,0 +1,20 @@ +let mode = fn(l) { + let m = {} + for i in l.iter() { + let old = m.get(i) + let new = if old == null {1} else {old + 1} + m.set(i, new) + } + var max = 0 + var mode = null + for i in m.iter() { + if i.get(1) > max { + max := i.get(1) + mode := i.get(0) + } + } + return mode +} + +print(mode([4, 6, 66, 66, 9, 22, 9, 9, 23, 43, 2, 43])) +print(mode(["abc", "def", "ghi", "abc"])) diff --git a/Task/Averages-Root-mean-square/Raku/averages-root-mean-square-2.raku b/Task/Averages-Root-mean-square/Raku/averages-root-mean-square-2.raku index e813d829a8..2bb7f6aecd 100644 --- a/Task/Averages-Root-mean-square/Raku/averages-root-mean-square-2.raku +++ b/Task/Averages-Root-mean-square/Raku/averages-root-mean-square-2.raku @@ -1 +1 @@ -sub rms { sqrt @_ R/ [+] @_ X** 2 } +sub rms { sqrt @_ R/ [+] @_».² } diff --git a/Task/Averages-Root-mean-square/Ursalang/averages-root-mean-square.ursa b/Task/Averages-Root-mean-square/Ursalang/averages-root-mean-square.ursa new file mode 100644 index 0000000000..cd5c2e381a --- /dev/null +++ b/Task/Averages-Root-mean-square/Ursalang/averages-root-mean-square.ursa @@ -0,0 +1,5 @@ +var tot = 0 +for i in range(10) { + tot := tot + (i + 1) ** 2 +} +print(sqrt(tot/10)) diff --git a/Task/Averages-Simple-moving-average/M2000-Interpreter/averages-simple-moving-average-1.m2000 b/Task/Averages-Simple-moving-average/M2000-Interpreter/averages-simple-moving-average-1.m2000 new file mode 100644 index 0000000000..3e70598a48 --- /dev/null +++ b/Task/Averages-Simple-moving-average/M2000-Interpreter/averages-simple-moving-average-1.m2000 @@ -0,0 +1,28 @@ +module Simple_moving_average { + smaMAKER=lambda (m) -> { + s=stack + =lambda m, s (N) -> { + stack s { + if len(s)=m then drop + data N + } + = array(stack(s))#sum()/len(s) + } + } + Print "Period = 3" + ma=smaMaker(3) + test(0, 9) + Print "Period = 5" + ma=smaMaker(5) + test(9, 0) + end + sub test(A, B) + local i + Print + for i=A to B + Print "Add ";i;" => moving average ";ma(i) + next + Print + end sub +} +Simple_moving_average diff --git a/Task/Averages-Simple-moving-average/M2000-Interpreter/averages-simple-moving-average-2.m2000 b/Task/Averages-Simple-moving-average/M2000-Interpreter/averages-simple-moving-average-2.m2000 new file mode 100644 index 0000000000..6ebf41e00a --- /dev/null +++ b/Task/Averages-Simple-moving-average/M2000-Interpreter/averages-simple-moving-average-2.m2000 @@ -0,0 +1,37 @@ +module Simple_moving_average { + class smaMaker { + private: + s=stack + m + public: + set { + read this + } + value (N) { + stack .s { + if len(.s)=.m then drop + data N + } + = array(stack(.s))#sum()/len(.s) + } + class: + module smaMaker (.m) { + } + } + Print "Period = 3" + ma=smaMaker(3) + test(0, 9) + Print "Period = 5" + ma=smaMaker(5) + test(9, 0) + end + sub test(A, B) + local i + Print + for i=A to B + Print "Add ";i;" => moving average ";ma(i) + next + Print + end sub +} +Simple_moving_average diff --git a/Task/Babbage-problem/EDSAC-order-code/babbage-problem.edsac b/Task/Babbage-problem/EDSAC-order-code/babbage-problem.edsac index 3189034b85..1240f20d03 100644 --- a/Task/Babbage-problem/EDSAC-order-code/babbage-problem.edsac +++ b/Task/Babbage-problem/EDSAC-order-code/babbage-problem.edsac @@ -26,12 +26,13 @@ Here, the last character sets the teleprinter to figures.] [4] PF PF [1st difference for n^2] [Constants] +[2024-12-25 Load time: clear each 35-bit constant, including sandwich bit] + T6#ZPF T8#ZPF T10#ZPF T12#ZPF +[Then resume normal loading at first 35-bit constant] + T6Z [6] P64F PF [2nd difference for n^2, i.e. 128] [8] P4F PF [1st difference for n, i.e. 8] - T10#Z PF T10Z [clears sandwich digit between 10 and 11; - cf. Wilkes, Wheeler & Gill, 1951, pp 110, 141-2] [10] #1760F V2046F [-1000000] - T12#Z PF T12Z [clears sandwich digit between 12 and 13] [12] Q1728F PD [269696] [14] &F [line feed] [15] @F [carriage return] diff --git a/Task/Babbage-problem/M2000-Interpreter/babbage-problem.m2000 b/Task/Babbage-problem/M2000-Interpreter/babbage-problem.m2000 index 1dcd8795e0..db574a7240 100644 --- a/Task/Babbage-problem/M2000-Interpreter/babbage-problem.m2000 +++ b/Task/Babbage-problem/M2000-Interpreter/babbage-problem.m2000 @@ -1,6 +1,14 @@ -Def Long k=1000000, T=269696, n +long long k=1000000, T=269696, n +boolean first=true +Document doc$ n=Sqrt(269696) For n=n to k { - If n^2 mod k = T Then Exit + If n^2&& mod k = T Then + doc$=format$("The "+if$(first->"smallest", "next")+" number whose square ends in {0} is {1}, Its square is {2}", T, n, n**2&&)+{ + } + first=false + refresh + end if } -Report format$("The smallest number whose square ends in {0} is {1}, Its square is {2}", T, n, n**2) +clipboard doc$ +report doc$ diff --git a/Task/Babbage-problem/PascalABC.NET/babbage-problem.pas b/Task/Babbage-problem/PascalABC.NET/babbage-problem.pas new file mode 100644 index 0000000000..e8c2ecff0e --- /dev/null +++ b/Task/Babbage-problem/PascalABC.NET/babbage-problem.pas @@ -0,0 +1,9 @@ +//the smallest positive integer whose square ends in the digits 269,696 +## var k:=269696; +var n:=trunc(sqrt(k));(* Start with n *) +if n mod 2<>0 then n-=1;(* n:=n-1 *) + repeat + n += 2 (* Increase n by 2. n:=n+2 *) + until (n * n) mod 1000000 = 269696; +$'The smallest positive integer is {n} whose square ends in {k}'.println; +$'{n}² = {n*n}'.println; diff --git a/Task/Bell-numbers/BQN/bell-numbers.bqn b/Task/Bell-numbers/BQN/bell-numbers.bqn new file mode 100644 index 0000000000..918f1357ad --- /dev/null +++ b/Task/Bell-numbers/BQN/bell-numbers.bqn @@ -0,0 +1,8 @@ +Bell ← {(+`⊢´⊸∾)⍟(↕𝕩)⋈1} + +•Out "First 15 Bell numbers:" +•Show ⊑¨ Bell 15 + +•Out "" +•Out "First 10 rows of the Bell triangle:" +•Show¨ Bell 10 diff --git a/Task/Bell-numbers/Forth/bell-numbers.fth b/Task/Bell-numbers/Forth/bell-numbers.fth new file mode 100644 index 0000000000..6b7c8259fa --- /dev/null +++ b/Task/Bell-numbers/Forth/bell-numbers.fth @@ -0,0 +1,51 @@ +: triangle-allocate ( u -- addr ) + dup 1+ * 2/ cells dup + allocate abort" out of memory" + tuck swap erase ; + +: triangle-deallocate ( addr -- ) + free abort" memory deallocation error" ; + +: triangle-row-address ( addr u -- addr ) + dup 1+ * 2/ cells + ; + +: bell-triangle-row ( addr u -- ) + tuck 1- triangle-row-address + 2dup swap cells + + dup 1 cells - @ over ! + rot 0 ?do + dup @ >r over @ r> + >r + cell+ r> over ! + swap cell+ swap + loop 2drop ; + +: bell-triangle ( u -- addr ) + dup triangle-allocate + dup 1 swap ! + swap 1 ?do + dup i bell-triangle-row + loop ; + +: print-bell-numbers ( addr u -- ) + 0 ?do + dup i triangle-row-address @ . cr + loop drop ; + +: print-bell-row ( addr u -- ) + tuck triangle-row-address swap + 1+ 0 ?do + dup @ . cell+ + loop drop cr ; + +: main ( -- ) + 15 bell-triangle + ." First 15 Bell numbers:" cr + dup 15 print-bell-numbers cr + ." First 10 rows of the Bell triangle:" cr + 10 0 do + dup i print-bell-row + loop + triangle-deallocate ; + +main +bye diff --git a/Task/Bell-numbers/Haskell/bell-numbers-5.hs b/Task/Bell-numbers/Haskell/bell-numbers-5.hs new file mode 100644 index 0000000000..2574f2daa3 --- /dev/null +++ b/Task/Bell-numbers/Haskell/bell-numbers-5.hs @@ -0,0 +1,17 @@ +import Data.Ratio ((%), numerator) + +infixl 7 *. +(*.) :: Num a => a -> [a] -> [a] +x *. (p:ps) = x*p : x*.ps + +instance Num a => Num [a] where + negate = map negate + (+) = zipWith (+) + (*) (p:ps) (q:qs) = p*q : ((p*.qs) + ps*(q:qs)) + fromInteger n = fromInteger n:repeat 0 + +instance (Eq a, Fractional a) => Fractional [a] where + (/) (0:ps) (0:qs) = ps/qs + (/) (p:ps) (q:qs) = let r=p/q in r : (ps - r*.qs)/(q:qs) + + fromRational q = fromRational q:repeat 0 diff --git a/Task/Bell-numbers/Haskell/bell-numbers-6.hs b/Task/Bell-numbers/Haskell/bell-numbers-6.hs new file mode 100644 index 0000000000..1cccede973 --- /dev/null +++ b/Task/Bell-numbers/Haskell/bell-numbers-6.hs @@ -0,0 +1,2 @@ +expseq :: [Rational] -> [Rational] +expseq ps = zipWith (\p q -> p*fromInteger q) ps (scanl (*) 1 [1..]) diff --git a/Task/Bell-numbers/Haskell/bell-numbers-7.hs b/Task/Bell-numbers/Haskell/bell-numbers-7.hs new file mode 100644 index 0000000000..e6c2d50d9c --- /dev/null +++ b/Task/Bell-numbers/Haskell/bell-numbers-7.hs @@ -0,0 +1,3 @@ +infixr 9 |> +(|>) :: (Eq a, Num a) => [a] -> [a] -> [a] +(p:ps) |> (0:qs) = p : qs*(ps |> (0:qs)) diff --git a/Task/Bell-numbers/Haskell/bell-numbers-8.hs b/Task/Bell-numbers/Haskell/bell-numbers-8.hs new file mode 100644 index 0000000000..9cc115db88 --- /dev/null +++ b/Task/Bell-numbers/Haskell/bell-numbers-8.hs @@ -0,0 +1,11 @@ +exp1 :: [Rational] +exp1 = 0 : map (1%) factorials + where + factorials = scanl (*) 1 [2..] + +exps :: [Rational] +exps = 1 : zipWith (*) exps [ 1%n | n <- [1..] ] + +bell :: [Integer] +bell = map numerator + (expseq (exps |> exp1)) diff --git a/Task/Bell-numbers/Haskell/bell-numbers-9.hs b/Task/Bell-numbers/Haskell/bell-numbers-9.hs new file mode 100644 index 0000000000..11d50b5761 --- /dev/null +++ b/Task/Bell-numbers/Haskell/bell-numbers-9.hs @@ -0,0 +1,4 @@ +ghci> take 15 bell +[1,1,2,5,15,52,203,877,4140,21147,115975,678570,4213597,27644437,190899322] +ghci> bell !! 49 +10726137154573358400342215518590002633917247281 diff --git a/Task/Bell-numbers/Miranda/bell-numbers.miranda b/Task/Bell-numbers/Miranda/bell-numbers.miranda new file mode 100644 index 0000000000..67a573f599 --- /dev/null +++ b/Task/Bell-numbers/Miranda/bell-numbers.miranda @@ -0,0 +1,16 @@ +main :: [sys_message] +main = [Stdout "First 15 and 50th Bell numbers:\n", + Stdout (lay [(rjustify 2 (show i)) ++ ": " ++ show (bell_numbers ! i) + | i <- [1..15] ++ [50]]), + Stdout "\nFirst 10 rows of the Bell triangle:\n", + Stdout (lay [concat [rjustify 7 (show n) | n <- row] + | row <- take 10 bell_triangle]) + ] + + +bell_numbers :: [num] +bell_numbers = map last bell_triangle + +bell_triangle :: [[num]] +bell_triangle = iterate bell_step [1] + where bell_step row = scan (+) (last row) row diff --git a/Task/Bell-numbers/PARI-GP/bell-numbers.parigp b/Task/Bell-numbers/PARI-GP/bell-numbers.parigp new file mode 100644 index 0000000000..f62bf25259 --- /dev/null +++ b/Task/Bell-numbers/PARI-GP/bell-numbers.parigp @@ -0,0 +1,4 @@ +genit(maxx=50)={bell=List(); +for(n=0,maxx,q=sum(k=0,n,stirling(n,k,2)); +listput(bell,q));bell} +END diff --git a/Task/Bell-numbers/Refal/bell-numbers.refal b/Task/Bell-numbers/Refal/bell-numbers.refal new file mode 100644 index 0000000000..f65c59ce11 --- /dev/null +++ b/Task/Bell-numbers/Refal/bell-numbers.refal @@ -0,0 +1,41 @@ +$ENTRY Go { + , : e.Bell (e.B50) + , : (e.F15) e.Rest + = + + >; +} + +Show { + (e.X) = >; +}; + +BellNumbers { + s.N, : e.Rows = ; +}; + +BellTriangle { + s.N = ((1))>; + 0 e.T = e.T; + s.N e.Rs (e.R) = e.Rs (e.R) ()>; +}; + +BellStep { + e.Row, e.Row: e.X (e.Last) = ; +}; + +Rsum { + (Acc e.Acc) = ; + (Acc e.Acc) (e.N) e.Ns, : e.N2 = + (e.N2) ; + e.Ns = ; +}; + +Each { + (e.F) = ; + (e.F) (e.X) e.Xs = () ; +}; + +Head { + t.X e.Y = t.X; +}; diff --git a/Task/Bell-numbers/SETL/bell-numbers.setl b/Task/Bell-numbers/SETL/bell-numbers.setl new file mode 100644 index 0000000000..83c7ca45d4 --- /dev/null +++ b/Task/Bell-numbers/SETL/bell-numbers.setl @@ -0,0 +1,31 @@ +program bell_numbers; + print("First 15 and 50th Bell numbers:"); + b := bell_nums(50); + loop for i in [1..15] with 50 do + print(lpad(str i, 2) + ": " + str b(i)); + end loop; + + print; + print("First 10 rows of the Bell triangle:"); + loop for row in bell_triangle(10) do + print(+/[lpad(str n, 7) : n in row]); + end loop; + + proc bell_nums(n); + tri := bell_triangle(n); + return [row(#row) : row in tri]; + end proc; + + proc bell_triangle(rows); + tri := [[1]]; + loop for i in [2..rows] do + row := tri(#tri); + nextrow := [row(#row)]; + loop for n in row do + nextrow with:= nextrow(#nextrow) + n; + end loop; + tri with:= nextrow; + end loop; + return tri; + end proc; +end program; diff --git a/Task/Benfords-law/Quackery/benfords-law.quackery b/Task/Benfords-law/Quackery/benfords-law.quackery new file mode 100644 index 0000000000..c18ea50a99 --- /dev/null +++ b/Task/Benfords-law/Quackery/benfords-law.quackery @@ -0,0 +1,36 @@ + [ $ "bigrat.qky" loadfile ] now! + + [ ' [ 1 1 ] + swap 2 - times + [ dup -1 peek + over -2 peek + + join ] ] is fibonacci ( n --> [ ) + + [ 0 swap witheach + ] is sum ( [ --> n ) + + [ [ 10 /mod over while + drop again ] nip ] is msd ( n --> n ) + + [ 2dup peek 1+ unrot poke ] is tallydigit ( [ n --> [ ) + + [ 0 10 of swap + witheach + [ msd tallydigit ] ] is msdcount ( [ --> [ ) + + [ [ table + $ "0.30103" $ "0.17609" + $ "0.12494" $ "0.09691" + $ "0.07918" $ "0.06695" + $ "0.05799" $ "0.05115" + $ "0.04576" ] do echo$ ] is expected ( --> ) + + say "n expected counted" cr + 1000 fibonacci msdcount + behead drop + dup sum swap + witheach + [ i^ 1+ echo sp sp + i^ expected sp sp + over reduce + 5 point$ echo$ cr ] + drop diff --git a/Task/Bifid-cipher/Go/bifid-cipher.go b/Task/Bifid-cipher/Go/bifid-cipher.go new file mode 100644 index 0000000000..c8a6cfa6fe --- /dev/null +++ b/Task/Bifid-cipher/Go/bifid-cipher.go @@ -0,0 +1,180 @@ +/* + Only use ASCII letters between A and Z or the Characters in square... . If the row with 'J' is removed from the squares, + then the square is a 'Polybios square' and you must use removeSpaceI(text) to encrypt and decrypt +*/ +package main + +import ( + "fmt" + "strings" +) + +var ( + squareRosetta [][]byte = [][]byte{ //rosettacode + {'A', 'B', 'C', 'D', 'E'}, + {'F', 'G', 'H', 'I', 'K'}, + {'L', 'M', 'N', 'O', 'P'}, + {'Q', 'R', 'S', 'T', 'U'}, + {'V', 'W', 'X', 'Y', 'Z'}, + {'J', '1', '2', '3', '4'}, + } + + squareWikipedia [][]byte = [][]byte{ // wikipedia + + {'B', 'G', 'W', 'K', 'Z'}, + {'Q', 'P', 'N', 'D', 'S'}, + {'I', 'O', 'A', 'X', 'E'}, + {'F', 'C', 'L', 'U', 'M'}, + {'T', 'H', 'Y', 'V', 'R'}, + {'J', '1', '2', '3', '4'}, + } + + textRosetta string = "0ATTACKATDAWN" + textRosettaEncoded string = "DQBDAXDQPDQH" // only for test + textWikipedia string = "FLEEATONCE" + textWikipediaEncoded string = "UAEOLWRINS" // only for test + textTest string = "The invasion will start on the first of January" + textTextEncoded string = "RASOAQXFIOORXESXADETSWLTNIAZQOISBRGBALY" // only for test +) + +type koord struct { + X byte + Y byte +} + +func (k *koord) LessThen(other *koord) bool { + if k.Y > other.Y { + return false + } + if k.Y < other.Y { + return true + } + if k.X < other.X { + return true + } + return false +} + +func (k *koord) EqualTo(other koord) bool { + if k.X == other.X && k.Y == other.Y { + return true + } + return false +} + +var encryptMap map[byte]koord +var decryptMap map[koord]byte + +func squareToMaps(square [][]byte) (map[byte]koord, map[koord]byte) { + eMap := make(map[byte]koord) + dMap := make(map[koord]byte) + for x, col := range square { + for y, v := range col { + eMap[v] = koord{byte(x), byte(y)} + dMap[koord{byte(x), byte(y)}] = v + + } + } + return eMap, dMap +} + +func removeSpaceI(text string) string { + var n string + s := strings.ToUpper(text) + for _, b := range []byte(s) { + //use only ASCII Characters from A to Z + if b < 'A' || b > 'Z' { + continue + } + if b == 'J' { + b = 'I' + } + n = n + string(b) + } + return n +} + +func removeSpace(text string, square map[byte]koord) string { + var n string + //to UpperCase and then remove all Spaces an Characters witch are not in square + s := strings.ReplaceAll(strings.ToUpper(text), " ", "") + for _, b := range []byte(s) { + _, ok := square[b] + if ok { + n = n + string(b) + } + } + return n +} + +func encrypt(text string, emap map[byte]koord, dmap map[koord]byte) string { + text = removeSpace(text, emap) + var row0, row1 []byte + for _, b := range []byte(text) { + xy := emap[b] + row0 = append(row0, xy.X) + row1 = append(row1, xy.Y) + } + row0 = append(row0, row1...) + + var s string + for i := 0; i < len(row0); i += 2 { + s = s + string(dmap[koord{row0[i], row0[i+1]}]) + } + return s +} + +func decrypt(text string, emap map[byte]koord, dmap map[koord]byte) string { + text = removeSpace(text, emap) + k := make([]koord, len(text)) + + for i, b := range []byte(text) { + k[i] = emap[b] + } + + kl := make([]byte, len(k)*2) + i := int(0) + for _, ki := range k { + kl[i] = ki.X + kl[i+1] = ki.Y + i += 2 + } + l := len(kl) / 2 + k1 := kl[:l] + k2 := kl[l:] + var s string + + for i := 0; i < l; i++ { + s = s + string(dmap[koord{k1[i], k2[i]}]) + } + return s +} + +func main() { + + encryptMap, decryptMap = squareToMaps(squareRosetta) + fmt.Println("from Rosettacode") + fmt.Println("original:\t", textRosetta) + s := encrypt(textRosetta, encryptMap, decryptMap) + fmt.Println("codiert:\t", s) + s = decrypt(s, encryptMap, decryptMap) + fmt.Println("and back:\t", s) + + fmt.Println("from Wikipedia") + encryptMap, decryptMap = squareToMaps(squareWikipedia) + fmt.Println("original:\t", textWikipedia) + s = encrypt(textWikipedia, encryptMap, decryptMap) + fmt.Println("codiert:\t", s) + s = decrypt(s, encryptMap, decryptMap) + fmt.Println("and back:\t", s) + + encryptMap, decryptMap = squareToMaps(squareWikipedia) + fmt.Println("from Rosettacode long part") + fmt.Println("original:\t", textTest) + s = encrypt(textTest, encryptMap, decryptMap) + fmt.Println("codiert:\t", s) + // Wenn der Text eine ungerade Anzahl Buchstaben hat, funktioniert der Algorithmus nicht!!! + s = decrypt(s, encryptMap, decryptMap) + fmt.Println("and back:\t", s) + +} diff --git a/Task/Bifid-cipher/Haskell/bifid-cipher.hs b/Task/Bifid-cipher/Haskell/bifid-cipher.hs new file mode 100644 index 0000000000..9964f7aa9d --- /dev/null +++ b/Task/Bifid-cipher/Haskell/bifid-cipher.hs @@ -0,0 +1,60 @@ +import Data.List +import Data.Char + +-- Defining all the grids I'll be using in one go. + +rcBifid = [ + 'A','B','C','D','E', + 'F','G','H','I','K', + 'L','M','N','O','P', + 'Q','R','S','T','U', + 'V','W','X','Y','Z' + ] -- We will use strings here onwards. This was just a demonstration. + +wikiBifid = "POLYBIUSCHERADFGKMNQTVWXZ" +cmiBifid = "CMIHASKELQWRTYUOPDFGZXVBN" + +-- Convert a character to its grid coordinates (1-based index) +chr2pair square x = if x == 'J' then chr2pair square 'I' else case elemIndex x square of + Nothing -> error "char is not in cipher grid" + Just a -> (\(x,y) -> (x+1,y+1)) (divMod a 5) -- Convert flat index to (row, col) + +pair2chr square (x,y) = square !! ((x-1)*5+y-1) + +-- Pairs up elements from a list, used in Bifid encoding process +pairUp :: [a] -> [(a,a)] +pairUp [] = [] +pairUp [a] = error "Odd number of elements" +pairUp (x:y:ys) = (x,y):(pairUp ys) + +encrypt square message = map (pair2chr square) (pairUp (l ++ r)) where + (l,r) = unzip $ map (chr2pair square) message + +decrypt square message = map (pair2chr square) (zip u d) where + (u,d) = splitAt (length message) $ concatMap (\(x,y) -> [x,y]) $ map (chr2pair square) message + +main = do + let + message1 = "ATTACKATDAWN" + message2 = "FLEEATONCE" + encrypt1 = encrypt rcBifid message1 + encrypt2 = encrypt wikiBifid message2 + encrypt3 = encrypt wikiBifid message1 + myMessage = "The invasion will start on the first of January" + encrypt4 = encrypt cmiBifid $ map toUpper $ filter (/= ' ') myMessage -- Remove spaces, uppercase + + putStrLn $ "Message 1: " ++ message1 + putStrLn $ "Encryption wrt RC's square: " ++ encrypt1 + putStrLn $ "Decrypt: " ++ show (decrypt rcBifid encrypt1) + + putStrLn $ "Message 2: " ++ message2 + putStrLn $ "Encryption wrt Wiki's square: " ++ encrypt2 + putStrLn $ "Decrypt: " ++ show (decrypt wikiBifid encrypt2) + + putStrLn $ "Message 3: " ++ message1 + putStrLn $ "Encryption wrt Wiki's square: " ++ encrypt3 + putStrLn $ "Decrypt: " ++ show (decrypt wikiBifid encrypt3) + + putStrLn $ "Message 4: " ++ myMessage + putStrLn $ "Encryption wrt CMI square: " ++ encrypt4 + putStrLn $ "Decrypt: " ++ show (decrypt cmiBifid encrypt4) diff --git a/Task/Bifid-cipher/M2000-Interpreter/bifid-cipher.m2000 b/Task/Bifid-cipher/M2000-Interpreter/bifid-cipher.m2000 new file mode 100644 index 0000000000..67d507af7a --- /dev/null +++ b/Task/Bifid-cipher/M2000-Interpreter/bifid-cipher.m2000 @@ -0,0 +1,68 @@ +module Bifid_cipher (f, code$) { + n=sqrt(len(code$)) + print #f," "; + for i=1 to n + print #f, i+" "; + next + print #f + for i=0 to n-1 + Print #f, (i+1)+" "+STR$(mid$(code$,1+i*n, n),STRING$("@ ", 5)) + next + tables=lambda (a$)->{ + n=sqrt(len(a$)) + a=list + for i=1 to len(a$) + append a, mid$(a$,i, 1):=((i-1) mod n+1, (i-1) div n+1 ) + next + b=list + m=each(a) + while m + z=eval(m) + append b, z#val$(1)+z#val$(0):=eval$(m!) + end while + =a, b + }(code$) + encode= lambda (a, b)->{ + =lambda a,b (mess as string) -> { + document code$ + for n=1 to 0 + for i=1 to len(mess) + q=mid$(mess, i,1) + if not exist(a, q) then + if q="J" then q="I" else q="A" + end if + code$=a(q)#val$(n) + next + next + document final$ + for i=1 to len(code$) step 2 + final$=b$(mid$(code$, i, 2)) + next + = final$ + } + }(!tables) + decode= lambda (a, b)->{ + =lambda a,b (final as string) -> { + document code$, mess$ + for i=1 to len(final) + q=a(mid$(final, i, 1)) + code$=q#val$(1)+q#val$(0) + next + offset=len(code$) div 2 + for i=1 to offset + mess$=b$(mid$(code$,i,1)+mid$(code$,i+offset,1)) + next + = mess$ + } + }(!tables) + Print #f, encode("ATTACKATDAWN") + Print #f, decode(encode("ATTACKATDAWN"))="ATTACKATDAWN" + Print #f, encode(ucase$(filter$("The invasion will start on the first of January", " "))) + Print #f, decode(encode(ucase$(filter$("The invasion will start on the first of January", " ")))) +} +open "out.txt" for output as #a +Bifid_cipher a, "ABCDEFGHIKLMNOPQRSTUVWXYZ" +Bifid_cipher a, "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" +Bifid_cipher a, "BGWKZQPNDSIOAXEFCLUMTHYVR" +close #a +win "out.txt" diff --git a/Task/Binary-digits/Zig/binary-digits.zig b/Task/Binary-digits/Zig/binary-digits.zig new file mode 100644 index 0000000000..8b207ca0b0 --- /dev/null +++ b/Task/Binary-digits/Zig/binary-digits.zig @@ -0,0 +1,7 @@ +const std = @import("std"); + +pub fn main() void { + for(0..10) |i| { + std.debug.print("{b}\n", .{i}); + } +} diff --git a/Task/Binary-strings/Free-Pascal-Lazarus/binary-strings.pas b/Task/Binary-strings/Free-Pascal-Lazarus/binary-strings.pas new file mode 100644 index 0000000000..7a8bb08035 --- /dev/null +++ b/Task/Binary-strings/Free-Pascal-Lazarus/binary-strings.pas @@ -0,0 +1,31 @@ +uses sysutils; +var + { declaration is creation } + a,b:string; + { creation with default value } + c:string = 'this is a string'; +begin + { assignment } + a := 'test'; + b := 'test'; + writeln(a:6, b:6); + { comparison } + writeln('equal? ', a = b ); + { empty string } + writeln('empty? ', a = ''); + { cloning, copying } + a := c; + writeln('copy c to a, a is now: ', a); + { append } + b := b +'W'; + writeln('append W to b: ',b); + { extract substring } + b := copy(a,6,2); + writeln('this should be is": ',b); + { replace } + a := stringreplace(a,'i','I',[rfReplaceAll]); + writeln('replace i with I: ',a); + { join } + a:= concat(b,c); + writeln('join b and c; ',a); +end. diff --git a/Task/Binary-strings/M2000-Interpreter/binary-strings.m2000 b/Task/Binary-strings/M2000-Interpreter/binary-strings.m2000 new file mode 100644 index 0000000000..02751bf64b --- /dev/null +++ b/Task/Binary-strings/M2000-Interpreter/binary-strings.m2000 @@ -0,0 +1,51 @@ +' String assignment +a$="alfa" +string a="beta" +b="beta too" +all=a$+a+b +Print All +' String comparison +Print a$=a, a=b, a+A+" too"+a$=a+b+a$ ' false false true +b$=a$ +// compare return 0 for equal (-1,0, 1), +//same as <=> but compare work with variables only (without coping values) +print "using compare", compare(a$, b$), a$<=>b$ ' 0 0 +' String cloning and copying +a2$=a$ ' copy +' Check if a string is empty +print a2$="", len(a$)=0 +' Append a byte to a string +c$=Str$("ABCDE") ' utf16le "ABCDE" convert to ANSI (one byte per code) +Print len(c$)=2.5 ' measure 16bit, so we get 2.5x2=5 bytes +c$+=Str$("Z") +Print Len(c$)=3 +Print chr$(c$)="ABCDEZ" ' convert to UTF16LE and then compare +' Extract a substring from a string +Print chr$(mid$(c$,2, 2 as byte))="BC" +Print mid$("ABCDEZ",2,2) ="BC" +' Replace every occurrence of a byte (or a string) in a string with another string +Print Replace$("BC", "?", "ABCDEZBC")="A?DEZ?" +Print Replace$("BC", "?", CHR$(c$))="A?DEZ" +' String creation and destruction (using buffers. Memory Blocks) +' (when needed and if there's no garbage collection or similar mechanism) +'Join strings (IN A BUFFRT) +buffer clear K as byte*10 ' using clear to erase the buffer with 0 +Return K, 0:=c$ +Print eval(k, 2)=asc("C"), eval(k, 3)=asc("D") +Return k, 2:=str$("KL") +Print chr$(eval$(k, 0, 6))="ABKLEZ" +' rotate one byte +M= eval(K,0) +return k, 0:=eval$(k, 1, 5), 5:=m ' we can place strings or bytes at specific index - from 0. +Print chr$(eval$(k, 0, 6))="BKLEZA" ' true +// change length of buffer +buffer K as byte*6 +// now we get the full string (with the length of 6 bytes) +Print chr$(eval$(k))="BKLEZA" ' true +buffer K1 as byte*6 +// buffers are special objects, so we have strings refering by object pointer. +// we can pass the buffer pointer or return it from a function, also we can swap variables for buffers +swap K, k1 +Print chr$(eval$(k1))="BKLEZA" ' true +// we can get the address of string: +Print k1(0) ' return the absolute address of byte at offset 0 on k1 buffer diff --git a/Task/Binary-strings/Sidef/binary-strings.sidef b/Task/Binary-strings/Sidef/binary-strings.sidef new file mode 100644 index 0000000000..9f9f66c290 --- /dev/null +++ b/Task/Binary-strings/Sidef/binary-strings.sidef @@ -0,0 +1,48 @@ +# string creation +var x = "hello world" + +# string destruction +x = nil + +# string assignment with a null byte +x = "a\0b" +say x.length # ==> 3 + +# string comparison +if (x == "hello") { + say "equal" +} else { + say "not equal" +} + +var y = 'bc' +if (x < y) { + say "#{x} is lexicographically less than #{y}" +} + +# string cloning +var xx = x.clone +say (x == xx) # true, same length and content +say (x.refaddr == xx.refaddr) # false, different objects + +# check if empty +if (x.is_empty) { + say "is empty" +} + +# append a byte +x += "\07" +say x.dump #=> "a\0b\a" + +# substring +say x.substr(0, -1).dump #=> "a\0b" + +# replace bytes +say "hello world".tr("l", "L") + +# join strings +var a = "hel" +var b = "lo w" +var c = "orld" +var d = (a + b + c) +say d diff --git a/Task/Bioinformatics-base-count/C/bioinformatics-base-count-1.c b/Task/Bioinformatics-base-count/C/bioinformatics-base-count-1.c deleted file mode 100644 index 40a842e9b5..0000000000 --- a/Task/Bioinformatics-base-count/C/bioinformatics-base-count-1.c +++ /dev/null @@ -1,115 +0,0 @@ -#include -#include -#include - -typedef struct genome{ - char* strand; - int length; - struct genome* next; -}genome; - -genome* genomeData; -int totalLength = 0, Adenine = 0, Cytosine = 0, Guanine = 0, Thymine = 0; - -int numDigits(int num){ - int len = 1; - - while(num>10){ - num = num/10; - len++; - } - - return len; -} - -void buildGenome(char str[100]){ - int len = strlen(str),i; - genome *genomeIterator, *newGenome; - - totalLength += len; - - for(i=0;istrand = (char*)malloc(len*sizeof(char)); - strcpy(genomeData->strand,str); - genomeData->length = len; - - genomeData->next = NULL; - } - - else{ - genomeIterator = genomeData; - - while(genomeIterator->next!=NULL) - genomeIterator = genomeIterator->next; - - newGenome = (genome*)malloc(sizeof(genome)); - - newGenome->strand = (char*)malloc(len*sizeof(char)); - strcpy(newGenome->strand,str); - newGenome->length = len; - - newGenome->next = NULL; - genomeIterator->next = newGenome; - } -} - -void printGenome(){ - genome* genomeIterator = genomeData; - - int width = numDigits(totalLength), len = 0; - - printf("Sequence:\n"); - - while(genomeIterator!=NULL){ - printf("\n%*d%3s%3s",width+1,len,":",genomeIterator->strand); - len += genomeIterator->length; - - genomeIterator = genomeIterator->next; - } - - printf("\n\nBase Count\n----------\n\n"); - - printf("%3c%3s%*d\n",'A',":",width+1,Adenine); - printf("%3c%3s%*d\n",'T',":",width+1,Thymine); - printf("%3c%3s%*d\n",'C',":",width+1,Cytosine); - printf("%3c%3s%*d\n",'G',":",width+1,Guanine); - printf("\n%3s%*d\n","Total:",width+1,Adenine + Thymine + Cytosine + Guanine); - - free(genomeData); -} - -int main(int argc,char** argv) -{ - char str[100]; - int counter = 0, len; - - if(argc!=2){ - printf("Usage : %s \n",argv[0]); - return 0; - } - - FILE *fp = fopen(argv[1],"r"); - - while(fscanf(fp,"%s",str)!=EOF) - buildGenome(str); - fclose(fp); - - printGenome(); - - return 0; -} diff --git a/Task/Bioinformatics-base-count/C/bioinformatics-base-count-2.c b/Task/Bioinformatics-base-count/C/bioinformatics-base-count.c similarity index 100% rename from Task/Bioinformatics-base-count/C/bioinformatics-base-count-2.c rename to Task/Bioinformatics-base-count/C/bioinformatics-base-count.c diff --git a/Task/Bioinformatics-base-count/M2000-Interpreter/bioinformatics-base-count.m2000 b/Task/Bioinformatics-base-count/M2000-Interpreter/bioinformatics-base-count.m2000 new file mode 100644 index 0000000000..ad0dda3e8e --- /dev/null +++ b/Task/Bioinformatics-base-count/M2000-Interpreter/bioinformatics-base-count.m2000 @@ -0,0 +1,39 @@ +Module Bioinformatics_base_count (f){ + a$={ + CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG + CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG + AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT + GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT + CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG + TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA + TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT + CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG + TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC + GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT + } + Data "A", "C","G","T" + a$=filter$(a$," "+chr$(13)+chr$(10)+chr$(9)) + tot=len(a$) + k=1 + print #f, "SEQUENCE:" + for i=50 to len(a$) step 50 + Print #f, str$(k,"000: ");mid$(a$, k, 50) + k=i + next + Print #f, "BASECOUNT:" + while not empty + read t$ + b$=filter$(a$, t$) + Print #f, " "+t$+": ";len(a$)-len(b$) + swap a$, b$ + end while + Print #f, "Tot:";tot +} + +open "" for wide output as #f +Bioinformatics_base_count f +close #f +open "outtext.txt" for wide output as #f +Bioinformatics_base_count f +close #f +win "outtext.txt" diff --git a/Task/Biorhythms/C/biorhythms-2.c b/Task/Biorhythms/C/biorhythms-2.c index 3e2d9d0f69..ddd8256686 100644 --- a/Task/Biorhythms/C/biorhythms-2.c +++ b/Task/Biorhythms/C/biorhythms-2.c @@ -3,3 +3,4 @@ gcc -o cbio cbio.c -lm Age: 10717 days Physical cycle: -27% Emotional cycle: -100% +Intellectual cycle: -100% diff --git a/Task/Biorhythms/M2000-Interpreter/biorhythms.m2000 b/Task/Biorhythms/M2000-Interpreter/biorhythms.m2000 index 8b4a33c778..732e4e600f 100644 --- a/Task/Biorhythms/M2000-Interpreter/biorhythms.m2000 +++ b/Task/Biorhythms/M2000-Interpreter/biorhythms.m2000 @@ -1,24 +1,21 @@ -Module Biorhythms { - form 80 - enum bio {Physical=23, Emotional=28,Mental=33} - quadrants=(("up and rising", "peak"), ("up but falling", "transition"), ("down and falling", "valley"), ("down but rising", "transition")) - date birth="1943-03-09" - date bioDay="1972-07-11", transition - for k=1 to 1 +Module Biorhythms (birth, bioDay, N as long = 1) { + date birth, bioDay, transition + enum bio {Physical=23, Emotional=28, Mental=33} + dim quadrants(4) + quadrants(0):=("up and rising", "peak"), ("up but falling", "transition"), ("down and falling", "valley"), ("down but rising", "transition") + if N<1 then N=1 + for k=1 to N long Days=bioDay-birth - Print "Day "+(bioDay)+":" - + Print "Day "+bioDay+" | Age in days: "+Days string frm="{0:-20} : {1}", pword, dfmt="YYYY-MM-DD" - long position, percentage, length, targetday + long position, percentage, length k=each(bio) while k - length=eval(k) - + length=eval(k) position=days mod length quadrant=int(4*position/length) - targetday=bioDay // get the long value of day from date type percentage=100*sin(360*position/length) - transition=bioDay+floor((quadrant+1)/4*23)-position + transition=bioDay+floor((quadrant+1)/4*length)-position select case percentage case >95 pword="peak" @@ -27,14 +24,15 @@ Module Biorhythms { case -5 to 5 pword="critical " case else - { - pword=percentage+"% ("+quadrants#val(quadrant)#val$(0)+", next " - pword+=quadrants#val(quadrant)#val$(1)+" "+str$(transition,dfmt)+")" - } + { + pword=percentage+"% ("+quadrants(quadrant)#val$(0)+", next " + pword+=quadrants(quadrant)#val$(1)+" "+str$(transition, dfmt)+")" + } end select print format$(frm, eval$(k)+" day "+(days mod length), pword) End while bioDay++ next k } -Biorhythms +form 80 +Biorhythms "1943-03-09", "1972-07-11" diff --git a/Task/Biorhythms/Scala/biorhythms.scala b/Task/Biorhythms/Scala/biorhythms-1.scala similarity index 100% rename from Task/Biorhythms/Scala/biorhythms.scala rename to Task/Biorhythms/Scala/biorhythms-1.scala diff --git a/Task/Biorhythms/Scala/biorhythms-2.scala b/Task/Biorhythms/Scala/biorhythms-2.scala new file mode 100644 index 0000000000..347b8ef0ba --- /dev/null +++ b/Task/Biorhythms/Scala/biorhythms-2.scala @@ -0,0 +1,94 @@ +import java.time.LocalDate +import java.time.format.DateTimeFormatter +import java.time.temporal.ChronoUnit +import scala.jdk.CollectionConverters._ + +object Biorhythms extends App { + + private val datePairs = List( + ("1943-03-09", "1972-07-11"), + ("1809-01-12", "1863-11-19"), + ("1809-02-12", "1863-11-19") + ) + + datePairs.foreach(calculateBiorhythms) + + private def calculateBiorhythms(dates: (String, String)): Unit = { + val formatter = DateTimeFormatter.ISO_LOCAL_DATE + val birthDate = LocalDate.parse(dates._1, formatter) + val targetDate = LocalDate.parse(dates._2, formatter) + val daysBetween = ChronoUnit.DAYS.between(birthDate, targetDate).toInt + + println(s"Birth Date: $birthDate, Target Date: $targetDate") + println(s"Days Between: $daysBetween") + + Cycle.values.foreach(processCycle(daysBetween, targetDate, _)) + + println() + } + + private def processCycle(daysBetween: Int, targetDate: LocalDate, cycle: Cycle): Unit = { + val position = daysBetween % cycle.length + val angle = 2 * Math.PI * position / cycle.length + val percentage = Math.round(100 * Math.sin(angle)).toInt + + val description = percentage match { + case p if p > 95 => "peak" + case p if p < -95 => "valley" + case p if Math.abs(p) < 5 => "critical transition" + case _ => + val quadrant = Quadrant.fromPosition(position, cycle.length) + val daysToTransition = quadrant.daysToTransition(position, cycle.length) + val transitionDate = targetDate.plusDays(daysToTransition) + val (trend, nextTransition) = quadrant.getDescriptions + s"$percentage% ($trend, $nextTransition on $transitionDate)" + } + + println(s"${cycle} day $position: $description") + } + + private enum Cycle(val length: Int) { + private case PHYSICAL extends Cycle(23) + private case EMOTIONAL extends Cycle(28) + private case MENTAL extends Cycle(33) + + override def toString: String = this match { + case PHYSICAL => "Physical" + case EMOTIONAL => "Emotional" + case MENTAL => "Mental" + } + } + + enum Quadrant { + case UpAndRising + case UpButFalling + case DownAndFalling + case DownButRising + + def getDescriptions: (String, String) = this match { + case UpAndRising => ("up and rising", "next peak") + case UpButFalling => ("up but falling", "next transition") + case DownAndFalling => ("down and falling", "next valley") + case DownButRising => ("down but rising", "next transition") + } + + def daysToTransition(position: Int, cycleLength: Int): Int = { + val quarter = cycleLength / 4 + val positionInQuadrant = position % quarter + quarter - positionInQuadrant + } + } + + private object Quadrant { + def fromPosition(position: Int, cycleLength: Int): Quadrant = { + val relativePosition = position.toDouble / cycleLength + relativePosition match { + case p if p >= 0.0 && p < 0.25 => Quadrant.UpAndRising + case p if p >= 0.25 && p < 0.5 => Quadrant.UpButFalling + case p if p >= 0.5 && p < 0.75 => Quadrant.DownAndFalling + case p if p >= 0.75 && p < 1.0 => Quadrant.DownButRising + case _ => throw new IllegalArgumentException("Position out of bounds") + } + } + } +} diff --git a/Task/Bitmap-B-zier-curves-Cubic/ALGOL-68/bitmap-b-zier-curves-cubic-2.alg b/Task/Bitmap-B-zier-curves-Cubic/ALGOL-68/bitmap-b-zier-curves-cubic-2.alg index e19cad1f9b..64efe22d15 100644 --- a/Task/Bitmap-B-zier-curves-Cubic/ALGOL-68/bitmap-b-zier-curves-cubic-2.alg +++ b/Task/Bitmap-B-zier-curves-Cubic/ALGOL-68/bitmap-b-zier-curves-cubic-2.alg @@ -1,12 +1,12 @@ #!/usr/bin/a68g --script # # -*- coding: utf-8 -*- # -PR READ "prelude/Bitmap.a68" PR; # c.f. [[rc:Bitmap]] # -PR READ "prelude/Bitmap/Bresenhams_line_algorithm.a68" PR; # c.f. [[rc:Bitmap/Bresenhams_line_algorithm]] # +PR READ "prelude/Bitmap.a68" PR; +PR READ "prelude/Bitmap/Bresenhams_line_algorithm.a68" PR; PR READ "prelude/Bitmap/Bezier_curves/Cubic.a68" PR; -# The following test # -test:( +### test program ### +( REF IMAGE x = INIT LOC[16,16]PIXEL; (fill OF class image)(x, (white OF class image)); (cubic bezier OF class image)(x, (16, 1), (1, 4), (3, 16), (15, 11), (black OF class image), EMPTY); diff --git a/Task/Bitmap-B-zier-curves-Quadratic/ALGOL-68/bitmap-b-zier-curves-quadratic.alg b/Task/Bitmap-B-zier-curves-Quadratic/ALGOL-68/bitmap-b-zier-curves-quadratic.alg new file mode 100644 index 0000000000..c06ba96d7a --- /dev/null +++ b/Task/Bitmap-B-zier-curves-Quadratic/ALGOL-68/bitmap-b-zier-curves-quadratic.alg @@ -0,0 +1,41 @@ +BEGIN # draw a quadratic curve using Bresenham's line algoritm # + + PR READ "prelude/Bitmap.a68" PR; + PR READ "prelude/Bitmap/Bresenhams_line_algorithm.a68" PR; + + PROC quadratic bezier = ( REF IMAGE bm, INT x1, y1, x2, y2, x3, y3, nseg, REAL scale )VOID: + BEGIN + INT prevx := 0, prevy := 0; + FOR i FROM 0 TO nseg DO + REAL t = i / nseg; + REAL t1 = 1 - t; + REAL a = t1 * t1; + REAL b = 2 * t * t1; + REAL c = t * t; + INT currx = ENTIER ( scale * ( a * x1 + b * x2 + c * x3 + 0.5 ) ); + INT curry = ENTIER ( scale * ( a * y1 + b * y2 + c * y3 + 0.5 ) ); + IF i > 0 THEN + ( line OF class image )( bm + , ( prevx, prevy ) + , ( currx, curry ) + , black OF class image + ) + FI; + prevx := currx; + prevy := curry + OD + END # quadratic bezier # ; + + BEGIN + REF IMAGE bm = INIT LOC[ 1 : 60, 1 : 40 ]PIXEL; + ( fill OF class image )( bm, white OF class image ); + quadratic bezier( bm, 10, 100, 250, 270, 150, 20, 20, 70 / 300 ); + # print in monochrome # + FOR y FROM 2 UPB bm BY -1 TO 2 LWB bm DO + FOR x FROM 1 LWB bm TO 1 UPB bm DO + print( ( IF PIXEL( bm[ x, y ] ) /= white OF class image THEN "##" ELSE " " FI ) ) + OD; + print( ( newline ) ) + OD + END +END diff --git a/Task/Bitmap-B-zier-curves-Quadratic/EasyLang/bitmap-b-zier-curves-quadratic.easy b/Task/Bitmap-B-zier-curves-Quadratic/EasyLang/bitmap-b-zier-curves-quadratic.easy new file mode 100644 index 0000000000..2edb8d1510 --- /dev/null +++ b/Task/Bitmap-B-zier-curves-Quadratic/EasyLang/bitmap-b-zier-curves-quadratic.easy @@ -0,0 +1,19 @@ +proc quadraticbezier x1 y1 x2 y2 x3 y3 nseg . . + for i = 0 to nseg + t = i / nseg + t1 = 1 - t + a = t1 * t1 + b = 2 * t * t1 + c = t * t + currx = a * x1 + b * x2 + c * x3 + 0.5 + curry = a * y1 + b * y2 + c * y3 + 0.5 + if i = 0 + move currx curry + else + line currx curry + . + . +. +linewidth 0.5 +clear +quadraticbezier 1 1 30 37 59 1 100 diff --git a/Task/Bitmap-B-zier-curves-Quadratic/M2000-Interpreter/bitmap-b-zier-curves-quadratic.m2000 b/Task/Bitmap-B-zier-curves-Quadratic/M2000-Interpreter/bitmap-b-zier-curves-quadratic.m2000 new file mode 100644 index 0000000000..a5b02611cc --- /dev/null +++ b/Task/Bitmap-B-zier-curves-Quadratic/M2000-Interpreter/bitmap-b-zier-curves-quadratic.m2000 @@ -0,0 +1,191 @@ +module bezier { + Function Bitmap { + def x as long, y as long, Import as boolean + If match("NN") then + Read x, y + else.if Match("N") Then + \\ is a file? + Read f as long + byte whitespace[0] + if not Eof(f) then + get #f, whitespace :P6$=chr$(whitespace[0]) + get #f, whitespace : P6$+=chr$(whitespace[0]) + boolean getW=true, getH=true, getV=true + long v + If p6$="P6" Then + do + get #f, whitespace + select case whitespace[0] + case 35 + {do get #f, whitespace + until whitespace[0]=10 + } + case 32, 9, 13, 10 + { if getW and x<>0 then + getW=false + else.if getH and y<>0 then + getH=false + else.if getV and v<>0 then + getV=false + end if + } + case 48 to 57 + {if getW then + x*=10 + x+=whitespace[0]-48 + else.if getH then + y*=10 + y+=whitespace[0]-48 + else.if getV then + v*=10 + v+=whitespace[0]-48 + end if + } + End Select + iF eof(f) then Error "Not a ppm file" + until getV=false + else + Error "Not a P6 ppm" + end if + Import=True + end if + else + Error "No proper arguments" + end if + if x<1 or y<1 then Error "Wrong dimensions" + structure rgb { + red as byte + green as byte + blue as byte + } + m=len(rgb)*x mod 4 + if m>0 then m=4-m ' add some bytes to raster line + m+=len(rgb) *x + Structure rasterline { + { + pad as byte*m + } + hline as rgb*x + } + Structure Raster { + magic as integer*4 + w as integer*4 + h as integer*4 + { + linesB as byte*len(rasterline)*y + } + lines as rasterline*y + } + Buffer Clear Image1 as Raster + Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) + if not Import then Return Image1, 0!lines:=String$(chrcode$(0xffff), Len(rasterline)*y div 2) + Buffer Clear Pad as Byte*4 + SetPixel=Lambda Image1, Pad, aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{ + where=alines+3*x+blines*y + if c>0 then c=color(c) + c-! + Return Pad, 0:=c as long + Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte + } + GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{ + where=alines+3*x+blines*y + =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte)) + } + StrDib$=Lambda$ Image1, Raster -> { + =Eval$(Image1, 0, Len(Raster)) + } + CopyImage=Lambda Image1 (image$) -> { + if left$(image$,12)=Eval$(Image1, 0, 24 ) Then { + Return Image1, 0:=Image$ + } Else Error "Can't Copy Image" + } + Export2File=Lambda Image1, x, y (f) -> { + Print #f, "P6";chr$(10);"# Created using M2000 Interpreter";chr$(10); + Print #f, x;" ";y;" 255";chr$(10); + x2=x-1 : where=0 + x0=x*3 + structure rgbP6 { + r as byte + g as byte + b as byte + } + buffer Pad as rgbP6*x*y + For y1=y-1 to 0 { + Return pad, x*y1:=eval$(image1, 0!linesB!where, x0) + where+=x0 + m=where mod 4 : if m<>0 then where+=4-m + } + For x1=0 to x*y-1 { + Push Eval(pad, x1!b) : Return pad, x1!b:=Eval(pad, x1!r), x1!r:=Number + } + Put #f, pad + } + if Import then { + x0=x-1 : where=0 + structure rgbP6 { + r as byte, g as byte, b as byte + } + buffer Pad1 as rgbP6*x*y + Get #f, Pad1 + For x1=0 to x*y-1 { + Push Eval(pad1, x1!b) : Return pad1, x1!b:=Eval(pad1, x1!r), x1!r:=Number + } + x1=x*3 + For y1=y-1 to 0 { + Return Image1, 0!linesB!where:=Eval$(Pad1, y1*x, x1) + where+=3*(x0+1) + m=where mod 4 : if m<>0 then where+=4-m + } + } + Group Bitmap { + type:Bitmap + SetPixel=SetPixel + GetPixel=GetPixel + Image$=StrDib$ + Copy=CopyImage + ToFile=Export2File + } + =Bitmap + } + module bezier (&ppm as Bitmap, x1, y1, x2, y2, x3, y3, n, col=0){ + Group point_ { + long x,y + } + Long i + Double t, t1, a, b, c, d + Dim p(n+1)=point_ + For i = 0 To n + t = i / n + t1 = 1 - t + a = t1 ^ 2 + b = t * t1 * 2 + c = t ^ 2 + p(i).x = Int(a * x1 + b * x2 + c * x3 + .5) + p(i).y = Int(a * y1 + b * y2 + c * y3 + .5) + Next + + For i = 0 To n -1 + Br_line(p(i).x, p(i).y, p(i +1).x, p(i +1).y, col) + Next + sub Br_line(x0 As Long, y0 As Long, x1 As Long, y1 As Long, Col=0) + Local Long dx = Abs(x1 - x0), dy = Abs(y1 - y0) + Local Long sx = If(x0 < x1-> 1, -1) + Local Long sy = If(y0 < y1-> 1, -1) + Local Long er = If(dx > dy-> dx, -dy) div 2, e2 + Do + Call ppm.SetPixel(x0, y0, Col) + If x0=x1 And y0=y1 Then Exit + e2 = er + If e2 > -dx Then Er -= dy : x0 += sx + If e2 < dy Then Er += dx : y0 += sy + Always + end sub + } + A=Bitmap(250, 250) + bezier &A, 10, 100, 220, 310, 150, 20, 20 + move 3000,3000 : image A.Image$() + Open "curve.ppm" for output as #f + Call A.tofile(f) + close #f +} +bezier diff --git a/Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm-1.alg b/Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm-1.alg deleted file mode 100644 index 71ca3c026d..0000000000 --- a/Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm-1.alg +++ /dev/null @@ -1,42 +0,0 @@ -# -*- coding: utf-8 -*- # - -line OF class image := (REF IMAGE picture, POINT start, stop, PIXEL color)VOID: -BEGIN - REAL dx = ABS (x OF stop - x OF start), - dy = ABS (y OF stop - y OF start); - REAL err; - POINT here := start, - step := (1, 1); - IF x OF start > x OF stop THEN - x OF step := -1 - FI; - IF y OF start > y OF stop THEN - y OF step := -1 - FI; - IF dx > dy THEN - err := dx / 2; - WHILE x OF here /= x OF stop DO - picture[x OF here, y OF here] := color; - err -:= dy; - IF err < 0 THEN - y OF here +:= y OF step; - err +:= dx - FI; - x OF here +:= x OF step - OD - ELSE - err := dy / 2; - WHILE y OF here /= y OF stop DO - picture[x OF here, y OF here] := color; - err -:= dx; - IF err < 0 THEN - x OF here +:= x OF step; - err +:= dy - FI; - y OF here +:= y OF step - OD - FI; - picture[x OF here, y OF here] := color # ensure dots to be drawn # -END # line #; - -SKIP diff --git a/Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm-2.alg b/Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm.alg similarity index 89% rename from Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm-2.alg rename to Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm.alg index d1ba6015a9..223c635fd0 100644 --- a/Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm-2.alg +++ b/Task/Bitmap-Bresenhams-line-algorithm/ALGOL-68/bitmap-bresenhams-line-algorithm.alg @@ -1,11 +1,11 @@ #!/usr/bin/a68g --script # # -*- coding: utf-8 -*- # -PR READ "prelude/Bitmap.a68" PR; # c.f. [[rc:Bitmap]] # +PR READ "prelude/Bitmap.a68" PR; PR READ "prelude/Bitmap/Bresenhams_line_algorithm.a68" PR; ### The test program: ### -test:( +( REF IMAGE x = INIT LOC[1:16, 1:16]PIXEL; (fill OF class image)(x, white OF class image); (line OF class image)(x, ( 1, 8), ( 8,16), black OF class image); diff --git a/Task/Bitmap-Bresenhams-line-algorithm/Arturo/bitmap-bresenhams-line-algorithm.arturo b/Task/Bitmap-Bresenhams-line-algorithm/Arturo/bitmap-bresenhams-line-algorithm.arturo new file mode 100644 index 0000000000..874b30a87e --- /dev/null +++ b/Task/Bitmap-Bresenhams-line-algorithm/Arturo/bitmap-bresenhams-line-algorithm.arturo @@ -0,0 +1,67 @@ +; Bitmap object definition +define :bitmap [ + init: method [width :integer height :integer][ + \width: width + \height: height + \grid: array.of:@[width height] false + ] + + setOn: method [x :integer y :integer][ + \grid\[y]\[x]: true + ] + + line: method [x0 :integer y0 :integer x1 :integer y1 :integer][ + [dx,dy]: @[abs x1 - x0, abs y1 - y0] + [x,y]: @[x0, y0] + sx: (x0 > x1) ? -> neg 1 -> 1 + sy: (y0 > y1) ? -> neg 1 -> 1 + + switch dx > dy [ + err: dx // 2 + while [x <> x1][ + \setOn x y + if negative? err: <= err - dy -> + [y, err]: @[y + sy, err + dx] + + x: x + sx + ] + ][ + err: dy // 2 + while [y <> y1][ + \setOn x y + if negative? err: <= err - dx -> + [x, err]: @[x + sx, err + dy] + y: y + sy + ] + ] + \setOn x y + ] + + string: method [][ + join.with:"\n" @[ + "+" ++ (repeat "-" \width) ++ "+" + join.with:"\n" map 0..dec \height 'y [ + "|" ++ (join.with:"" map 0..dec \width 'x -> + \grid\[dec \height-y]\[x] ? -> "@" -> " " + ) ++ "|" + ] + "+" ++ (repeat "-" \width) ++ "+" + ] + ] +] + +; Create bitmap +bitmap: to :bitmap @[17 17]! + +; and... draw a diamond shape +points: @[ + [1 8 8 16] + [8 16 16 8] + [16 8 8 1] + [8 1 1 8] +] + +loop points 'p -> + bitmap\line p\0 p\1 p\2 p\3 + +print bitmap diff --git a/Task/Bitmap-Bresenhams-line-algorithm/M2000-Interpreter/bitmap-bresenhams-line-algorithm.m2000 b/Task/Bitmap-Bresenhams-line-algorithm/M2000-Interpreter/bitmap-bresenhams-line-algorithm.m2000 new file mode 100644 index 0000000000..5ed0c0f987 --- /dev/null +++ b/Task/Bitmap-Bresenhams-line-algorithm/M2000-Interpreter/bitmap-bresenhams-line-algorithm.m2000 @@ -0,0 +1,20 @@ +' using Twips +' twipsX is 15 twips. So for 96 dpi, we have 1440/96=15 twips/pixel +Module Bresenham_s_line_algorithm { + Module Br_line(x0 As Long, y0 As Long, x1 As Long, y1 As Long, Col=15) { + Long dx = Abs(x1 - x0), dy = Abs(y1 - y0) + Long sx = If(x0 < x1-> TWIPSX, -TWIPSX) + Long sy = If(y0 < y1-> TWIPSY, -TWIPSY) + Long er = If(dx > dy-> dx, -dy) div 2, e2 + Do + PSet col, x0, y0 + If abs(x0-x1)<=TWIPSX And abs(y0-y1)<=TWIPSY Then Exit + e2 = er + If e2 > -dx Then Er -= dy : x0 += sx + If e2 < dy Then Er += dx : y0 += sy + Always + } + cls ,0 + Br_line scale.x*.2, scale.y*.2, scale.x*.8, scale.y*.8 , #FFbb77 +} +Bresenham_s_line_algorithm diff --git a/Task/Bitmap-Midpoint-circle-algorithm/ALGOL-68/bitmap-midpoint-circle-algorithm-2.alg b/Task/Bitmap-Midpoint-circle-algorithm/ALGOL-68/bitmap-midpoint-circle-algorithm-2.alg index e3b8b12235..f48de65ee9 100644 --- a/Task/Bitmap-Midpoint-circle-algorithm/ALGOL-68/bitmap-midpoint-circle-algorithm-2.alg +++ b/Task/Bitmap-Midpoint-circle-algorithm/ALGOL-68/bitmap-midpoint-circle-algorithm-2.alg @@ -1,13 +1,12 @@ #!/usr/bin/a68g --script # # -*- coding: utf-8 -*- # -PR READ "prelude/Bitmap.a68" PR; # c.f. [[rc:Bitmap]] # -PR READ "prelude/Bitmap/Bresenhams_line_algorithm.a68" PR; # c.f. [[rc:Bitmap/Bresenhams_line_algorithm]] # +PR READ "prelude/Bitmap.a68" PR; +PR READ "prelude/Bitmap/Bresenhams_line_algorithm.a68" PR; PR READ "prelude/Bitmap/Midpoint_circle_algorithm.a68" PR; # The following illustrates use: # - -test:( +( REF IMAGE x = INIT LOC [1:16, 1:16] PIXEL; (fill OF class image)(x, (white OF class image)); (circle OF class image)(x, (8, 8), 5, (black OF class image)); diff --git a/Task/Bitmap-PPM-conversion-through-a-pipe/FreeBASIC/bitmap-ppm-conversion-through-a-pipe.basic b/Task/Bitmap-PPM-conversion-through-a-pipe/FreeBASIC/bitmap-ppm-conversion-through-a-pipe.basic new file mode 100644 index 0000000000..5633823dd7 --- /dev/null +++ b/Task/Bitmap-PPM-conversion-through-a-pipe/FreeBASIC/bitmap-ppm-conversion-through-a-pipe.basic @@ -0,0 +1,64 @@ +Const ancho = 400 +Const alto = 300 +Dim As Integer i, x, y +Dim As Ulong kolor + +' Set up graphics +Screenres ancho, alto, 32 +Windowtitle "Pattern Generator" + +' A little extravagant, this draws a design of dots and lines +' Fill background with color Rgb(&h40, &h80, &hc0) +Line (0, 0)-(ancho-1, alto-1), Rgb(64, 128, 192), BF + +' Draw random dots Rgb(&h20, &h40, &h80) +For i = 1 To 2000 + Pset (Rnd * (ancho-1), Rnd * (alto-1)), Rgb(32, 64, 128) +Next + +' Draw horizontal lines +For x = 0 To ancho-1 + For y = 240 To 244 + Pset (x, y), Rgb(32, 64, 128) + Next + For y = 260 To 264 + Pset (x, y), Rgb(32, 64, 128) + Next +Next + +' Draw vertical lines +For y = 0 To alto-1 + For x = 80 To 84 + Pset (x, y), Rgb(32, 64, 128) + Next + For x = 95 To 99 + Pset (x, y), Rgb(32, 64, 128) + Next +Next + +' Open PPM file to write +Dim As Integer ff = Freefile +Open "noutput.ppm" For Binary As #ff +If Err > 0 Then Print "Error opening output file": End + +' Write PPM header +Put #ff, , "P6" & Chr(10) +Put #ff, , Str(ancho) & " " & Str(alto) & Chr(10) +Put #ff, , "255" & Chr(10) + +' Write pixel data +For y = 0 To alto - 1 + For x = 0 To ancho - 1 + kolor = Point(x, y) + Put #ff, , Cbyte(kolor Shr 16) ' Blue + Put #ff, , Cbyte(kolor Shr 8) ' Green + Put #ff, , Cbyte(kolor) ' Red + Next +Next + +Close #ff + +' Convert to JPG using ImageMagick (pipe logic) +Shell "magick.exe noutput.ppm noutput.jpg" + +Sleep diff --git a/Task/Bitmap-Read-an-image-through-a-pipe/FreeBASIC/bitmap-read-an-image-through-a-pipe.basic b/Task/Bitmap-Read-an-image-through-a-pipe/FreeBASIC/bitmap-read-an-image-through-a-pipe.basic new file mode 100644 index 0000000000..532b629312 --- /dev/null +++ b/Task/Bitmap-Read-an-image-through-a-pipe/FreeBASIC/bitmap-read-an-image-through-a-pipe.basic @@ -0,0 +1,65 @@ +Type IMAGE + w As Integer + h As Integer + bpp As Integer + dato(Any) As Ubyte +End Type + +Function readImageFile(filename As String, img As IMAGE) As Boolean + ' First convert image to PPM using temp file + Dim As String cmd = "magick.exe " & filename & " temp.ppm" + Shell(cmd) + + Dim As Integer ff = Freefile + Open "temp.ppm" For Binary As #ff + + ' Read PPM header + Dim As String linea + Line Input #ff, linea ' P6 + If Left(linea, 2) <> "P6" Then Return True + + ' Skip comments + Do + Line Input #ff, linea + If Left(linea, 1) <> "#" Then Exit Do + Loop + + img.w = Val(Left(linea, Instr(linea, " "))) + img.h = Val(Mid(linea, Instr(linea, " "))) + + ' Allocate memory for image data + Redim img.dato(img.w * img.h * 3 - 1) + + ' Read binary pixel data + Get #ff, , img.dato() + + Close #ff + Kill("temp.ppm") ' Clean up temp file + Return False +End Function + +Function writePPM(filename As String, img As IMAGE) As Boolean + Dim As Integer ff = Freefile + Open filename For Binary As #ff + + ' Write PPM header + Put #ff, , "P6" & Chr(10) + Put #ff, , Str(img.w) & " " & Str(img.h) & Chr(10) + Put #ff, , "255" & Chr(10) + + ' Write image data + For i As Integer = 0 To (img.w * img.h * 3 - 1) Step 3 + Put #ff, , img.dato(i + 1) ' Green + Put #ff, , img.dato(i + 2) ' Blue + Put #ff, , img.dato(i) ' Red + Next + + Close #ff + Return False +End Function + +' Main program +Dim As IMAGE img + +If readImageFile("example.png", img) Then Print "Error reading input file" +If writePPM("output.ppm", img) Then Print "i:\Error writing PPM file" diff --git a/Task/Bitmap-Write-a-PPM-file/FreeBASIC/bitmap-write-a-ppm-file.basic b/Task/Bitmap-Write-a-PPM-file/FreeBASIC/bitmap-write-a-ppm-file.basic index a955daa425..d658dc3b0d 100644 --- a/Task/Bitmap-Write-a-PPM-file/FreeBASIC/bitmap-write-a-ppm-file.basic +++ b/Task/Bitmap-Write-a-PPM-file/FreeBASIC/bitmap-write-a-ppm-file.basic @@ -1,7 +1,8 @@ -Dim As Integer ancho = 150, alto = 200 +Dim As Integer ancho, alto +ancho = 150: alto = 200 Dim As Integer x, y ' width, height -Dim As Ubyte kolor -Screenres ancho,alto,32 +Dim As Ulong kolor +Screenres ancho, alto, 32 ' Draw circles Screenlock @@ -10,24 +11,26 @@ Circle (75, 100), 35, Rgb(0, 255, 0),,,, F Circle (75, 100), 20, Rgb(0, 0, 255),,,, F Screenunlock -' Create PPM file header -Dim encabezado As String -encabezado = "P6" & Chr(10) & Str(ancho) & " " & Str(alto) & Chr(10) & "255" & Chr(10) - ' Open PPM file to write Dim As Integer ff = Freefile -Open "i:\example.PPM" For Binary As #ff -Put #ff, , encabezado +Open "example.ppm" For Binary As #ff +If Err > 0 Then Print "Error opening output file": End + +' Create PPM file header +Print #ff, "P6" +Print #ff, "# Created using FreeBASIC" +Print #ff, ancho & " " & alto +Print #ff, "255" ' Write image data to PPM file For y = 0 To alto - 1 For x = 0 To ancho - 1 kolor = Point(x, y) - Put #ff, , Chr( kolor And &HFF) ' Red - Put #ff, , Chr((kolor Shr 8) And &HFF) ' Green - Put #ff, , Chr((kolor Shr 16) And &HFF) ' Blue - Next x -Next y + Put #ff, , Cbyte(kolor Shr 8) ' Green + Put #ff, , Cbyte(kolor) ' Blue + Put #ff, , Cbyte(kolor Shr 16) ' Red + Next +Next Close #ff diff --git a/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-1.m2000 b/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-1.m2000 index c2892cc958..b3c4b9607b 100644 --- a/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-1.m2000 +++ b/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-1.m2000 @@ -50,26 +50,28 @@ Module Checkit { Return Image1, 0:=Image$ } Else Error "Can't Copy Image" } - Export2File=Lambda Image1, x, y (f) -> { + Export2File=Lambda Image1, x, y, r=len(rasterline) (f) -> { \\ use this between open and close Print #f, "P3" Print #f,"# Created using M2000 Interpreter" Print #f, x;" ";y Print #f, 255 x2=x-1 - where=24 - For y1= 0 to y-1 { + For y1= y-1 to 0 { a$="" - For x1=0 to x2 { - Print #f, a$;Eval(Image1, where +2 as byte);" "; + where=24+r*y1 + x1=0 + Print #f, Eval(Image1, where +2 as byte);" "; + Print #f, Eval(Image1, where+1 as byte);" "; + Print #f, Eval(Image1, where as byte); + where+=3 + For x1=1 to x2 { + Print #f, " ";Eval(Image1, where +2 as byte);" "; Print #f, Eval(Image1, where+1 as byte);" "; Print #f, Eval(Image1, where as byte); where+=3 - a$=" " } Print #f - m=where mod 4 - if m<>0 then where+=4-m } } Group Bitmap { @@ -81,31 +83,10 @@ Module Checkit { } =Bitmap } - A=Bitmap(10, 10) Call A.SetPixel(5,5, color(128,0,255)) Open "A2.PPM" for Output as #F Call A.ToFile(F) Close #f - ' is the same as this one - Try { - Open "A.PPM" for Output as #F - Print #f, "P3" - Print #f,"# Created using M2000 Interpreter" - Print #f, 10;" ";10 - Print #f, 255 - For y=10-1 to 0 { - a$="" - For x=0 to 10-1 { - rgb=-A.GetPixel(x, y) - Print #f, a$;Binary.And(rgb, 0xFF); " "; - Print #f, Binary.And(Binary.Shift(rgb, -8), 0xFF); " "; - Print #f, Binary.Shift(rgb, -16); - a$=" " - } - Print #f - } - Close #f - } } Checkit diff --git a/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-2.m2000 b/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-2.m2000 index f65d2af1b7..0cc430b1ff 100644 --- a/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-2.m2000 +++ b/Task/Bitmap-Write-a-PPM-file/M2000-Interpreter/bitmap-write-a-ppm-file-2.m2000 @@ -1,177 +1,180 @@ -Module PPMbinaryP6 { - If Version<9.4 then 1000 - If Version=9.4 Then if Revision<19 then 1000 - Module Checkit { - Function Bitmap { - def x as long, y as long - If match("NN") then { - Read x, y - } else.if Match("N") Then { - E$="Not a ppm file" - Read f as long - buffer whitespace as byte - if not Eof(f) then { - get #f, whitespace : iF eof(f) then Error E$ - P6$=eval$(whitespace) - get #f, whitespace : iF eof(f) then Error E$ - P6$+=eval$(whitespace) - def boolean getW=true, getH=true, getV=true - def long v - \\ str$("P6") has 2 bytes. "P6" has 4 bytes - If p6$=str$("P6") Then { - do { - get #f, whitespace - if Eval$(whitespace)=str$("#") then { - do { - iF eof(f) then Error E$ - get #f, whitespace - } until eval(whitespace)=10 - } else { - select case eval(whitespace) - case 32, 9, 13, 10 - { - if getW and x<>0 then { - getW=false - } else.if getH and y<>0 then { - getH=false - } else.if getV and v<>0 then { - getV=false - } - } - case 48 to 57 - { - if getW then { - x*=10 - x+=eval(whitespace, 0)-48 - } else.if getH then { - y*=10 - y+=eval(whitespace, 0)-48 - } else.if getV then { - v*=10 - v+=eval(whitespace, 0)-48 - } - } - End Select - } - iF eof(f) then Error E$ - } until getV=false - } else Error "Not a P6 ppm" - } - } else Error "No proper arguments" - if x<1 or y<1 then Error "Wrong dimensions" - structure rgb { - red as byte - green as byte - blue as byte - } - m=len(rgb)*x mod 4 - if m>0 then m=4-m ' add some bytes to raster line - m+=len(rgb) *x - Structure rasterline { - { - pad as byte*m - } - \\ union pad+hline - hline as rgb*x - } - \\ we use union linesB and lines - \\ so we can address linesb as bytes - Structure Raster { - magic as integer*4 - w as integer*4 - h as integer*4 - { - linesB as byte*len(rasterline)*y - } - lines as rasterline*y - } - Buffer Clear Image1 as Raster - \\ 24 chars as header to be used from bitmap render build in functions - Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) - \\ fill white (all 255) - \\ Str$(string) convert to ascii, so we get all characters from words width to byte width - if not valid(f) then Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y)) - Buffer Clear Pad as Byte*4 - SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{ - where=alines+3*x+blines*y - if c>0 then c=color(c) - c-! - Return Pad, 0:=c as long - Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte - } - GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{ - where=alines+3*x+blines*y - =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte)) - } - StrDib$=Lambda$ Image1, Raster -> { - =Eval$(Image1, 0, Len(Raster)) - } - CopyImage=Lambda Image1 (image$) -> { - if left$(image$,12)=Eval$(Image1, 0, 24 ) Then { - Return Image1, 0:=Image$ - } Else Error "Can't Copy Image" - } - Export2File=Lambda Image1, x, y (f) -> { - \\ use this between open and close - Print #f, "P6";chr$(10); - Print #f,"# Created using M2000 Interpreter";chr$(10); - Print #f, x;" ";y;" 255";chr$(10); - x2=x-1 - where=0 - Buffer pad as byte*3 - For y1= 0 to y-1 { - For x1=0 to x2 { - \\ use linesB which is array of bytes - Return pad, 0:=eval$(image1, 0!linesB!where, 3) - Push Eval(pad, 2) - Return pad, 2:=Eval(pad, 0), 0:=Number - Put #f, pad - where+=3 - } - m=where mod 4 - if m<>0 then where+=4-m - } - } - if valid(F) then { - x0=x-1 - where=0 - Buffer Pad1 as byte*3 - For y1=y-1 to 0 { - For x1=0 to x0 { - Get #f, Pad1 ' Read binary - \\ reverse rgb - Push Eval(pad1, 2) - Return pad1, 2:=Eval(pad1, 0), 0:=Number - Return Image1, 0!linesB!where:=Eval$(Pad1) - where+=3 +Module P6 { + Function Bitmap { + def x as long, y as long, Import as boolean + If match("NN") then + Read x, y + else.if Match("N") Then + \\ is a file? + Read f as long + byte whitespace[0] + if not Eof(f) then + get #f, whitespace :P6$=chr$(whitespace[0]) + get #f, whitespace : P6$+=chr$(whitespace[0]) + boolean getW=true, getH=true, getV=true + long v + If p6$="P6" Then + do + get #f, whitespace + select case whitespace[0] + case 35 + {do get #f, whitespace + until whitespace[0]=10 } - m=where mod 4 - if m<>0 then where+=4-m - } - } - Group Bitmap { - SetPixel=SetPixel - GetPixel=GetPixel - Image$=StrDib$ - Copy=CopyImage - ToFile=Export2File - } - =Bitmap + case 32, 9, 13, 10 + { if getW and x<>0 then + getW=false + else.if getH and y<>0 then + getH=false + else.if getV and v<>0 then + getV=false + end if + } + case 48 to 57 + {if getW then + x*=10 + x+=whitespace[0]-48 + else.if getH then + y*=10 + y+=whitespace[0]-48 + else.if getV then + v*=10 + v+=whitespace[0]-48 + end if + } + End Select + iF eof(f) then Error "Not a ppm file" + until getV=false + else + Error "Not a P6 ppm" + end if + Import=True + end if + else + Error "No proper arguments" + end if + if x<1 or y<1 then Error "Wrong dimensions" + structure rgb { + red as byte + green as byte + blue as byte } - A=Bitmap(10, 10) - Call A.SetPixel(5,5, color(128,0,255)) - Open "A.PPM" for Output as #F - Call A.ToFile(F) - Close #f - - Print "Saved" - Open "A.PPM" for Input as #F - C=Bitmap(f) - Copy 400*twipsx,200*twipsy use C.Image$() - Close #f - } - Checkit - End - 1000 Error "Need Version 9.4, Revision 19 or higher" + m=len(rgb)*x mod 4 + if m>0 then m=4-m ' add some bytes to raster line + m+=len(rgb) *x + Structure rasterline { + { + pad as byte*m + } + hline as rgb*x + } + Structure Raster { + magic as integer*4 + w as integer*4 + h as integer*4 + { + linesB as byte*len(rasterline)*y + } + lines as rasterline*y + } + Buffer Clear Image1 as Raster + Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) + if not Import then Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y)) + Buffer Clear Pad as Byte*4 + SetPixel=Lambda Image1, Pad, aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{ + where=alines+3*x+blines*y + if c>0 then c=color(c) + c-! + Return Pad, 0:=c as long + Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte + } + GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{ + where=alines+3*x+blines*y + =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte)) + } + StrDib$=Lambda$ Image1, Raster -> { + =Eval$(Image1, 0, Len(Raster)) + } + CopyImage=Lambda Image1 (image$) -> { + if left$(image$,12)=Eval$(Image1, 0, 24 ) Then { + Return Image1, 0:=Image$ + } Else Error "Can't Copy Image" + } + Export2File=Lambda Image1, x, y (f) -> { + Print #f, "P6";chr$(10);"# Created using M2000 Interpreter";chr$(10); + Print #f, x;" ";y;" 255";chr$(10); + x2=x-1 : where=0 + x0=x*3 + structure rgbP6 { + r as byte + g as byte + b as byte + } + buffer Pad as rgbP6*x*y + For y1=y-1 to 0 { + Return pad, x*y1:=eval$(image1, 0!linesB!where, x0) + where+=x0 + m=where mod 4 : if m<>0 then where+=4-m + } + For x1=0 to x*y-1 { + Push Eval(pad, x1!b) : Return pad, x1!b:=Eval(pad, x1!r), x1!r:=Number + } + Put #f, pad + } + if Import then { + x0=x-1 : where=0 + structure rgbP6 { + r as byte + g as byte + b as byte + } + buffer Pad1 as rgbP6*x*y + Get #f, Pad1 + For x1=0 to x*y-1 { + Push Eval(pad1, x1!b) : Return pad1, x1!b:=Eval(pad1, x1!r), x1!r:=Number + } + x1=x*3 + For y1=y-1 to 0 { + Return Image1, 0!linesB!where:=Eval$(Pad1, y1*x, x1) + where+=3*(x0+1) + m=where mod 4 : if m<>0 then where+=4-m + } + } + Group Bitmap { + SetPixel=SetPixel + GetPixel=GetPixel + Image$=StrDib$ + Copy=CopyImage + ToFile=Export2File + } + =Bitmap + } + A=Bitmap(150,100) + For i=0 to 98 { + Call A.SetPixel(i, i, 0) + Call A.SetPixel(99, i, 0) + } + Call A.SetPixel(i,i,0) + Copy 200*twipsx, 100*twipsy use A.Image$() + Profiler + Open "a.ppm" for output as #F + Call A.tofile(f) + Close #f + Print Filelen("a.ppm") + Print Timecount/1000;"sec" + Profiler + exit + Image A.Image$() Export "a.jpg", 100 ' per cent quality + Print Filelen("a.jpg") + Image A.Image$() Export "a1.jpg", 10 ' per cent quality + Print Filelen("a1.jpg") + Image A.Image$() Export "a.bmp" + Print Filelen("a.bmp") ' no compression + Print Timecount/1000;"sec" + Move 5000,5000 ' twips + Image "a.jpg" + Move 5000,8000 + Image "a1.jpg" + Move 8000, 5000 + Image "a.bmp" } -PPMbinaryP6 +p6 diff --git a/Task/Bitmap/ALGOL-68/bitmap-1.alg b/Task/Bitmap/ALGOL-68/bitmap-1.alg deleted file mode 100644 index 896165161a..0000000000 --- a/Task/Bitmap/ALGOL-68/bitmap-1.alg +++ /dev/null @@ -1,48 +0,0 @@ -# -*- coding: utf-8 -*- # - -MODE PIXEL = STRUCT(#SHORT# BITS red,green,blue); -MODE POINT = STRUCT(INT x,y); - -MODE IMAGE = [0,0]PIXEL; # instance attributes # - -MODE CLASSIMAGE = STRUCT ( # class attributes # - PIXEL black, red, green, blue, white, - PROC (REF IMAGE)REF IMAGE init, - PROC (REF IMAGE, PIXEL)VOID fill, - PROC (REF IMAGE)VOID print, -# virtual: # - REF PROC (REF IMAGE, POINT, POINT, PIXEL)VOID line, - REF PROC (REF IMAGE, POINT, INT, PIXEL)VOID circle, - REF PROC (REF IMAGE, POINT, POINT, POINT, POINT, PIXEL, UNION(INT, VOID))VOID cubic bezier -); - -CLASSIMAGE class image = ( - # black = # (#SHORTEN# 16r00, #SHORTEN# 16r00, #SHORTEN# 16r00), - # red = # (#SHORTEN# 16rff, #SHORTEN# 16r00, #SHORTEN# 16r00), - # green = # (#SHORTEN# 16r00, #SHORTEN# 16rff, #SHORTEN# 16r00), - # blue = # (#SHORTEN# 16r00, #SHORTEN# 16r00, #SHORTEN# 16rff), - # white = # (#SHORTEN# 16rff, #SHORTEN# 16rff, #SHORTEN# 16rff), - # PROC init = # (REF IMAGE self)REF IMAGE: - BEGIN - (fill OF class image)(self, black OF class image); - self - END, - - # PROC fill = # (REF IMAGE self, PIXEL color)VOID: - FOR x FROM 1 LWB self TO 1 UPB self DO - FOR y FROM 2 LWB self TO 2 UPB self DO - self[x,y] := color - OD - OD, - # PROC print = # (REF IMAGE self)VOID: - printf(($n(UPB self)(3(16r2d))l$, self)), -# virtual: # - # REF PROC line = # LOC PROC (REF IMAGE, POINT, POINT, PIXEL)VOID, - # REF PROC circle = # LOC PROC (REF IMAGE, POINT, INT, PIXEL)VOID, - # REF PROC cubic bezier = # LOC PROC (REF IMAGE, POINT, POINT, POINT, POINT, PIXEL, UNION(INT, VOID))VOID -); - -OP CLASSOF = (IMAGE image)CLASSIMAGE: class image; -OP INIT = (REF IMAGE image)REF IMAGE: (init OF (CLASSOF image))(image); - -SKIP diff --git a/Task/Bitmap/ALGOL-68/bitmap-2.alg b/Task/Bitmap/ALGOL-68/bitmap.alg similarity index 100% rename from Task/Bitmap/ALGOL-68/bitmap-2.alg rename to Task/Bitmap/ALGOL-68/bitmap.alg diff --git a/Task/Bitmap/M2000-Interpreter/bitmap-1.m2000 b/Task/Bitmap/M2000-Interpreter/bitmap-1.m2000 index 905292d6cb..ebd64b552a 100644 --- a/Task/Bitmap/M2000-Interpreter/bitmap-1.m2000 +++ b/Task/Bitmap/M2000-Interpreter/bitmap-1.m2000 @@ -1,72 +1,102 @@ -\ Bitmap width in pixels, height in pixels -\ Return a group object with some lambda as members: SetPixel, GetPixel, Image$ -\ copyimage -\ using Copy x, y Use Image$ we can display image$ to x, y as twips -\ we can use x*twipsx, y*twipsy for x,y as pixels -Function Bitmap (x as long, y as long) { - if x<1 or y<1 then Error "Wrong dimensions" - structure rgb { - red as byte - green as byte - blue as byte - } - m=len(rgb)*x mod 4 - if m>0 then m=4-m ' add some bytes to raster line - m+=len(rgb) *x - Structure rasterline { - { - pad as byte*m +Module Checkit { + Function Bitmap (x as long, y as long) { + if x<1 or y<1 then Error "Wrong dimensions" + structure rgb { + red as byte + green as byte + blue as byte + } + m=len(rgb)*x mod 4 + if m>0 then m=4-m ' add some bytes to raster line + m+=len(rgb) *x + Structure rasterline { + { + pad as byte*m + } + \\ union pad+hline + hline as rgb*x } - \\ union pad+hline - hline as rgb*x - } - Structure Raster { - magic as integer*4 - w as integer*4 - h as integer*4 - lines as rasterline*y - } - Buffer Clear Image1 as Raster - \\ 24 chars as header to be used from bitmap render build in functions - Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) - \\ fill white (all 255) - \\ Str$(string) convert to ascii, so we get all characters from words width to byte width - Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y)) - Buffer Clear Pad as Byte*4 - SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{ - where=alines+3*x+blines*y - if c>0 then c=color(c) - c-! - Return Pad, 0:=c as long - Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte + Structure Raster { + magic as integer*4 + w as integer*4 + h as integer*4 + lines as rasterline*y + } + Buffer Clear Image1 as Raster + \\ 24 chars as header to be used from bitmap render build in functions + Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) + \\ fill white (all 255) + \\ Str$(string) convert to ascii, so we get all characters from words width to byte width + Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y)) + Buffer Clear Pad as Byte*4 + SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{ + where=alines+3*x+blines*y + if c>0 then c=color(c) + c-! + Return Pad, 0:=c as long + Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte + } + GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{ + where=alines+3*x+blines*y + =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte)) + } + StrDib$=Lambda$ Image1, Raster -> { + =Eval$(Image1, 0, Len(Raster)) + } + CopyImage=Lambda Image1 (image$) -> { + if left$(image$,12)=Eval$(Image1, 0, 24 ) Then { + Return Image1, 0:=Image$ + } Else Error "Can't Copy Image" + } + Export2File=Lambda Image1, x, y, r=len(rasterline) (f) -> { + \\ use this between open and close + Print #f, "P3" + Print #f,"# Created using M2000 Interpreter" + Print #f, x;" ";y + Print #f, 255 + x2=x-1 + For y1= y-1 to 0 { + a$="" + where=24+r*y1 + x1=0 + Print #f, Eval(Image1, where +2 as byte);" "; + Print #f, Eval(Image1, where+1 as byte);" "; + Print #f, Eval(Image1, where as byte); + where+=3 + For x1=1 to x2 { + Print #f, " ";Eval(Image1, where +2 as byte);" "; + Print #f, Eval(Image1, where+1 as byte);" "; + Print #f, Eval(Image1, where as byte); + where+=3 + } + Print #f + } + } + Group Bitmap { + SetPixel=SetPixel + GetPixel=GetPixel + Image$=StrDib$ + Copy=CopyImage + ToFile=Export2File + } + =Bitmap } - GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{ - where=alines+3*x+blines*y - =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte)) + A=Bitmap(150,100) + For i=0 to 98 { + Call A.SetPixel(i, i, 5) + Call A.SetPixel(99, i, color(128,0,255)) } - StrDib$=Lambda$ Image1, Raster -> { - =Eval$(Image1, 0, Len(Raster)) - } - CopyImage=Lambda Image1 (image$) -> { - if left$(image$,12)=Eval$(Image1, 0, 24 ) Then { - Return Image1, 0:=Image$ - } Else Error "Can't Copy Image" - } - Group Bitmap { - SetPixel=SetPixel - GetPixel=GetPixel - Image$=StrDib$ - Copy=CopyImage - } - =Bitmap + Call A.SetPixel(i,i,0) + Call A.SetPixel(30,50, color(128,0,255)) + Print A.GetPixel(30,50)=color(128,0,255) + move 3000, 3000 + Image A.image$() + profiler + Open "A2.PPM" for Output as #F + Call A.ToFile(F) + Close #f + print timecount } -A=Bitmap(100,100) -Call A.SetPixel(50,50, color(128,0,255)) -Print A.GetPixel(50,50)=color(128,0,255) -\\ display image to screen at 100, 50 pixel -copy 100*twipsx,50*twipsy use A.Image$() -A1=Bitmap(100,100) -Call A1.copy(A.Image$()) -copy 500*twipsx,50*twipsy use A1.Image$() +Checkit diff --git a/Task/Bitmap/M2000-Interpreter/bitmap-2.m2000 b/Task/Bitmap/M2000-Interpreter/bitmap-2.m2000 index 562ea41c5b..bae307643e 100644 --- a/Task/Bitmap/M2000-Interpreter/bitmap-2.m2000 +++ b/Task/Bitmap/M2000-Interpreter/bitmap-2.m2000 @@ -1,55 +1,57 @@ Module P6 { Function Bitmap { def x as long, y as long, Import as boolean - - If match("NN") then { + If match("NN") then Read x, y - } else.if Match("N") Then { + else.if Match("N") Then \\ is a file? Read f as long - buffer whitespace as byte - if not Eof(f) then { - get #f, whitespace :P6$=eval$(whitespace) - get #f, whitespace : P6$+=eval$(whitespace) - def boolean getW=true, getH=true, getV=true - def long v - \\ str$("P6") has 2 bytes. "P6" has 4 bytes - If p6$=str$("P6") Then { - do { + byte whitespace[0] + if not Eof(f) then + get #f, whitespace :P6$=chr$(whitespace[0]) + get #f, whitespace : P6$+=chr$(whitespace[0]) + boolean getW=true, getH=true, getV=true + long v + If p6$="P6" Then + do get #f, whitespace - if Eval$(whitespace)=str$("#") then { - do {get #f, whitespace} until eval(whitespace)=10 - } else { - select case eval(whitespace) - case 32, 9, 13, 10 - { if getW and x<>0 then { - getW=false - } else.if getH and y<>0 then { - getH=false - } else.if getV and v<>0 then { - getV=false - } - } - case 48 to 57 - {if getW then { - x*=10 - x+=eval(whitespace, 0)-48 - } else.if getH then { - y*=10 - y+=eval(whitespace, 0)-48 - } else.if getV then { - v*=10 - v+=eval(whitespace, 0)-48 - } - } - End Select + select case whitespace[0] + case 35 + {do get #f, whitespace + until whitespace[0]=10 } + case 32, 9, 13, 10 + { if getW and x<>0 then + getW=false + else.if getH and y<>0 then + getH=false + else.if getV and v<>0 then + getV=false + end if + } + case 48 to 57 + {if getW then + x*=10 + x+=whitespace[0]-48 + else.if getH then + y*=10 + y+=whitespace[0]-48 + else.if getV then + v*=10 + v+=whitespace[0]-48 + end if + } + End Select iF eof(f) then Error "Not a ppm file" - } until getV=false - } else Error "Not a P6 ppm" + until getV=false + else + Error "Not a P6 ppm" + end if Import=True - } - } else Error "No proper arguments" + end if + else + Error "No proper arguments" + end if if x<1 or y<1 then Error "Wrong dimensions" structure rgb { red as byte @@ -78,7 +80,7 @@ Module P6 { Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) if not Import then Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y)) Buffer Clear Pad as Byte*4 - SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{ + SetPixel=Lambda Image1, Pad, aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{ where=alines+3*x+blines*y if c>0 then c=color(c) c-! @@ -101,23 +103,41 @@ Module P6 { Print #f, "P6";chr$(10);"# Created using M2000 Interpreter";chr$(10); Print #f, x;" ";y;" 255";chr$(10); x2=x-1 : where=0 - Buffer pad as byte*3 - For y1= 0 to y-1 { - For x1=0 to x2 { - Return pad, 0:=eval$(image1, 0!linesB!where, 3) - Push Eval(pad, 2) : Return pad, 2:=Eval(pad, 0), 0:=Number - Put #f, pad : where+=3 - } + x0=x*3 + structure rgbP6 { + r as byte + g as byte + b as byte + } + buffer Pad as rgbP6*x*y + For y1=y-1 to 0 { + Return pad, x*y1:=eval$(image1, 0!linesB!where, x0) + where+=x0 m=where mod 4 : if m<>0 then where+=4-m } + For x1=0 to x*y-1 { + Push Eval(pad, x1!b) : Return pad, x1!b:=Eval(pad, x1!r), x1!r:=Number + } + Put #f, pad } if Import then { - x0=x-1 : where=0 - Buffer Pad1 as byte*3 - For y1=y-1 to 0 { - For x1=0 to x0 {Get #f, Pad1 : Push Eval(pad1, 2) : Return pad1, 2:=Eval(pad1, 0), 0:=Number - Return Image1, 0!linesB!where:=Eval$(Pad1) : where+=3} - m=where mod 4 : if m<>0 then where+=4-m} + x0=x-1 : where=0 + structure rgbP6 { + r as byte + g as byte + b as byte + } + buffer Pad1 as rgbP6*x*y + Get #f, Pad1 + For x1=0 to x*y-1 { + Push Eval(pad1, x1!b) : Return pad1, x1!b:=Eval(pad1, x1!r), x1!r:=Number + } + x1=x*3 + For y1=y-1 to 0 { + Return Image1, 0!linesB!where:=Eval$(Pad1, y1*x, x1) + where+=3*(x0+1) + m=where mod 4 : if m<>0 then where+=4-m + } } Group Bitmap { SetPixel=SetPixel diff --git a/Task/Bitwise-IO/Seed7/bitwise-io.seed7 b/Task/Bitwise-IO/Seed7/bitwise-io.seed7 index a5764cfc78..413c230ed9 100644 --- a/Task/Bitwise-IO/Seed7/bitwise-io.seed7 +++ b/Task/Bitwise-IO/Seed7/bitwise-io.seed7 @@ -1,14 +1,7 @@ $ include "seed7_05.s7i"; include "bitdata.s7i"; - include "strifile.s7i"; -const proc: initWriteAscii (inout file: outFile, inout integer: bitPos) is func - begin - outFile.bufferChar := '\0;'; - bitPos := 0; - end func; - -const proc: writeAscii (inout file: outFile, inout integer: bitPos, in string: ascii) is func +const proc: writeAscii (inout msbOutBitStream: outStream, in string: ascii) is func local var char: ch is ' '; begin @@ -16,42 +9,38 @@ const proc: writeAscii (inout file: outFile, inout integer: bitPos, in string: a if ch > '\127;' then raise RANGE_ERROR; else - putBitsMsb(outFile, bitPos, ord(ch), 7); + putBits(outStream, ord(ch), 7); end if; end for; end func; -const proc: finishWriteAscii (inout file: outFile, inout integer: bitPos) is func +const proc: finishWriteAscii (inout msbOutBitStream: outStream) is func begin - putBitsMsb(outFile, bitPos, 0, 7); # Write a terminating NUL char. - write(outFile, chr(ord(outFile.bufferChar))); + putBits(outStream, 0, 7); # Write a terminating NUL char. + flush(outStream); end func; -const func string: readAscii (inout msbBitStream: aBitStream) is func +const func string: readAscii (inout msbInBitStream: inStream) is func result var string: stri is ""; local var char: ch is ' '; begin - while ch <> '\0;' do - ch := chr(getBits(aBitStream, 7)); + repeat + ch := chr(getBits(inStream, 7)); if ch <> '\0;' then stri &:= ch; end if; - end while; + until ch = '\0;'; end func; const proc: main is func local - var file: aFile is STD_NULL; - var integer: bitPos is 0; - var msbBitStream: aBitStream is msbBitStream.value; + var msbOutBitStream: outStream is msbOutBitStream.value; + var msbInBitStream: inStream is msbInBitStream.value; begin - aFile := openStriFile; - initWriteAscii(aFile, bitPos); - writeAscii(aFile, bitPos, "Hello, Rosetta Code!"); - finishWriteAscii(aFile, bitPos); - seek(aFile, 1); - aBitStream := openMsbBitStream(aFile); - writeln(literal(readAscii(aBitStream))); + writeAscii(outStream, "Hello, Rosetta Code!"); + finishWriteAscii(outStream); + inStream := openMsbInBitStream(getBytes(outStream)); + writeln(literal(readAscii(inStream))); end func; diff --git a/Task/Bitwise-operations/EasyLang/bitwise-operations.easy b/Task/Bitwise-operations/EasyLang/bitwise-operations.easy index 433a6625bb..800e7fa354 100644 --- a/Task/Bitwise-operations/EasyLang/bitwise-operations.easy +++ b/Task/Bitwise-operations/EasyLang/bitwise-operations.easy @@ -1,9 +1,10 @@ -# numbers are doubles, bit operations use 32 bits and are unsigned -x = 11 -y = 2 -print bitnot x -print bitand x y -print bitor x y -print bitxor x y -print bitshift x y -print bitshift x -y +# numbers are doubles, bit operations are unsigned, truncate +# the fractional part and use 53 integer bits +a = 14 +b = 3 +print bitand a b +print bitor a b +print bitxor a b +print bitshift a b +print bitshift a -b +print bitand a bitnot b diff --git a/Task/Bitwise-operations/M2000-Interpreter/bitwise-operations.m2000 b/Task/Bitwise-operations/M2000-Interpreter/bitwise-operations.m2000 new file mode 100644 index 0000000000..7185314544 --- /dev/null +++ b/Task/Bitwise-operations/M2000-Interpreter/bitwise-operations.m2000 @@ -0,0 +1,43 @@ +module binary_ops{ + select case random(1, 6) + case 1 + Double x=10, y=2 + case 2 + Decimal x=10, y=2 + case 3 + Integer x=10, y=2 + case 4 + Long x=10, y=2 + case 5 ' byte from 0 to 255 (unsigned) + Byte x=10, y=2 + case else + Long Long x=10, y=2 + end select + print type$(x) + //x & y values from 0 to 4294967295 + print binary.not(x)=4294967285, sint(binary.not(x))=-11 + print binary.and(x, y)=2 + print binary.or(x, y)=10 + // y values -31 to 31 + print binary.xor(x, y)=8 + print binary.shift(x, y)=40 + print binary.shift(x, -y)=2 + print binary.rotate(x, y)=40 + print binary.rotate(x, -y)=2147483650, sint(binary.rotate(x, -y))=-2147483646 + // Binary.Neg return Unsigned from signed values: -2147483648 (0x8000_0000&) to 2147483647 (0x7FFF_FFFF&) + // values>2147483647 return 2147483648 + // values <-2147483648 return 2147483647 + // 0xFFFF_ABCD& (signed value), 0xFFFF_ABCD unsinged value same bits + print 0xFFFF_ABCD&=-21555, 0xFFFF_ABCD=4294945741, sint(0xFFFF_ABCD)=-21555 + print Binary.Neg(0xFFFF_ABCD&)=21554, Binary.Not(0xFFFF_ABCD)=21554 + print sint(Binary.Neg(0xFFFF_ABCD&)+ uint(0xFFFF_ABCD&))=sint(Binary.Neg(0)) + // signed 0xFFFF_ABCD& has same bits as unsigned 0xFFFF_ABCD, + // but have different value as used in calculations + print Binary.Neg(0xFFFF_ABCD&)=Binary.Not(0xFFFF_ABCD), 0xFFFF_ABCD&<>0xFFFF_ABCD + print Binary.Neg(0x0FFF_ABCD&)=Binary.Not(0x0FFF_ABCD), 0xFFFF_ABCD&<>0xFFFF_ABCD + // Add (modulo 32), x unsigned and add a negate signed (converted to unsigned) + print binary.add(x, binary.neg(y), 1)=8 ' 10 - 2 =12 + print binary.add(x, binary.neg(-y), 1)=12 ' 10 - - 2 = 12 + print sint(binary.neg(x))=-11, binary.neg(x)=binary.not(x) +} +binary_ops diff --git a/Task/Bitwise-operations/Nim/bitwise-operations.nim b/Task/Bitwise-operations/Nim/bitwise-operations.nim index 6932b12574..d831e18c5f 100644 --- a/Task/Bitwise-operations/Nim/bitwise-operations.nim +++ b/Task/Bitwise-operations/Nim/bitwise-operations.nim @@ -1,4 +1,4 @@ -proc bitwise(a, b) = +proc bitwise[T: SomeInteger](a, b: T) = echo "a and b: " , a and b echo "a or b: ", a or b echo "a xor b: ", a xor b diff --git a/Task/Bitwise-operations/Raku/bitwise-operations.raku b/Task/Bitwise-operations/Raku/bitwise-operations.raku index a7596faadb..7cbeacac55 100644 --- a/Task/Bitwise-operations/Raku/bitwise-operations.raku +++ b/Task/Bitwise-operations/Raku/bitwise-operations.raku @@ -9,7 +9,8 @@ sub int-bits (Int $a, Int $b) { say ''; say_bit "$a", $a; say ''; - say_bit "2's complement $a", +^$a; + say_bit "1's complement (not) $a", +^$a; + say_bit "2's complement $a", +^$a + 1; say_bit "$a and $b", $a +& $b; say_bit "$a or $b", $a +| $b; say_bit "$a xor $b", $a +^ $b; diff --git a/Task/Blum-integer/Ada/blum-integer.ada b/Task/Blum-integer/Ada/blum-integer.ada new file mode 100644 index 0000000000..5c8e2c59ca --- /dev/null +++ b/Task/Blum-integer/Ada/blum-integer.ada @@ -0,0 +1,89 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Ada.Float_Text_IO; use Ada.Float_Text_IO; + +procedure Blum is + + Inc : Constant array (1 .. 8) of Integer := (4, 2, 4, 2, 4, 6, 2, 6); + + function Is_Prime (N : Integer) return Boolean is + D : Integer := 5; + begin + if N < 2 then return False; end if; + if N mod 2 = 0 then return N = 2; end if; + if N mod 3 = 0 then return N = 3; end if; + + while D * D <= N loop + if N mod D = 0 then return False; end if; + D := D + 2; + if N mod D = 0 then return False; end if; + D := D + 4; + end loop; + + return True; + end Is_Prime; + + function First_Prime_Factor (N : Integer) return Integer is + D : Integer := 7; + I : Integer := 1; + begin + if N = 1 then return 1; end if; + if N mod 3 = 0 then return 3; end if; + if N mod 5 = 0 then return 5; end if; + + while D * D <= N loop + if N mod D = 0 then + return D; + end if; + D := D + Inc(I); + I := (I mod 8) + 1; + end loop; + + return N; + end First_Prime_Factor; + + I, Blum_Count : Integer := 1; + J, P, Q : Integer; + Blums : Array (1 .. 50) of Integer; + Counts : Array (1 .. 4) of Integer := (others => 0); + Final_Digits : Array (1 .. 4) of Integer := (1, 3, 7, 9); + +begin + loop + P := First_Prime_Factor(I); + if P mod 4 = 3 then + Q := I / P; + if Q /= P and Q mod 4 = 3 and Is_Prime(Q) then + if Blum_Count < 51 then Blums(Blum_Count) := I; end if; + Counts(((I mod 10) / 3) + 1) := Counts(((I mod 10) / 3) + 1) + 1; + Blum_Count := Blum_Count + 1; + if Blum_Count = 51 then + Put("First 50 Blum Integers:"); New_Line; + for J in Integer range 1 .. 50 loop + Put(Item => Blums(J), Width => 3); Put(" "); + if J mod 10 = 0 then New_Line; end if; + end loop; + New_Line; + elsif Blum_Count = 26829 or Blum_Count mod 100000 = 1 then + Put("The "); Put(Item => Blum_Count, Width => 7); + Put("th Blum Integer is: "); Put(Item => I, Width => 9); + New_Line; + if Blum_Count = 400001 then + New_Line; Put("% Distribution of the First 400,000 Blum Integers:"); New_Line; + for J in Integer range 1 .. 4 loop + Put(" "); Put(Item => Float(Counts(J)) / 4000.0, Fore => 2, Aft => 3, Exp => 0); + Put("% end in "); Put(Item => Final_Digits(J), Width => 1); + New_Line; + end loop; + exit; + end if; + end if; + end if; + end if; + if I mod 5 = 3 then + I := I + 4; + else + I := I + 2; + end if; + end loop; +end Blum; diff --git a/Task/Blum-integer/Fortran/blum-integer.f b/Task/Blum-integer/Fortran/blum-integer.f new file mode 100644 index 0000000000..1108cc2fbe --- /dev/null +++ b/Task/Blum-integer/Fortran/blum-integer.f @@ -0,0 +1,158 @@ +program BlumInteger + use, intrinsic :: iso_fortran_env, only: int32, int64 + implicit none + + integer(int32), parameter :: LIMIT = 10*1000*1000 + integer(int32), allocatable :: BlumPrimes(:) + integer(int32), allocatable :: BlumPrimes2(:) + logical :: BlumField(0:LIMIT) + integer(int32) :: EndDigit(0:9) + integer(int64) :: k + integer(int32) :: n, idx, j, P4n3Cnt,xx,yy + call system_clock(count=xx) + call Sieve4n_3_Primes(LIMIT, BlumPrimes2) +! allocate(blumprimes(0:size(BlumPrimes2)-1)) +! The blumprimes2 array is allocated in the subroutine as a zero based array +! but, the main program doesn't know that and assumes it's 1 based so we allocate +! a zero based array then use move_alloc to correctly resize it a transfer the data + allocate(blumprimes(0:1)) + call move_alloc(blumprimes2,blumprimes) + P4n3Cnt = size(BlumPrimes) -1 + print *, 'There are ', CommaUint(int(P4n3Cnt, int64)), ' needed primes 4*n+3 to Limit ', CommaUint(int(LIMIT, int64)) + P4n3Cnt = P4n3Cnt - 1 + print * + + ! Generate Blum-Integers + BlumField = .false. + do idx = 0, P4n3Cnt + n = BlumPrimes(idx) + do j = idx+1, P4n3Cnt + k = int(n, int64) * int(BlumPrimes(j), int64) + if (k > LIMIT) exit + BlumField(k) = .true. + end do + end do + call system_clock(count=yy) + print *, 'First 50 Blum-Integers ' + idx = 0 + j = 0 + do + do while (idx < LIMIT .and. .not. BlumField(idx)) + idx = idx + 1 + end do + if (idx == LIMIT) exit + if (mod(j, 10) == 0 .and. j /= 0) print * + write(*, '(I5)', advance='no') idx + j = j + 1 + idx = idx + 1 + if (j >= 50) exit + end do + print '(//)' + + print *, ' relative occurence of digit' + print *, ' n.th |BlumInteger|Digit: 1 3 7 9' + idx = 0 + j = 0 + n = 0 + k = 26828 + EndDigit = 0 + do + do while (idx < LIMIT .and. .not. BlumField(idx)) + idx = idx + 1 + end do + if (idx == LIMIT) exit + ! Count last decimal digit + EndDigit(mod(idx, 10)) = EndDigit(mod(idx, 10)) + 1 + j = j + 1 + if (j == k) then + write(*, '(A10,A1,A11,A1)', advance='no') CommaUint(int(j, int64)), '|', CommaUint(int(idx, int64)), '|' + write(*, '(F7.3,A4)', advance='no') real(EndDigit(1))/j*100, '% |' + write(*, '(F7.3,A4)', advance='no') real(EndDigit(3))/j*100, '% |' + write(*, '(F7.3,A4)', advance='no') real(EndDigit(7))/j*100, '% |' + write(*, '(F7.3,A2)') real(EndDigit(9))/j*100, '%' + if (k < 100000) then + k = 100000 + else + k = k + 100000 + end if + end if + idx = idx + 1 + if (j >= 400000) exit + end do + print '(/,a,f8.6,1x,a)', 'Elapsed time = ',(yy-xx)/1000.0,'seconds' +contains + + subroutine Sieve4n_3_Primes(Limit, P4n3) + use iso_fortran_env + integer(int32), intent(in) :: Limit + integer(int32), allocatable, intent(out) :: P4n3(:) + integer(kind=1), allocatable :: sieve(:) + integer(int32) :: BlPrCnt, idx, n, j, sieve_size + + sieve_size = (Limit / 3 - 3) / 4 + 1 + allocate(sieve(0:sieve_size-1)) + allocate(P4n3(0:sieve_size-1)) + + sieve = 0 + BlPrCnt = 0 + idx = 0 + do + if (sieve(idx) == 0) then + n = idx*4 + 3 + P4n3(BlPrCnt) = n + BlPrCnt = BlPrCnt + 1 + j = idx + n + if (j > ubound(sieve, 1)) exit + do while (j <= ubound(sieve, 1)) + sieve(j) = 1 + j = j + n + end do + end if + idx = idx + 1 + if (idx > ubound(sieve, 1)) exit + end do + ! Collect the rest + do idx = idx, ubound(sieve, 1) + if (sieve(idx) == 0) then + P4n3(BlPrCnt) = idx*4 + 3 + BlPrCnt = BlPrCnt + 1 + end if + end do + P4n3 = P4n3(0:BlPrCnt-1) + end subroutine Sieve4n_3_Primes + + function CommaUint(n) result(res) + integer, parameter :: sizer = 30 + integer(int64), intent(in) :: n + character(:), allocatable :: res + character(len=sizer) :: temp + integer :: fromIdx, toIdx, i + character :: pRes(sizer) + + write(temp, '(I0)') n + fromIdx = len_trim(temp) + toIdx = fromIdx - 1 + if (toIdx < 3) then + res = temp(1:fromIdx) + return + end if + allocate(res, mold=repeat(' ',sizer)) + toIdx = 4*(toIdx / 3) + mod(toIdx, 3) + 1 + pRes = ' ' + + do i = 1, fromIdx + pRes(toIdx) = temp(fromIdx-i+1:fromIdx-i+1) + toIdx = toIdx - 1 + if (mod(i, 3) == 0 .and. i /= fromIdx) then + pRes(toIdx) = ',' + toIdx = toIdx - 1 + end if + end do + do i = 1,sizer ! Go from character array to string + res(I:I) = pRes(i) + end do +! + res = trim(adjustl(Res)) + end function CommaUint + +end program BlumInteger diff --git a/Task/Blum-integer/FreeBASIC/blum-integer.basic b/Task/Blum-integer/FreeBASIC/blum-integer.basic index 8b1bdd7df5..4f8b7da16f 100644 --- a/Task/Blum-integer/FreeBASIC/blum-integer.basic +++ b/Task/Blum-integer/FreeBASIC/blum-integer.basic @@ -1,39 +1,76 @@ -Dim Shared As Uinteger Prime1 -Dim As Uinteger n = 3, c = 0, Prime2 +#include "isprime.bas" -Function isSemiprime(n As Uinteger) As Boolean - Dim As Uinteger d = 3, c = 0 - While d*d <= n - While n Mod d = 0 - If c = 2 Then Return False - n /= d - c += 1 - Wend - d += 2 - Wend - Prime1 = n - Return c = 1 +Type PrimeHelper + inc(7) As Integer + idx As Integer +End Type + +Function initPrimeHelper() As PrimeHelper + Dim helper As PrimeHelper + helper.inc(0) = 4 : helper.inc(1) = 2 : helper.inc(2) = 4 + helper.inc(3) = 2 : helper.inc(4) = 4 : helper.inc(5) = 6 + helper.inc(6) = 2 : helper.inc(7) = 6 + helper.idx = 0 + Return helper End Function -Print "The first 50 Blum integers:" -Do - If isSemiprime(n) Then - If Prime1 Mod 4 = 3 Then - Prime2 = n / Prime1 - If (Prime2 <> Prime1) And (Prime2 Mod 4 = 3) Then - c += 1 - If c <= 50 Then - Print Using "####"; n; - If c Mod 10 = 0 Then Print - End If - If c >= 26828 Then - Print !"\nThe 26828th Blum integer is: " ; n - Exit Do +Function firstPrimeFactor(n As Integer) As Integer + If n = 1 Then Return 1 + If n Mod 3 = 0 Then Return 3 + If n Mod 5 = 0 Then Return 5 + + Dim helper As PrimeHelper = initPrimeHelper() + Dim k As Integer = 7 + + While k * k <= n + If n Mod k = 0 Then Return k + k += helper.inc(helper.idx) + helper.idx = (helper.idx + 1) Mod 8 + Wend + + Return n +End Function + +Sub main() + Dim As Integer blum(49), counts(9) + Dim As Integer bc = 0, i = 1, p, q + Dim As Integer j + + Dim As Double t0 = Timer + Do + p = firstPrimeFactor(i) + If p Mod 4 = 3 Then + q = i \ p + If q <> p Andalso q Mod 4 = 3 Andalso isPrime(q) Then + If bc < 50 Then blum(bc) = i + counts(i Mod 10) += 1 + bc += 1 + + If bc = 50 Then + Print "First 50 Blum integers:" + For j = 0 To 49 + Print Using "####"; blum(j); + If (j + 1) Mod 10 = 0 Then Print + Next + Print + Elseif bc = 26828 Orelse bc Mod 100000 = 0 Then + Print Using "The ###,###th Blum integer is: #,###,###"; bc; i + + If bc = 400000 Then + Print !"\n% distribution of the first 400,000 Blum integers:" + For j = 1 To 9 Step 2 + If j <> 5 Then Print Using " ##.###% end in #"; (counts(j)/4000); j + Next + Exit Do + End If End If End If End If - End If - n += 2 -Loop + i += Iif(i Mod 5 = 3, 4, 2) + Loop + Print Chr(10); Timer - t0; " sec." +End Sub + +main() Sleep diff --git a/Task/Blum-integer/Gambas/blum-integer.gambas b/Task/Blum-integer/Gambas/blum-integer.gambas index 027cc6a610..ce94e9d661 100644 --- a/Task/Blum-integer/Gambas/blum-integer.gambas +++ b/Task/Blum-integer/Gambas/blum-integer.gambas @@ -1,44 +1,67 @@ -Public Prime1 As Integer +Use "isprime.bas" -Public Sub Main() +Private inc As Integer[] = [4, 2, 4, 2, 4, 6, 2, 6] - Dim n As Integer = 3, c As Integer = 0, Prime2 As Integer +Private Function FirstPrimeFactor(n As Long) As Long - Print "The first 50 Blum integers:" - Do - If isSemiprime(n) Then - If Prime1 Mod 4 = 3 Then - Prime2 = n / Prime1 - If (Prime2 <> Prime1) And (Prime2 Mod 4 = 3) Then - c += 1 - If c <= 50 Then - Print Format$(n, "####"); - If c Mod 10 = 0 Then Print - End If - If c >= 26828 Then - Print "\nThe 26828th Blum integer is: "; n - Break - End If - End If - End If - End If - n += 2 - Loop + If n = 1 Then Return 1 + If n Mod 3 = 0 Then Return 3 + If n Mod 5 = 0 Then Return 5 + + Dim k As Long = 7 + Dim i As Integer = 0 + + While k * k <= n + If n Mod k = 0 Then Return k + k += inc[i] + i = (i + 1) Mod 8 + Wend + + Return n End -Function isSemiprime(n As Integer) As Boolean +Public Sub Main() - Dim d As Integer = 3, c As Integer = 0 - While d * d <= n - While n Mod d = 0 - If c = 2 Then Return False - n /= d - c += 1 - Wend - d += 2 + Dim blum As New Long[50] + Dim counts As New Collection + + counts[1] = 0 + counts[3] = 0 + counts[7] = 0 + counts[9] = 0 + + Dim bc As Long = 0, i As Long = 1 + + While True + Dim p As Long = FirstPrimeFactor(i) + If p Mod 4 = 3 Then + Dim q As Long = i \ p + If q <> p And q Mod 4 = 3 And IsPrime(q) Then + If bc < 50 Then blum[bc] = i + counts[i Mod 10] += 1 + bc += 1 + + If bc = 50 Then + Print "First 50 Blum integers:" + For j As Integer = 0 To 49 + Print Format(blum[j], "####"); " "; + If (j + 1) Mod 10 = 0 Then Print + Next + Print + Else If bc = 26828 Or bc Mod 100000 = 0 Then + Print "The "; Format(bc, " ###,###"); "th Blum integer is: "; Format(i, " #,###,###") + If bc = 400000 Then + Print Chr(10); "% distribution of the first 400,000 Blum integers:" + For Each j As Integer In [1, 3, 7, 9] + Print Format(counts[j] / 4000, " ##.###"); "% end in "; j + Next + Return + Endif + Endif + Endif + Endif + i += If(i Mod 5 = 3, 4, 2) Wend - Prime1 = n - Return c = 1 -End Function +End diff --git a/Task/Blum-integer/OxygenBasic/blum-integer.basic b/Task/Blum-integer/OxygenBasic/blum-integer.basic new file mode 100644 index 0000000000..50ba04d0a0 --- /dev/null +++ b/Task/Blum-integer/OxygenBasic/blum-integer.basic @@ -0,0 +1,78 @@ +#include "isprime.bas" +uses console + +dim inc(7) as integer +inc(0) = 4: inc(1) = 2: inc(2) = 4 +inc(3) = 2: inc(4) = 4: inc(5) = 6 +inc(6) = 2: inc(7) = 6 + +function firstPrimeFactor(n as long) as long + if n = 1 then return 1 + if n mod 3 = 0 then return 3 + if n mod 5 = 0 then return 5 + + long k = 7 + int idx = 0 + + while k * k <= n + if mod(n, k) = 0 then return k + k += inc(idx) + idx = mod((idx + 1), 8) + wend + return n +end function + +sub main() + dim as long blum(49), counts(9) + long bc = 0, i = 1, pct, p, q + int j + string s, t + + do + p = firstPrimeFactor(i) + if p mod 4 = 3 then + q = i \ p + if q <> p and q mod 4 = 3 and isPrime(q) then + if bc < 50 then blum(bc) = i + counts(i mod 10) = counts(i mod 10) + 1 + bc += 1 + + if bc = 50 then + printl "First 50 Blum integers:" + for j = 0 to 49 + s = str(blum(j)) + while len(s) < 4: s = " " + s: wend + print s; + if mod((j + 1), 10) = 0 then printl + next + printl + elseif bc = 26828 or bc mod 100000 = 0 then + s = str(bc) + while len(s) < 6: s = " " + s: wend + t = str(i) + while len(t) < 7: t = " " + t: wend + printl "The " + s + "th Blum integer is: " + t + if bc = 400000 then + printl cr "% distribution of the first 400,000 Blum integers:" + + for j = 1 to 9 step 2 + if j <> 5 then + pct = counts(j)/4000 + s = str(pct) + while len(s) < 5: s = " " + s: wend + printl s + "% end in " + str(j) + end if + next + end + end if + end if + end if + end if + if mod(i, 5) = 3 then i += 4 else i += 2 + end do +end sub + +main() + +printl cr "Enter ..." +waitkey diff --git a/Task/Blum-integer/PureBasic/blum-integer.basic b/Task/Blum-integer/PureBasic/blum-integer.basic new file mode 100644 index 0000000000..191ab6d065 --- /dev/null +++ b/Task/Blum-integer/PureBasic/blum-integer.basic @@ -0,0 +1,69 @@ +XIncludeFile "isprime.pb" + +Structure PrimeHelper + inc.i[8] + index.i +EndStructure + +Procedure.i firstPrimeFactor(n.q) + If n = 1 : ProcedureReturn 1 : EndIf + If n % 3 = 0 : ProcedureReturn 3 : EndIf + If n % 5 = 0 : ProcedureReturn 5 : EndIf + + Define helper.PrimeHelper + helper\inc[0] = 4 : helper\inc[1] = 2 : helper\inc[2] = 4 + helper\inc[3] = 2 : helper\inc[4] = 4 : helper\inc[5] = 6 + helper\inc[6] = 2 : helper\inc[7] = 6 + + Define k.q = 7 + While k * k <= n + If n % k = 0 : ProcedureReturn k : EndIf + k + helper\inc[helper\index] + helper\index = (helper\index + 1) % 8 + Wend + ProcedureReturn n +EndProcedure + +OpenConsole() +Define Dim blum.q(49) +Define.q bc = 0, i = 1 +Define Dim counts.q(9) + +Repeat + Define p.q = firstPrimeFactor(i) + If p % 4 = 3 + Define q.q = i / p + If q <> p And q % 4 = 3 And isPrime(q) + If bc < 50 : blum(bc) = i : EndIf + counts(i % 10) + 1 + bc + 1 + + If bc = 50 + PrintN("First 50 Blum integers:") + For j = 0 To 49 + Print(" " + RSet(Str(blum(j)), 3)) + If (j + 1) % 10 = 0 : PrintN("") : EndIf + Next + PrintN("") + ElseIf bc = 26828 Or bc % 100000 = 0 + PrintN("The " + RSet(Str(bc), 6) + "th Blum integer is: " + RSet(Str(i), 7)) + If bc = 400000 + PrintN(#CRLF$ + "% distribution of the first 400,000 Blum integers:") + For j = 1 To 9 Step 2 + If j <> 5 + PrintN(RSet(StrF(counts(j)/4000, 3), 5) + "% end in " + Str(j)) + EndIf + Next + Break + EndIf + EndIf + EndIf + EndIf + If i % 5 = 3 + i + 4 + Else + i + 2 + EndIf +ForEver + +PrintN(#CRLF$ + "Press ENTER to exit"): Input() diff --git a/Task/Blum-integer/QB64/blum-integer.qb64 b/Task/Blum-integer/QB64/blum-integer.qb64 new file mode 100644 index 0000000000..9b3a0be158 --- /dev/null +++ b/Task/Blum-integer/QB64/blum-integer.qb64 @@ -0,0 +1,73 @@ +Dim Shared inc(7) As Integer +inc(0) = 4: inc(1) = 2: inc(2) = 4 +inc(3) = 2: inc(4) = 4: inc(5) = 6 +inc(6) = 2: inc(7) = 6 + +Dim blum(49) As Long +Dim counts(9) As Long +Dim bc As Long, i As Long, p As Long, q As Long, j As Integer +i = 1 + +Do + p = firstPrimeFactor(i) + If p Mod 4 = 3 Then + q = i \ p + If q <> p And q Mod 4 = 3 And isPrime(q) Then + If bc < 50 Then blum(bc) = i + counts(i Mod 10) = counts(i Mod 10) + 1 + bc = bc + 1 + + If bc = 50 Then + Print "First 50 Blum integers:" + For j = 0 To 49 + Print Using "####"; blum(j); + If (j + 1) Mod 10 = 0 Then Print + Next + Print + ElseIf bc = 26828 Or bc Mod 100000 = 0 Then + Print Using "The ###,###th Blum integer is: #,###,###"; bc; i + If bc = 400000 Then + Print Chr$(10); "% distribution of the first 400,000 Blum integers:" + For j = 1 To 9 Step 2 + If j <> 5 Then + Print Using " ##.###% end in #"; (counts(j%) / 4000); j% + End If + Next + End + End If + End If + End If + End If + If i Mod 5 = 3 Then i = i + 4 Else i = i + 2 +Loop +End + +Function firstPrimeFactor& (n As Long) + Dim k As Long, idx As Integer + If n = 1 Then firstPrimeFactor& = 1: Exit Function + If n Mod 3 = 0 Then firstPrimeFactor& = 3: Exit Function + If n Mod 5 = 0 Then firstPrimeFactor& = 5: Exit Function + k = 7: idx = 0 + Do While k * k <= n + If n Mod k = 0 Then + firstPrimeFactor& = k + Exit Function + End If + k = k + inc(idx) + idx = (idx + 1) Mod 8 + Loop + firstPrimeFactor& = n +End Function + +Function isPrime% (n As Long) + Dim i As Long + If n <= 1 Then Exit Function + If n <= 3 Then isPrime% = 1: Exit Function + If n Mod 2 = 0 Or n Mod 3 = 0 Then Exit Function + i = 5 + While i * i <= n + If n Mod i = 0 Or n Mod (i + 2) = 0 Then Exit Function + i = i + 6 + Wend + isPrime% = 1 +End Function diff --git a/Task/Boyer-Moore-string-search/Free-Pascal-Lazarus/boyer-moore-string-search.pas b/Task/Boyer-Moore-string-search/Free-Pascal-Lazarus/boyer-moore-string-search.pas new file mode 100644 index 0000000000..2a2772d84a --- /dev/null +++ b/Task/Boyer-Moore-string-search/Free-Pascal-Lazarus/boyer-moore-string-search.pas @@ -0,0 +1,62 @@ +{$mode objfpc}{$H+} +uses strutils, classes; +const s:string = 'GCTAGCTCTACGAGTCTA'+ LineEnding + + 'GGCTATAATGCGTA'+ LineEnding + + 'there would have been a time for such a word'+ LineEnding + + 'needle need noodle needle'+ LineEnding + + 'DKnuthusesandprogramsanimaginarycomputertheMIXanditsassociatedmachinecodeandassemblylanguages'+ LineEnding + + 'Nearby farms grew an acre of alfalfa on the dairy''s behalf, with bales of that alfalfa exchanged for milk.'; + +var + List:TStringlist; + matches:SizeIntArray; + i:SizeInt; +begin + List := TStringlist.Create; + try + List.Text := s; + if FindMatchesBoyerMooreCaseSensitive(List[0],'TCTA',matches,true) then + begin + write('TCTA found at index: '); + for i in matches do write(i:4); + writeln; + end else writeln('no matches found'); + + if FindMatchesBoyerMooreCaseSensitive(List[1],'TAATAAA',matches,true) then + begin + write('TAATAAA found at index: '); + for i in matches do write(i:4); + writeln; + end else writeln('no matches found for TAATAAA'); + + if FindMatchesBoyerMooreCaseSensitive(List[2],'word',matches,true) then + begin + write('word found at index: '); + for i in matches do write(i:4); + writeln; + end else writeln('no matches found for word'); + + if FindMatchesBoyerMooreCaseSensitive(List[3],'needle',matches,true) then + begin + write('needle found at index: '); + for i in matches do write(i:4); + writeln; + end else writeln('no matches found for needle'); + + if FindMatchesBoyerMooreCaseSensitive(List[4],'and',matches,true) then + begin + write('and found at index: '); + for i in matches do write(i:4); + writeln; + end else writeln('no matches found for and'); + + if FindMatchesBoyerMooreCaseSensitive(List[5],'alfalfa',matches,true) then + begin + write('alfalfa found at index: '); + for i in matches do write(i:4); + writeln; + end else writeln('no matches found for alfalfa'); + finally + List.Free; + end; +end. diff --git a/Task/Boyer-Moore-string-search/Pascal/boyer-moore-string-search-1.pas b/Task/Boyer-Moore-string-search/Pascal/boyer-moore-string-search-1.pas new file mode 100644 index 0000000000..dfbfd37b6c --- /dev/null +++ b/Task/Boyer-Moore-string-search/Pascal/boyer-moore-string-search-1.pas @@ -0,0 +1,2 @@ +FindMatchesBoyerMooreCaseInSensitive; +FindMatchesBoyerMooreCaseSensitive; diff --git a/Task/Boyer-Moore-string-search/Pascal/boyer-moore-string-search.pas b/Task/Boyer-Moore-string-search/Pascal/boyer-moore-string-search-2.pas similarity index 100% rename from Task/Boyer-Moore-string-search/Pascal/boyer-moore-string-search.pas rename to Task/Boyer-Moore-string-search/Pascal/boyer-moore-string-search-2.pas diff --git a/Task/Brilliant-numbers/00-TASK.txt b/Task/Brilliant-numbers/00-TASK.txt index e17610886b..24c4103983 100644 --- a/Task/Brilliant-numbers/00-TASK.txt +++ b/Task/Brilliant-numbers/00-TASK.txt @@ -23,4 +23,5 @@ ;See also ;* [https://www.numbersaplenty.com/set/brilliant_number Numbers Aplenty - Brilliant numbers] +;* [https://www.alpertron.com.ar/BRILLIANT.HTM - Like the task upper Limit 1E201] ;* [[oeis:A078972|OEIS:A078972 - Brilliant numbers: semiprimes whose prime factors have the same number of decimal digits]] diff --git a/Task/Brilliant-numbers/Free-Pascal-Lazarus/brilliant-numbers.pas b/Task/Brilliant-numbers/Free-Pascal-Lazarus/brilliant-numbers.pas index c38497d189..d85407517a 100644 --- a/Task/Brilliant-numbers/Free-Pascal-Lazarus/brilliant-numbers.pas +++ b/Task/Brilliant-numbers/Free-Pascal-Lazarus/brilliant-numbers.pas @@ -2,227 +2,259 @@ program BrilliantNumbers; {$IFDEF FPC} {$MODE Delphi} {$Optimization ON,All} + {$codealign proc=32,loop=1} {$ENDIF} {$IFDEF WINDOWS} {$APPTYPE CONSOLE} {$ENDIF} - uses - SysUtils,classes; + SysUtils,primSieve,classes; const - MaxRoot = 100*1000*1000+2310;//+2310 to get next prime beyond limit + MaxRoot =1000*1000*1000; type - tPrimeDelta = array of Uint8; + tPrime = array of Uint32; + tpPrime = pUint32; tBrilliant = record - pMin, // start for dgtcnt - pMid, // start for dgtcnt+1 - pMax, // end for dgtcnt+1 + Count_dgt : Uint64; MinIdx, MidIdx, MaxIdx : Uint32; end; var - BrilliantPos :array [0..8] of TBrilliant; - OddPowP : Uint32; +{$ALIGN 32} + BrilliantPos :array [0..10] of TBrilliant; - function BuildWheel(var primes: tPrimeDelta): longint; - //pre-sieve with small primes,returns the last used prime + function commatize(n:NativeUint):string; var - //wheelprimes = 2,3,5,7,11. ;wheelsize = product[i= 0..wpno-1]wheelprimes[i] > Uint64|i> 13 - wheelprimes: array[0..15] of byte; - wheelSize, wpno, pr, pw, i, k: longword; + l,i : NativeUint; begin - pr := 1; - primes[1] := 1; - WheelSize := 1; - wpno := 0; - repeat - Inc(pr); - pw := pr; - if pw > wheelsize then - Dec(pw, wheelsize); - if Primes[pw]<>0 then - begin - k := WheelSize + 1; - for i := 1 to pr - 1 do - begin - Inc(k, WheelSize); - if k < High(primes) then - move(primes[1], primes[k - WheelSize], WheelSize) - else - begin - move(primes[1], primes[k - WheelSize], High(primes) - WheelSize * i); - break; - end; - end; - Dec(k); - if k > High(primes) then - k := High(primes); - wheelPrimes[wpno] := pr; - primes[pr] := 0; - - i := sqr(pr); - while i <= k do - begin - primes[i] := 0; - Inc(i, pr); - end; - - Inc(wpno); - WheelSize := k; - end; - until WheelSize >= High(primes); - while wpno > 0 do - begin - Dec(wpno); - primes[wheelPrimes[wpno]] := 1; + str(n,result); + l := length(result); + if l < 4 then + exit; + i := l+ (l-1) DIV 3; + setlength(result,i); + While i <> l do + Begin + result[i]:= result[l]; + result[i-1]:= result[l-1]; + result[i-2]:= result[l-2]; + result[i-3]:= ','; + dec(i,4); + dec(l,3); end; - Result := pr; end; - procedure Sieve(var primes: tPrimeDelta); + procedure Sieve(var pr: tPrime;n:UInt32); + //get primes plus one beyond limit var - pPrime: pUint8; - sieveprime, delFact: longword; + pPr : pUInt32; + i,p : Int32; begin - sieveprime := BuildWheel(primes); - pPrime := @primes[0]; + If n> 60184 then + //Pierre Dusart proved in 2010 + setlength(pr,trunc(n/(ln(n)-1.1))) + else + setlength(pr,6542); + i := 0; + pPr := @pr[0]; repeat - repeat - Inc(sieveprime); - until pPrime[sieveprime]<>0; - delFact := High(primes) div sieveprime; - if delFact < sieveprime then - BREAK; - inc(delFact); - repeat - repeat - Dec(delFact); - until pPrime[delFact]<>0; - pPrime[sieveprime * delFact] := 0; - until delFact < sieveprime; - until False; - primes[1] := 0; + p := NextPrime; + pPr[i] := p; + i +=1; + until p > n; + setlength(pr,i); + writeln('Primes [',pPr[0],'..',commatize(pPr[i-2]),'] +',commatize(pPr[i-1])); end; - procedure GetPrimeDelta(var prD:tPrimeDelta;size: int32); - var - pPD : pUint8; - idx,LastP,p : Uint32; - Begin - setlength(prD, 0); - setlength(prD, size + 1); - Sieve(prD); - pPD := @prD[0]; - idx := 0; - LastP := 0; - p := 0; - repeat - if pPD[p] <> 0 then - begin - pPD[idx] := p-LastP; - LastP := p; - inc(idx); - end; - inc(p); - until p> Size; - Setlength(prD,idx); - end; - - function Cnt_First_DgtCnt(pPD:pUint8;lmt:UInt64;dgtCnt: Int32):nativeUint; - //counting products of prime factors smaller than limit + function InsRes(p : tpPrime;Val,MaxIdx,cnt: Int32):int32; var - pLo,pHi,iLo,iHi : UInt64; + i : Int32; begin - with BrilliantPos[dgtCnt] do + if cnt = maxIdx then begin - pLo := pMin; - iLO := MinIdx; - pHi := pMid; - iHi := MidIdx; + while (maxIdx >=0) AND (val < p[maxIdx]) do + Begin + p[maxIdx+1] := p[maxIdx]; + dec(maxIdx); + end; + p[maxIdx+1] := val; + EXIT(cnt); + end + else + Begin + i := MaxIDx; + if val > p[i] then + begin + p[i+1] := val; + end + else + begin + while (i >=0) AND (val < p[i]) do + Begin + p[i+1] := p[i]; + dec(i); + end; + p[i+1] := val; + end; end; - result := iHi-iLo+1; - repeat - iLo+=1; - pLO := pLo+pPD[iLo]; - if pLo = pHi then - begin - if sqr(pLo) < Lmt then - pLO := pLo+pPD[iLo+1]; - OddPowP := pLo; - EXIT(result+1); - end; - while (pHi >= pLo) AND (pHi*pLo > lmt) do - begin - pHi := pHi-pPD[iHi]; - iHi-=1; - end; - result += iHi-iLo+1; - until (pHi < pLo); - OddPowP := pLo; + result := MaxIdx+1; + if result > cnt then + result := cnt; end; - procedure GetLimitPos(pPD:pUint8;MaxPrIdx:NativeUint); + procedure Get_N_Brilliant(pPr:tpPrime;cnt:Int32); var - lmt, p,pmin,idx1,dgtCnt : nativeuint; - DeltaMax,DeltaMin,TotCnt: Uint64; - begin + p_p : array of Int32; + lmt,p1,p2,i1,i2,maxIdx : Int32; + Begin + setlength(p_p,cnt+2); + MaxIdx := 0; + p_p[MaxIdx] := maxint; + i1 := 1; + p1 := pPr[0]; lmt := 10; - p := 0; - idx1 := 0; - dgtCnt := 0; - TotCnt := 0; - p += pPD[idx1]; repeat - BrilliantPos[dgtCnt].pMin:= p; - BrilliantPos[dgtCnt].MinIdx := idx1; - write('10^',2*dgtCnt+1:2,':',p:10); - pMin := p; - while (pMin*p < lmt) and (idx1 < MaxPrIdx) do - begin - idx1 += 1; - p += pPD[idx1]; - end; - pMin := p-pPD[idx1]; - BrilliantPos[dgtCnt].pMid := pMin; - BrilliantPos[dgtCnt].MidIdx := idx1-1; - DeltaMin := Cnt_First_DgtCnt(pPD,lmt,dgtCnt); - writeln(DeltaMin:20,TotCnt+DeltaMin:20); + repeat + p2 := p1; + if MaxIdx = cnt then + if p1*p1 > p_p[MaxIdx] then + break; + i2 := i1; + repeat + MaxIdx := InsRes(@p_p[0],p1*p2,MaxIdx,cnt); + p2 := pPr[i2]; + i2+=1; + if MaxIdx = cnt then + if p1*p2 > p_p[MaxIdx] then + break; + until p2>lmt; + p1 := pPr[i1]; + i1 +=1; + until p1>lmt; lmt *=10; - while (p*p <= lmt) AND (idx1 < MaxPrIdx) do - begin - idx1 += 1; - p += pPD[idx1]; - end; - pMin := p-pPD[idx1]; - BrilliantPos[dgtCnt].pMax := pMin; - BrilliantPos[dgtCnt].MaxIdx := idx1-1; + until (MaxIdx = cnt)AND (p1*p1 > p_p[MaxIdx]); - //for both decimals just summation formula - deltaMax := idx1-BrilliantPos[dgtCnt].MinIdx; - deltaMax := (deltaMax*(deltaMax+1) DIV 2); - TotCnt += deltaMax; - write('10^',2*dgtCnt+2:2,':',OddPowP:10); - writeln(DeltaMax-DeltaMin:20,TotCnt:20); - dgtCnt += 1; - lmt*=10; - until (idx1 >= MaxPrIdx) or(lmt>sqr(MaxRoot)); - writeln(p:16); - end; + Writeln('The first ',cnt,' brilliant numbers '); + For i1 := 1 to cnt do + Begin + write(commatize(p_p[i1-1]):6); + if i1 MOD 10 = 0 then + write(#13#10); + end; + writeln; + end; + + function BinSearch(pPr:tpPrime;maxIdx,p:NativeUint):NativeInt; + // binary search for idx , so, that primes[idx-1] < p < primes[idx] + var + tmp : double; + i1,i2,m : nativeUInt; + begin + //assumption, where to find the right prime + tmp := ln(p)-1; + i1 := trunc(p/tmp); + i2 := trunc(p/(tmp-0.1)); + IF i2 > MaxIdx then + i2 := MaxIdx; + repeat + m := (i1+i2) shr 1; + if pPr[m]

MaxIdx then + i2 := MaxIdx; + while pPr[i2] < p do + inc(i2); + result := i2; + end; + + function Cnt_First_DgtCnt(pPr:tpPrime;lmt:UInt64;dgtCnt: Int32):nativeInt; + //counting products of prime factors below limit + //and memorize the smallest brilliant number above limit + var + pLo,tmp,res : UInt64; + iLo,iHi : Int64; + begin + with BrilliantPos[dgtCnt] do + begin + iLO := MinIdx; + iHi := MidIdx; + end; + result := iHi-iLo; + res := pPr[iLo]*pPr[iHi+1]; + repeat + iLo +=1; + pLo := pPr[iLo]; + while (iHi >= iLo) AND (pPr[iHi]*pLo > Lmt) do + iHi-=1; + tmp := pPr[iHi+1]*pLo; + if (tmp>lmt)AND (res>tmp) then + res := tmp; + result += iHi-iLo+1; + until (iHi < iLo); + BrilliantPos[dgtCnt].Count_dgt := res; + end; + + procedure GetLimitPos(pPr:tpPrime;MaxPrIdx:NativeUint); + var + lmt, p,idx1,dgtCnt : nativeuint; + DeltaMax,DeltaMin,First,TotCnt: Uint64; + begin + lmt := 10; + p := 0; + idx1 := 0; + dgtCnt := 0; + TotCnt := 0; + p := pPr[idx1]; + repeat + BrilliantPos[dgtCnt].MinIdx := idx1; + write(2*dgtCnt+1:3,':'); + First := p*p; + p := Lmt DIV p; + if p> 60000 then + idx1:= BinSearch(pPr,MaxPrIdx,p) + else + while (p>pPr[idx1]) and (idx1 < MaxPrIdx) do + idx1 += 1; + BrilliantPos[dgtCnt].MidIdx := idx1; + DeltaMin := Cnt_First_DgtCnt(pPr,lmt,dgtCnt); + writeln(commatize(TotCnt+DeltaMin):23,commatize(First):24); + lmt *=10; + repeat + idx1 +=1; + until (sqr(pPr[idx1]) >= lmt)OR (idx1>=MaxPrIdx); + p := pPr[idx1]; + BrilliantPos[dgtCnt].MaxIdx := idx1-1; + //for both decimals just summation formula + deltaMax := idx1-BrilliantPos[dgtCnt].MinIdx; + deltaMax := (deltaMax*(deltaMax+1) DIV 2); + TotCnt += deltaMax; + First := BrilliantPos[dgtCnt].Count_dgt; + write(2*dgtCnt+2:3,':'); + writeln(commatize(TotCnt):23,commatize(First):24); + dgtCnt += 1; + lmt*=10; + until (idx1 >= MaxPrIdx) or(lmt>sqr(MaxRoot)); + end; var - primeDelta :TprimeDelta; + primes :tPrime; + pPr : tpPrime; T : INt64; - pPD : pUint8; begin T := GetTickCount64; - GetPrimeDelta(primeDelta,MaxRoot); + Sieve(primes,MaxRoot); Writeln('Sieving in ',GetTickCount64-T,' ms'); T := GetTickCount64; - pPD := @primeDelta[0]; -// 10^ 1: 2 3 3 - writeln('Limit first prime deltaCount Total Count'); - GetLimitPos(pPD,High(primeDelta)); + + pPr := @primes[0]; + Get_N_Brilliant(pPr,100); + writeln('Digits total count first brilliant'); + GetLimitPos(pPr,High(primes)); + writeln(' ',Commatize(sqr(primes[High(primes)])):26); Writeln('Counting in ',GetTickCount64-T,' ms'); {$IFDEF WINDOWS} readln; diff --git a/Task/Brownian-tree/FutureBasic/brownian-tree.basic b/Task/Brownian-tree/FutureBasic/brownian-tree.basic new file mode 100644 index 0000000000..a394c348c4 --- /dev/null +++ b/Task/Brownian-tree/FutureBasic/brownian-tree.basic @@ -0,0 +1,153 @@ +// Brownian tree +//https://rosettacode.org/wiki/Brownian_tree + +/* +A Brownian tree is built with these steps: +first, a "seed" is placed somewhere on the screen. +Then, a particle is placed in a random position of the screen, +and moved randomly until it bumps against the seed. +The particle is left there, and another particle is placed in a random position +and moved until it bumps against the seed or any previous particle, and so on. + +*/ + + +begin globals + + _w = 400 // window size + short w = _w + bool pixelUsed(_w ,_w ) + short x, y , Oldx, Oldy + cgRect TheRect + short Edge + long SpeckleCount + short MainColor,SpeckleColor + bool GreenGreen,WhiteWhite,WhiteIndigo,WhiteMagenta,GreenIndigo,CyanBlue + bool SeedPlanted + long count + + + // Color Options + GreenGreen = 0 + GreenIndigo = 0 + WhiteIndigo = 1 + WhiteWhite = 0 + WhiteMagenta = 0 + CyanBlue = 0 + + if GreenGreen then MainColor = _ZGreen : SpeckleColor = _ZGreen + if WhiteWhite then MainColor = _ZWhite : SpeckleColor = _ZWhite + if WhiteIndigo then MainColor = _ZWhite : SpeckleColor = _zSystemIndigo + if WhiteMagenta then MainColor = _ZWhite : SpeckleColor = _zMagenta + if GreenIndigo then MainColor = _ZGreen : SpeckleColor = _zSystemIndigo + if CyanBlue then MainColor = _zCyan : SpeckleColor = _zBlue + +end globals + +_Window = 1 +window _Window, @"", ( 0, 0, _w, _w ), NSWindowStyleMaskTitled + NSWindowStyleMaskMiniaturizable + +windowcenter(_Window) +WindowSetBackgroundColor(_Window,fn ColorBlack) + +local fn ClearPixelArray + cls + + short row,col + for row = 1 to 400 + for col = 1 to 400 + pixelUsed(row,col) = NO + next + next + + + SpeckleCount = 0 + + Edge = _w + /// place seed in the middle + pen -1 + oval fill (w/2,w/2,5,5), MainColor + x = w/2 + y = w/2 + pixelUsed(x,y) = YES + + Oldx = x + Oldy = y + count = 0 + SeedPlanted = _true + +end fn + + +local fn DrawPixels + + // Set New Random particle location + if SeedPlanted = _false + do + x = rnd(Edge) + y = rnd(Edge) + until pixelUsed(x,y) = NO + end if + + SeedPlanted = _false + short xBack, yBack + xBack = x + yBack = x + + + // Find a location for the new particle + do + + Oldx = x + Oldy = y + + // set x and y within plus or minus 15 pixels of x or y + x += RND(3) - 2 + y += RND(3) - 2 + + // prevent results that are not within 15 pixels of Oldx and Oldy + if x <= 0 then x = xBack : y = yBack + if y <= 0 then y = xBack : y = yBack + if x > Edge then x = xBack : y = yBack + if y > Edge then y = xBack : y = yBack + + until pixelUsed(x,y) = YES + + + // Draw the new particle but protect the margin on the edge + + if Oldx > 15 && Oldx < Edge - 15 && Oldy > 15 && Oldy < Edge - 15 + SpeckleCount ++ + + pen -1 + if SpeckleCount < 200 + oval fill (Oldx,Oldy,1,1), MainColor + else + oval fill (Oldx,Oldy,2,2), SpeckleColor + SpeckleCount = 0 + end if + + pixelUsed(Oldx,Oldy) = YES + xBack = x + yBack = y + count ++ + end if + + + if count > 10000 + CFStringRef ReturnedKey + ReturnedKey = Inkey %(90,1),@"Any key for another one. Q to quit" + if fn StringContainsString(ReturnedKey, @"q") then end + if fn StringContainsString(ReturnedKey, @"Q") then end + fn ClearPixelArray + end if + + +end fn + + +fn ClearPixelArray + +fn AppSetTimer( .000001, @Fn DrawPixels, _true ) + +handleevents diff --git a/Task/Bulls-and-cows/J/bulls-and-cows-2.j b/Task/Bulls-and-cows/J/bulls-and-cows-2.j index 0fb16de9c6..9795e742c7 100644 --- a/Task/Bulls-and-cows/J/bulls-and-cows-2.j +++ b/Task/Bulls-and-cows/J/bulls-and-cows-2.j @@ -1,4 +1,4 @@ -U =. {{]F.(u[_2:Z:v)}} NB. apply u until v is true +U =. {{u^:(-.@:v)^:_.}} NB. apply u until v is true input =. 1!:1@1@echo@'Guess: ' output =. [ ('Bulls: ',:'Cows: ')echo@,.":@,. isdigits=. *./@e.&'0123456789' diff --git a/Task/Burrows-Wheeler-transform/ALGOL-68/burrows-wheeler-transform.alg b/Task/Burrows-Wheeler-transform/ALGOL-68/burrows-wheeler-transform.alg new file mode 100644 index 0000000000..a401340fef --- /dev/null +++ b/Task/Burrows-Wheeler-transform/ALGOL-68/burrows-wheeler-transform.alg @@ -0,0 +1,63 @@ +BEGIN # Burrows-Wheeler transform - translated from the EasyLang sample # + PR read "sort.incl.a68" PR # include sort utilities # + CHAR stx = REPR 2, etx = REPR 3; + OP BWT = ( STRING s )STRING: + BEGIN + [ LWB s : UPB s + 2 ]STRING tbl; + STRING ss = stx + s + etx; + FOR i FROM LWB ss TO UPB ss DO + STRING a = ss[ LWB ss : i ]; + STRING b = IF i >= UPB ss THEN "" ELSE ss[ i + 1 : ] FI; + tbl[ i ] := b + a + OD; + QUICKSORT tbl; + STRING r := ""; + FOR s pos FROM LWB tbl TO UPB tbl DO + r +:= tbl[ s pos ][ UPB tbl[ s pos ] ] + OD; + r + END # BWT # ; + OP IBWT = ( STRING r )STRING: + BEGIN + [ LWB r : UPB r ]STRING tbl; + FOR j FROM LWB r TO UPB r DO tbl[ j ] := "" OD; + FROM LWB r TO UPB r DO + FOR k FROM LWB r TO UPB r DO + r[ k ] +=: tbl[ k ] + OD; + QUICKSORT tbl + OD; + STRING result := ""; + FOR r pos FROM LWB tbl TO UPB tbl WHILE result = "" DO + STRING row = tbl[ r pos ]; + IF row[ UPB row ] = etx THEN result := row[ LWB row + 1 : UPB row - 1 ] FI + OD; + result + END # IBWT # ; + + BEGIN + OP XTX = ( STRING s )STRING: # make stx and etx visible # + BEGIN + STRING result := ""; + FOR s pos FROM LWB s TO UPB s DO + CHAR c = s[ s pos ]; + result +:= IF c = stx THEN "" + ELIF c = etx THEN "" + ELSE c + FI + OD; + result + END # XTX # ; + []STRING tests = ( "banana", "appellee", "dogwood" + , "TO BE OR NOT TO BE OR WANT TO BE OR NOT?" + , "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES" + ); + FOR t pos FROM LWB tests TO UPB tests DO + STRING s = tests[ t pos ]; + print( ( s, newline ) ); + STRING h = BWT s; + print( ( " -> ", XTX h, newline ) ); + print( ( IBWT h, newline, newline ) ) + OD + END +END diff --git a/Task/Burrows-Wheeler-transform/Fortran/burrows-wheeler-transform.f b/Task/Burrows-Wheeler-transform/Fortran/burrows-wheeler-transform.f new file mode 100644 index 0000000000..8fcb501e51 --- /dev/null +++ b/Task/Burrows-Wheeler-transform/Fortran/burrows-wheeler-transform.f @@ -0,0 +1,163 @@ +program BurrowsWheeler + implicit none + + ! Main program + call Test("BANANA") + call Test("CANAAN") + call Test("CANCAN") + call Test("appellee") + call Test("dogwood") + call Test("TO BE OR NOT TO BE OR WANT TO BE OR NOT?") + call Test("SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES") + call Test("Four score and 7 years ago, our forefathers set forth on this continent to establish a new nation "//& + "conceived in liberty and dedicated to he proposition that all men were created equal") + contains + ! Function to compare rotations + integer function CompareRotations(input, n, a, b) + character(len=*), intent(in) :: input + integer, intent(in) :: n, a, b + integer :: p, q, nrNotTested + integer :: i ,k + + CompareRotations = 0 + p = a + q = b + nrNotTested = n + do + p = p + 1 + if (p == n) p = 0 + q = q + 1 + if (q == n) q = 0 + i = p + 1 + k = q + 1 + if (input(i:i) == input(k:k)) then + nrNotTested = nrNotTested - 1 + else if (input(i:i) > input(k:k)) then + CompareRotations = 1 + exit + else + CompareRotations = -1 + exit + end if + if (nrNotTested == 0) exit + end do + end function CompareRotations + + ! Subroutine to encode the input string + subroutine Encode(input, encoded, index) + character(len=*), intent(in) :: input + character(len=*), intent(out) :: encoded + integer, intent(out) :: index + integer :: n, i, j, k, incr, v + integer, allocatable :: perm(:) + + n = len(input) + allocate(perm(0:n-1)) + do j = 0, n - 1 + perm(j) = j + end do + + ! Shell sort + incr = 1 + do + incr = 3 * incr + 1 + if (incr >= n) exit + end do + do + incr = incr / 3 + do i = incr, n - 1 + v = perm(i) + j = i + do while (j >= incr) + if(CompareRotations(input, n, perm(j - incr), v) /= 1)exit + perm(j) = perm(j - incr) + j = j - incr + end do + perm(j) = v + end do + if (incr == 1) exit + end do + + ! Create the output + do j = 0, n - 1 + k = perm(j) + encoded(j + 1:j + 1) = input(k + 1:k + 1) + if (k == n - 1) index = j + end do + + deallocate(perm) + end subroutine Encode + + ! Function to decode the encoded string + function Decode(encoded, index) result(decoded) + character(len=*), intent(in) :: encoded + integer, intent(in) :: index + character(len=:), allocatable :: decoded + integer :: charInfo(0:255) + integer, allocatable :: perm(:) + integer :: n, j, k, total, prev + character :: c + + n = len(encoded) + if (n == 0) then + decoded = "" + return + end if + + charInfo = 0 + do j = 0, n - 1 + c = encoded(j + 1:j + 1) + charInfo(ichar(c)) = charInfo(ichar(c)) + 1 + end do + + total = 0 + prev = 0 + do k = 0, 255 + total = total + prev + prev = charInfo(k) + charInfo(k) = total + end do + + allocate(perm(0:n-1)) + do j = 0, n - 1 + c = encoded(j + 1:j + 1) + k = charInfo(ichar(c)) + perm(k) = j + charInfo(ichar(c)) = charInfo(ichar(c)) + 1 + end do + + allocate(character(len=n) :: decoded) + k = 0 + j = index + do + j = perm(j) + decoded(k + 1:k + 1) = encoded(j + 1:j + 1) + k = k + 1 + if (j == index) exit + end do + + if (k < n) then + do j = k, n - 1 + decoded(j + 1:j + 1) = decoded(j - k + 1:j - k + 1) + end do + end if + end function Decode + + ! Subroutine to test the encoding and decoding + subroutine Test(s) + character(len=*), intent(in) :: s + character(len=:), allocatable :: encoded, decoded + integer :: index + + print *, "" + print *, " ", s + allocate(character(len=len(s)) :: encoded) + call Encode(s, encoded, index) + print *, "---> ", encoded + print *, " index = ", index + decoded = Decode(encoded, index) + print *, "---> ", decoded + deallocate(encoded) + end subroutine Test + +end program BurrowsWheeler diff --git a/Task/CRC-32/M2000-Interpreter/crc-32-1.m2000 b/Task/CRC-32/M2000-Interpreter/crc-32-1.m2000 index 52eb55078b..c6073ef05e 100644 --- a/Task/CRC-32/M2000-Interpreter/crc-32-1.m2000 +++ b/Task/CRC-32/M2000-Interpreter/crc-32-1.m2000 @@ -1,25 +1,30 @@ -Module CheckIt { - Function PrepareTable { - Dim Base 0, table(256) - For i = 0 To 255 { - k = i - For j = 0 To 7 { - If binary.and(k,1)=1 Then { - k =binary.Xor(binary.shift(k, -1) , 0xEDB88320) - } Else k=binary.shift(k, -1) - } - table(i) = k - } - =table() - } - crctable=PrepareTable() - crc32= lambda crctable (buf$) -> { - crc =0xFFFFFFFF - For i = 0 To Len(buf$) -1 - crc = binary.xor(binary.shift(crc, -8), array(crctable, binary.xor(binary.and(crc, 0xff), asc(mid$(buf$, i+1, 1))))) - Next i - =0xFFFFFFFF-crc - } - Print crc32("The quick brown fox jumps over the lazy dog")=0x414fa339 +odule CheckIt { + crc32 = lambda ->{ + Function PrepareTable { + buffer t as long * 256 + For i = 0 To 255 + k = i + For j = 0 To 7 + If binary.and(k,1)=1 Then + k =binary.Xor(binary.shift(k, -1) , 0xEDB88320) + Else + k=binary.shift(k, -1) + End If + Next + Return t, i:=k + Next + =t + } + = lambda crctable=PrepareTable() (c, buf$) -> { + crc=0xFFFFFFFF-c + For i = 1 To Len(buf$) + crc = binary.xor(binary.shift(crc, -8), eval(crctable, binary.xor(binary.and(crc, 0xff), asc(mid$(buf$, i, 1))))) + Next i + =0xFFFFFFFF-crc + } + }() ' execute now + Print crc32(0, "The quick brown fox jumps over the lazy dog")=0x414fa339& + Print crc32(crc32(0, "The quick brown fox jumps"), " over the lazy dog")=0x414fa339& + Print crc32(crc32(crc32(0, "The qu"), "ick brown"), " fox jumps over the lazy dog")=0x414fa339& } CheckIt diff --git a/Task/CRC-32/Zig/crc-32.zig b/Task/CRC-32/Zig/crc-32.zig index 10a6bf31c1..629dbde918 100644 --- a/Task/CRC-32/Zig/crc-32.zig +++ b/Task/CRC-32/Zig/crc-32.zig @@ -2,6 +2,6 @@ const std = @import("std"); const Crc32Ieee = std.hash.Crc32; pub fn main() !void { - var res: u32 = Crc32Ieee.hash("The quick brown fox jumps over the lazy dog"); + const res: u32 = Crc32Ieee.hash("The quick brown fox jumps over the lazy dog"); std.debug.print("{x}\n", .{res}); } diff --git a/Task/CSV-data-manipulation/Lua/csv-data-manipulation-1.lua b/Task/CSV-data-manipulation/Lua/csv-data-manipulation-1.lua new file mode 100644 index 0000000000..38f23efa69 --- /dev/null +++ b/Task/CSV-data-manipulation/Lua/csv-data-manipulation-1.lua @@ -0,0 +1,13 @@ +-- Lua has no built in methods to handle csv files. +-- it does have string.gmatch, which we use to global.match whatever isn't a comma + +print(io.read"l" .. ",SUM") +for line in io.lines() do + local fields, sum = {}, 0 + for field in line:gmatch"[^,]+" do + table.insert(fields, field) + sum = sum + field + end + table.insert(fields, sum) + print(table.concat(fields,",")) +end diff --git a/Task/CSV-data-manipulation/Lua/csv-data-manipulation-2.lua b/Task/CSV-data-manipulation/Lua/csv-data-manipulation-2.lua new file mode 100644 index 0000000000..0469930ba1 --- /dev/null +++ b/Task/CSV-data-manipulation/Lua/csv-data-manipulation-2.lua @@ -0,0 +1,26 @@ +local csv={} + +-- read csv file, save records and fields into table +for line in io.lines('file.csv') do + local fields = {} + for field in line:gmatch"[^,]+" do + table.insert(fields, tonumber(field) or field) + end + table.insert(csv, fields) +end + +-- change csv values +table.insert(csv[1], 'SUM') +for i=2,#csv do + local sum=0 + for _, val in ipairs(csv[i]) do + sum = sum + val + end + table.insert(csv[i], sum) +end + +-- Save +local fileHandler = io.open('file.csv', 'w') +for NR, fields in ipairs(csv) do + fileHandler:write(table.concat(fields,","), "\n") +end diff --git a/Task/CSV-data-manipulation/Lua/csv-data-manipulation.lua b/Task/CSV-data-manipulation/Lua/csv-data-manipulation.lua deleted file mode 100644 index 26ddaeabc9..0000000000 --- a/Task/CSV-data-manipulation/Lua/csv-data-manipulation.lua +++ /dev/null @@ -1,31 +0,0 @@ -local csv={} -for line in io.lines('file.csv') do - table.insert(csv, {}) - local i=1 - for j=1,#line do - if line:sub(j,j) == ',' then - table.insert(csv[#csv], line:sub(i,j-1)) - i=j+1 - end - end - table.insert(csv[#csv], line:sub(i,j)) -end - -table.insert(csv[1], 'SUM') -for i=2,#csv do - local sum=0 - for j=1,#csv[i] do - sum=sum + tonumber(csv[i][j]) - end - if sum>0 then - table.insert(csv[i], sum) - end -end - -local newFileData = '' -for i=1,#csv do - newFileData=newFileData .. table.concat(csv[i], ',') .. '\n' -end - -local file=io.open('file.csv', 'w') -file:write(newFileData) diff --git a/Task/CSV-to-HTML-translation/JavaScript/csv-to-html-translation-4.js b/Task/CSV-to-HTML-translation/JavaScript/csv-to-html-translation-4.js new file mode 100644 index 0000000000..1124a5e5d1 --- /dev/null +++ b/Task/CSV-to-HTML-translation/JavaScript/csv-to-html-translation-4.js @@ -0,0 +1,40 @@ +function csvToHtml(input) { + if (!input || typeof input !== 'string') { + throw new Error('Invalid input!'); + } + + function _createTableCell(cellContents, index) { + if (!cellContents || typeof cellContents !== 'string') { + throw new Error('Invalid data!'); + } + + const tableCell = document.createElement( + (index === 0) ? 'th' : 'td' + ); + + tableCell.textContent = cellContents.trim(); + return tableCell; + } + + const rows = input.split('\n'); + const table = document.createElement('table'); + + rows.forEach((row, index) => { + const tableRow = document.createElement('tr'); + const tableCells = row.split(','); + + tableCells.forEach((cell) => { + try { + tableRow.appendChild( + _createTableCell(cell, index), + ); + } catch (error) { + console.error(error); + } + }); + + table.appendChild(tableRow); + }); + + return table; +} diff --git a/Task/CSV-to-HTML-translation/JavaScript/csv-to-html-translation-5.js b/Task/CSV-to-HTML-translation/JavaScript/csv-to-html-translation-5.js new file mode 100644 index 0000000000..986924331b --- /dev/null +++ b/Task/CSV-to-HTML-translation/JavaScript/csv-to-html-translation-5.js @@ -0,0 +1,14 @@ +const inputData = `Character,Speech +The multitude,The messiah! Show us the messiah! +Brians mother,Now you listen here! He's not the messiah; he's a very naughty boy! Now go away! +The multitude,Who are you? +Brians mother,I'm his mother; that's who! +The multitude,Behold his mother! Behold his mother!`; + +try { + document.body.append( + csvToHtml(inputData), + ); +} catch (error) { + console.error(error) +} diff --git a/Task/CUSIP/Langur/cusip-1.langur b/Task/CUSIP/Langur/cusip-1.langur index 544bb91265..df07bf5a9d 100644 --- a/Task/CUSIP/Langur/cusip-1.langur +++ b/Task/CUSIP/Langur/cusip-1.langur @@ -6,7 +6,7 @@ val isCusip = fn(s) { val basechars = '0'..'9' ~ 'A'..'Z' ~ "*@#" val sum = for[=0] i of 8 { - var v = index(s2s(s, i), basechars) + var v = index(basechars, by=s2s(s, of=i)) if not v: return false v = v[1]-1 if i div 2: v *= 2 diff --git a/Task/Caesar-cipher/Langur/caesar-cipher.langur b/Task/Caesar-cipher/Langur/caesar-cipher.langur index 3161281621..7b3a36cc20 100644 --- a/Task/Caesar-cipher/Langur/caesar-cipher.langur +++ b/Task/Caesar-cipher/Langur/caesar-cipher.langur @@ -1,5 +1,5 @@ val rot = fn(s, key) { - cp2s map(fn(c) { rotate(rotate(c, key, 'a'..'z'), key, 'A'..'Z') }, s2cp(s)) + cp2s map(s2cp(s), by=fn(c) { rotate(rotate(c, distance=key, range='a'..'z'), distance=key, range='A'..'Z') }) } val s = "A quick brown fox jumped over something, you know." diff --git a/Task/Calculating-the-value-of-e/ALGOL-W/calculating-the-value-of-e.alg b/Task/Calculating-the-value-of-e/ALGOL-W/calculating-the-value-of-e.alg new file mode 100644 index 0000000000..2e559bfec8 --- /dev/null +++ b/Task/Calculating-the-value-of-e/ALGOL-W/calculating-the-value-of-e.alg @@ -0,0 +1,16 @@ +begin % calculate an approximation to e % + long real epsilon; + long real e0, e, f; + integer n; + epsilon := 1'-14; f := 1; e := n := 2; + while begin + e0 := e; + f := f * n; + n := n + 1; + e := e + 1.0 / f; + abs ( e - e0 ) >= epsilon + end do begin end; + write( I_w := 1, s_w := 0, r_format := "A", r_w := 16, r_d := 14 % <-- sets output formatting % + , "e = ", e, " after ", n - 1, " iterations" + ) +end. diff --git a/Task/Calculating-the-value-of-e/EDSAC-order-code/calculating-the-value-of-e-1.edsac b/Task/Calculating-the-value-of-e/EDSAC-order-code/calculating-the-value-of-e-1.edsac index 84c31ea9eb..d51b3a4a5e 100644 --- a/Task/Calculating-the-value-of-e/EDSAC-order-code/calculating-the-value-of-e-1.edsac +++ b/Task/Calculating-the-value-of-e/EDSAC-order-code/calculating-the-value-of-e-1.edsac @@ -1,5 +1,6 @@ [Calculate e] [EDSAC program, Initial Orders 2] + [2024-12-25 Bug fix: ensure sandwich bit in 35-bit constant is 0] [Library subroutine M3. Prints header and is then overwritten] [Here, last character sets teleprinter to figures] @@ -29,6 +30,8 @@ GK [set @ (theta) for relative addresses] [0] PF PF [build sum 4*(1/3! + 1/4! + 1/5! + ...)] [2] PF PF [term in sum] + T4#ZPF [load time: clear whole of #4, including sandwich bit] + T4Z [load time: resume normal loading] [4] PD PF [2^-34, stop when term < this] [6] PF [divisor] [7] IF [1/2] diff --git a/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-1.hs b/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-1.hs index e7ff6b2acd..d43cad0693 100644 --- a/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-1.hs +++ b/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-1.hs @@ -1,8 +1,7 @@ ------ APPROXIMATION OF E OBTAINED AFTER N ITERATIONS ---- eApprox :: Int -> Double -eApprox n = - (sum . take n) $ (1 /) <$> scanl (*) 1 [1 ..] +eApprox n = sum . map (1 /) $ scanl (*) 1 [1..n] --------------------------- TEST ------------------------- main :: IO () diff --git a/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-3.hs b/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-3.hs index 3b9b856f95..a13155388a 100644 --- a/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-3.hs +++ b/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-3.hs @@ -1,16 +1,4 @@ -{-# LANGUAGE TupleSections #-} - -------------------- APPROXIMATIONS TO E ------------------ - -approximatEs :: [Double] -approximatEs = - fst - <$> iterate - ( \(e, (i, n)) -> - (,) . (e +) . (1 /) <*> (succ i,) $ i * n - ) - (1, (1, 1)) - ---------------------------- TEST ------------------------- -main :: IO () -main = print $ approximatEs !! 17 +eApprox n = snd $ foldr f (1, 1) [n, pred n .. 1] + where + f x (fl, e) = + let y = fl * x in (y, e + 1 / y) diff --git a/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-4.hs b/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-4.hs new file mode 100644 index 0000000000..3b9b856f95 --- /dev/null +++ b/Task/Calculating-the-value-of-e/Haskell/calculating-the-value-of-e-4.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TupleSections #-} + +------------------- APPROXIMATIONS TO E ------------------ + +approximatEs :: [Double] +approximatEs = + fst + <$> iterate + ( \(e, (i, n)) -> + (,) . (e +) . (1 /) <*> (succ i,) $ i * n + ) + (1, (1, 1)) + +--------------------------- TEST ------------------------- +main :: IO () +main = print $ approximatEs !! 17 diff --git a/Task/Calendar/EasyLang/calendar.easy b/Task/Calendar/EasyLang/calendar.easy index 72c2661b82..b785fed23d 100644 --- a/Task/Calendar/EasyLang/calendar.easy +++ b/Task/Calendar/EasyLang/calendar.easy @@ -1,4 +1,5 @@ year = 1969 +# year = number substr timestr systime 1 4 # wkdays$ = "Su Mo Tu We Th Fr Sa" pagewide = 80 diff --git a/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function-1.c b/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function-1.c deleted file mode 100644 index c37f86a156..0000000000 --- a/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function-1.c +++ /dev/null @@ -1,24 +0,0 @@ -#include -#include - -int main(int argc,char** argv) { - - int arg1 = atoi(argv[1]), arg2 = atoi(argv[2]), sum, diff, product, quotient, remainder ; - - __asm__ ( "addl %%ebx, %%eax;" : "=a" (sum) : "a" (arg1) , "b" (arg2) ); - __asm__ ( "subl %%ebx, %%eax;" : "=a" (diff) : "a" (arg1) , "b" (arg2) ); - __asm__ ( "imull %%ebx, %%eax;" : "=a" (product) : "a" (arg1) , "b" (arg2) ); - - __asm__ ( "movl $0x0, %%edx;" - "movl %2, %%eax;" - "movl %3, %%ebx;" - "idivl %%ebx;" : "=a" (quotient), "=d" (remainder) : "g" (arg1), "g" (arg2) ); - - printf( "%d + %d = %d\n", arg1, arg2, sum ); - printf( "%d - %d = %d\n", arg1, arg2, diff ); - printf( "%d * %d = %d\n", arg1, arg2, product ); - printf( "%d / %d = %d\n", arg1, arg2, quotient ); - printf( "%d %% %d = %d\n", arg1, arg2, remainder ); - - return 0 ; -} diff --git a/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function-2.c b/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function-2.c deleted file mode 100644 index f6729d9aa6..0000000000 --- a/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function-2.c +++ /dev/null @@ -1,16 +0,0 @@ -#include - -int main() -{ - Py_Initialize(); - PyRun_SimpleString("a = [3*x for x in range(1,11)]"); - - PyRun_SimpleString("print 'First 10 multiples of 3 : ' + str(a)"); - - PyRun_SimpleString("print 'Last 5 multiples of 3 : ' + str(a[5:])"); - - PyRun_SimpleString("print 'First 10 multiples of 3 in reverse order : ' + str(a[::-1])"); - - Py_Finalize(); - return 0; -} diff --git a/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function.c b/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function.c new file mode 100644 index 0000000000..4e0643695b --- /dev/null +++ b/Task/Call-a-foreign-language-function/C/call-a-foreign-language-function.c @@ -0,0 +1,35 @@ +#include +#include +#include + +#include +#include + +const char * const lua_code = "print('tau = ' .. 8*math.atan(1))"; + +int +main(void) +{ + lua_State* L; + + /* initialize lua */ + L = luaL_newstate(); + luaL_openlibs(L); /* allows use of lua's standard libraries e.g. math */ + + /* load and run the code */ + if (luaL_loadstring(L, lua_code) != LUA_OK) { + fprintf(stderr, "Error loading lua code\n"); + return EXIT_FAILURE; + } + + if (lua_pcall(L, 0, 0, 0) != LUA_OK) { + fprintf(stderr, "Error running lua code\n"); + return EXIT_FAILURE; + } + + /* tidy up */ + lua_pop(L, lua_gettop(L)); + lua_close(L); + + return 0; +} diff --git a/Task/Call-a-foreign-language-function/M2000-Interpreter/call-a-foreign-language-function-5.m2000 b/Task/Call-a-foreign-language-function/M2000-Interpreter/call-a-foreign-language-function-5.m2000 index 7a98009d84..a8f20f1814 100644 --- a/Task/Call-a-foreign-language-function/M2000-Interpreter/call-a-foreign-language-function-5.m2000 +++ b/Task/Call-a-foreign-language-function/M2000-Interpreter/call-a-foreign-language-function-5.m2000 @@ -1,14 +1,14 @@ Module checkit { Static DisplayOnce=0 - N=100000 + N=1000000 Read ? N Form 60 Pen 14 Background { Cls 5} Cls 5 - \\ use f1 do unload lib - because only New statemend unload it + ' use f1 do unload lib - because only New statemend unload it FKEY 1,"save ctst1:new:load ctst1" - \\ We use a function as string container, because c code can easy color decorated in M2000. + ' We use a function as string container, because c code can easy color decorated in M2000. Function ccode { long primes(long a[], long b) { @@ -52,53 +52,54 @@ Module checkit { return 0; } } - \\ extract code. &functionname() is a string with the code inside "{ }" - \\ a reference to function actual is code of function in m2000 - \\ using Document object we have an easy way to drop paragraphs + ' extract code. &functionname() is a string with the code inside "{ }" + ' a reference to function actual is code of function in m2000 + ' using Document object we have an easy way to drop paragraphs document code$=Mid$(&ccode(), 2, len(&ccode())-2) - \\ remove 1st line two times \\ one line for an edit information from interpreter - \\ paragraph$(code$, 1) export paragraph 1st,using third parameter -1 means delete after export. + ' remove 1st line two times ' one line for an edit information from interpreter + ' paragraph$(code$, 1) export paragraph 1st,using third parameter -1 means delete after export. drop$=paragraph$(code$,1,-1)+paragraph$(code$,1,-1) If DisplayOnce Else { + If exist(temporary$+"MyName.dll") then dos "del "+temporary$+"MyName.*", 200; Report 2, "c code for primes" - Report code$ \\ report stop after 3/4 of screen lines use. Press spacebar or mouse button to continue + Report code$ ' report stop after 3/4 of screen lines use. Press spacebar or mouse button to continue DisplayOnce++ } - \\ dos "del c:\MyName.*", 200; - If not exist("c:\MyName.dll") then { + + If not exist(temporary$+"MyName.dll") then { Report 2, "Now we have to make a dll" - Rem : Load Make \\ we can use a Make.gsb in current folder - this is the user folder for now + Rem : Load Make ' we can use a Make.gsb in current folder - this is the user folder for now Module MAKE ( fname$, code$, timeout ) { if timeout<1000 then timeout=1000 If left$(fname$,2)="My" Else Error "Not proper name - use 'My' as first two letters" Print "Delete old files" - try { remove "c:\MyName" } - Dos "del c:\"+fname$+".*", timeout; + try { remove temporary$+"MyName" } + Dos "del "+temporary$+fname$+".*", timeout; Print "Save c file" - Open "c:\"+fname$+".c" for output as F \\ use of non unicode output + Open temporary$+fname$+".c" for output as F ' use of non unicode output Print #F, code$ Close #F - \\ use these two lines for opening dos console and return to M2000 command line - rem : Dos "cd c:\ && gcc -c -DBUILD_DLL "+fname$+".c" + ' use these two lines for opening dos console and return to M2000 command line + rem : Dos "cd " +temporary$+" && gcc -c -DBUILD_DLL "+fname$+".c" rem : Error "Check for errors" - \\ by default we give a time to process dos command and then continue + ' by default we give a time to process dos command and then continue Print "make object file" - dos "cd c:\ && gcc -c -DBUILD_DLL "+fname$+".c" , timeout; - if exist("c:\"+fname$+".o") then { + dos "cd " +temporary$+" && gcc -c -DBUILD_DLL "+fname$+".c" , timeout; + if exist(temporary$+fname$+".o") then { Print "make dll" - dos "cd c:\ && gcc -shared -o "+fname$+".dll "+fname$+".o -Wl,--out-implib,libmessage.a", timeout; + dos "cd " +temporary$+" && gcc -shared -o "+fname$+".dll "+fname$+".o -Wl,--out-implib,libmessage.a", timeout; } else Error "No object file - Error" - if not exist("c:\"+fname$+".dll") then Error "No dll - Error" + if not exist(temporary$+fname$+".dll") then Error "No dll - Error" } Make "MyName", code$, 1000 } - Declare primes lib c "c:\MyName.primes" {long c, long d} \\ c after lib mean CDecl call - \\ So now we can check error - \\ make a Buffer (add two more longs for any purpose) - Buffer Clear A as Long*(N+2) \\ so A(0) is base address, of an array of 100002 long (unsign for M2000). - \\ profiler enable a timecount + Declare primes lib c temporary$+"MyName.primes" {long c, long d} ' c after lib mean CDecl call + ' So now we can check error + ' make a Buffer (add two more longs for any purpose) + Buffer Clear A as Long*(N+2) ' so A(0) is base address, of an array of 100002 long (unsign for M2000). + ' profiler enable a timecount profiler Call primes(A(0), N) m=timecount @@ -118,7 +119,8 @@ Module checkit { Print } Print format$("Compute {0} primes in range 1 to {1}, in msec:{2:3}", total, N, m) - \\ unload dll, we have to use exactly the same name, as we use it in declare except for last chars ".dll" - remove "c:\MyName" + ' unload dll, we have to use exactly the same name, as we use it in declare except for last chars ".dll" + remove temporary$+"MyName" } +' use clear statement to clear static variables before run this, to make new dll checkit diff --git a/Task/Call-a-function/Langur/call-a-function-6.langur b/Task/Call-a-function/Langur/call-a-function-6.langur index 1efc364d84..846df84db9 100644 --- a/Task/Call-a-function/Langur/call-a-function-6.langur +++ b/Task/Call-a-function/Langur/call-a-function-6.langur @@ -1 +1 @@ -mapX(amb, wordsets...) +testfn(a, b, wordsets...) diff --git a/Task/Call-an-object-method/BQN/call-an-object-method.bqn b/Task/Call-an-object-method/BQN/call-an-object-method.bqn new file mode 100644 index 0000000000..eb5f410f28 --- /dev/null +++ b/Task/Call-an-object-method/BQN/call-an-object-method.bqn @@ -0,0 +1,7 @@ +foo ← { + Spam ⇐ {𝕊: "Wonderful Spam!!!"} + Eggs ⇐ {𝕨+𝕩} +} + +•Show 1 foo.Eggs 2 + foo.Spam@ diff --git a/Task/Canonicalize-CIDR/EasyLang/canonicalize-cidr.easy b/Task/Canonicalize-CIDR/EasyLang/canonicalize-cidr.easy index 64d7aae038..7c1c9054e8 100644 --- a/Task/Canonicalize-CIDR/EasyLang/canonicalize-cidr.easy +++ b/Task/Canonicalize-CIDR/EasyLang/canonicalize-cidr.easy @@ -1,23 +1,15 @@ func$ can_cidr s$ . - n[] = number strsplit s$ "./" - if len n[] <> 5 - return "" - . + n[] = number strtok s$ "./" + if len n[] <> 5 : return "" for i to 4 - if n[i] < 0 or n[i] > 255 - return "" - . + if n[i] < 0 or n[i] > 255 : return "" ad = ad * 256 + n[i] . - if n[5] > 31 or n[5] < 1 - return "" - . + if n[5] > 31 or n[5] < 1 : return "" mask = bitnot (bitshift 1 (32 - n[5]) - 1) ad = bitand ad mask for i to 4 - if r$ <> "" - r$ = "." & r$ - . + if r$ <> "" : r$ = "." & r$ r$ = ad mod 256 & r$ ad = ad div 256 . diff --git a/Task/Canonicalize-CIDR/FreeBASIC/canonicalize-cidr.basic b/Task/Canonicalize-CIDR/FreeBASIC/canonicalize-cidr.basic index 97b62bc879..bd4af5e919 100644 --- a/Task/Canonicalize-CIDR/FreeBASIC/canonicalize-cidr.basic +++ b/Task/Canonicalize-CIDR/FreeBASIC/canonicalize-cidr.basic @@ -1,54 +1,99 @@ -#lang "qb" +Const MAX_OCTET = 255 +Const MIN_NETWORK = 1 +Const MAX_NETWORK = 32 +Const OCTET_BITS = 8 -REM THE Binary OPS ONLY WORK On SIGNED 16-Bit NUMBERS -REM SO WE STORE THE IP ADDRESS As AN ARRAY OF FOUR OCTETS -Cls -Dim IP(3) -Do - REM Read DEMO Data - 140 Read CI$ - If CI$ = "" Then Exit Do 'Sleep: End - REM FIND / - SL = 0 - For I = Len(CI$) To 1 Step -1 - If Mid$(CI$,I,1) = "/" Then SL = I : I = 1 - Next I - If SL = 0 Then Print "INVALID CIDR STRING: '"; CI$; "'": Goto 140 - NW = Val(Mid$(CI$,SL+1)) - If NW < 1 Or NW > 32 Then Print "INVALID NETWORK WIDTH:"; NW: Goto 140 - REM PARSE OCTETS INTO IP ARRAY - BY = 0 : N = 0 - For I = 1 To SL-1 - C$ = Mid$(CI$,I,1) - If Not (C$ <> ".") Then - IP(N) = BY : N = N + 1 - BY = 0 - If IP(N-1) < 256 Then 310 - Print "INVALID OCTET VALUE:"; IP(N-1): Goto 140 - Else C = Val(C$):If C Or (C$="0") Then BY = BY*10+C +Type IPAddress + octets(3) As Integer +End Type + +Function isDigit(Byval ch As String) As Boolean + Return (Asc(ch) >= Asc("0")) And (Asc(ch) <= Asc("9")) +End Function + +Function ParseIPAddress(cidr As String, Byref networkWidth As Integer) As IPAddress + Dim As IPAddress ip + Dim As Integer slashPos = Instr(cidr, "/") + Dim As String ipPart = Left(cidr, slashPos - 1) + + networkWidth = Val(Mid(cidr, slashPos + 1)) + + Dim As Integer i, currentOctet = 0, octetValue = 0 + For i = 1 To Len(ipPart) + If Mid(ipPart, i, 1) = "." Then + ip.octets(currentOctet) = octetValue + currentOctet += 1 + octetValue = 0 + Elseif IsDigit(Mid(ipPart, i, 1)) Then + octetValue = octetValue * 10 + Val(Mid(ipPart, i, 1)) End If - 310 ' - Next I - IP(N) = BY : N = N + 1 - If IP(N-1) > 255 Then Print "INVALID OCTET VALUE:"; IP(N-1): Goto 140 - REM NUMBER OF COMPLETE OCTETS IN NETWORK PART - NB = Int(NW/8) - REM NUMBER OF NETWORK BITS IN PARTIAL OCTET - XB = NW And 7 - REM ZERO Out HOST BITS IN PARTIAL OCTET - IP(NB) = IP(NB) And (255 - 2^(8-XB) + 1) - REM And SET Any ALL-HOST OCTETS To 0 - If NB < 3 Then For I = NB +1 To 3 : IP(I) = 0 : Next I - REM Print Out THE RESULT - Print Mid$(Str$(IP(0)),2); - For I = 1 To 3 - Print "."; Mid$(Str$(IP( I)),2); - Next I - Print Mid$(CI$,SL) -Loop -Data "87.70.141.1/22", "36.18.154.103/12", "62.62.197.11/29" -Data "67.137.119.181/4", "161.214.74.21/24", "184.232.176.184/18" -REM SOME INVALID INPUTS -Data "127.0.0.1", "123.45.67.89/0", "98.76.54.32/100", "123.456.789.0/12" + Next + ip.octets(currentOctet) = octetValue + + Return ip +End Function + +Function ApplyNetworkMask(ip As IPAddress, networkWidth As Integer) As IPAddress + Dim As IPAddress result = ip + Dim As Integer completeOctets = networkWidth \ OCTET_BITS + Dim As Integer remainingBits = networkWidth And 7 + + ' Apply mask to partial octet + If completeOctets < 4 Then + result.octets(completeOctets) And= (MAX_OCTET - 2^(OCTET_BITS-remainingBits) + 1) + ' Zero remaining octets + For i As Integer = completeOctets + 1 To 3 + result.octets(i) = 0 + Next + End If + + Return result +End Function + +Function ValidateInput(ip As IPAddress, networkWidth As Integer, cidr As String) As Boolean + If Instr(cidr, "/") = 0 Then + Print "INVALID CIDR STRING: '"; cidr; "'" + Return False + End If + + If networkWidth < MIN_NETWORK Or networkWidth > MAX_NETWORK Then + Print "INVALID NETWORK WIDTH:"; networkWidth + Return False + End If + + For i As Integer = 0 To 3 + If ip.octets(i) > MAX_OCTET Then + Print "INVALID OCTET VALUE:"; ip.octets(i) + Return False + End If + Next + + Return True +End Function + +Sub ProcessCIDR(cidr As String) + Dim As Integer networkWidth + Dim As IPAddress ip = ParseIPAddress(cidr, networkWidth) + + If Not ValidateInput(ip, networkWidth, cidr) Then Exit Sub + + ip = ApplyNetworkMask(ip, networkWidth) + + Dim As String result = Str(ip.octets(0)) + For i As Integer = 1 To 3 + result &= "." & Str(ip.octets(i)) + Next + Print result & "/" & networkWidth +End Sub + +' Main program +Dim As String cidr(9) = { _ +"87.70.141.1/22", "36.18.154.103/12", "62.62.197.11/29", _ +"67.137.119.181/4", "161.214.74.21/24", "184.232.176.184/18", _ +"127.0.0.1", "123.45.67.89/0", "98.76.54.32/100", "123.456.789.0/12" } + +For i As Integer = 0 To 9 + ProcessCIDR(cidr(i)) +Next Sleep diff --git a/Task/Cantor-set/V-(Vlang)/cantor-set.v b/Task/Cantor-set/V-(Vlang)/cantor-set.v index 42d284fa1b..4da07c3172 100644 --- a/Task/Cantor-set/V-(Vlang)/cantor-set.v +++ b/Task/Cantor-set/V-(Vlang)/cantor-set.v @@ -5,12 +5,10 @@ const ( fn cantor(mut lines [][]u8, start int, len int, index int) { seg := len / 3 - if seg == 0 { - return - } + if seg == 0 {return} for i in index.. height { for j in start + seg..start + 2 * seg { - lines[i][j] = ' '[0] + lines[i][j] = " " [0] } } cantor(mut lines, start, seg, index + 1) diff --git a/Task/Cartesian-product-of-two-or-more-lists/Langur/cartesian-product-of-two-or-more-lists.langur b/Task/Cartesian-product-of-two-or-more-lists/Langur/cartesian-product-of-two-or-more-lists.langur index 88328fabe6..41c5649210 100644 --- a/Task/Cartesian-product-of-two-or-more-lists/Langur/cartesian-product-of-two-or-more-lists.langur +++ b/Task/Cartesian-product-of-two-or-more-lists/Langur/cartesian-product-of-two-or-more-lists.langur @@ -1,16 +1,16 @@ val X = fn ...x:x -writeln mapX(X, [1, 2], [3, 4]) == [[1, 3], [1, 4], [2, 3], [2, 4]] -writeln mapX(X, [3, 4], [1, 2]) == [[3, 1], [3, 2], [4, 1], [4, 2]] -writeln mapX(X, [1, 2], []) == [] -writeln mapX(X, [], [1, 2]) == [] +writeln mapX([1, 2], [3, 4], by=X) == [[1, 3], [1, 4], [2, 3], [2, 4]] +writeln mapX([3, 4], [1, 2], by=X) == [[3, 1], [3, 2], [4, 1], [4, 2]] +writeln mapX([1, 2], [], by=X) == [] +writeln mapX([], [1, 2], by=X) == [] writeln() -writeln mapX(X, [1776, 1789], [7, 12], [4, 14, 23], [0, 1]) +writeln mapX([1776, 1789], [7, 12], [4, 14, 23], [0, 1], by=X) writeln() -writeln mapX(X, [1, 2, 3], [30], [500, 100]) +writeln mapX([1, 2, 3], [30], [500, 100], by=X) writeln() -writeln mapX(X, [1, 2, 3], [], [500, 100]) +writeln mapX([1, 2, 3], [], [500, 100], by=X) writeln() diff --git a/Task/Cartesian-product-of-two-or-more-lists/Quackery/cartesian-product-of-two-or-more-lists.quackery b/Task/Cartesian-product-of-two-or-more-lists/Quackery/cartesian-product-of-two-or-more-lists.quackery index f5d68fb2af..f4e6d266e1 100644 --- a/Task/Cartesian-product-of-two-or-more-lists/Quackery/cartesian-product-of-two-or-more-lists.quackery +++ b/Task/Cartesian-product-of-two-or-more-lists/Quackery/cartesian-product-of-two-or-more-lists.quackery @@ -1,13 +1,26 @@ - [ [] unrot + [ [] temp put swap witheach - [ over witheach - [ over nested - swap nested join - nested dip rot join - unrot ] - drop ] drop ] is cartprod ( [ [ --> [ ) + [ [] temp put + over witheach + [ dip dup join + nested temp gather ] + drop temp take + temp gather ] + drop temp take ] is cart ( [ [ --> [ ) - ' [ 1 2 ] ' [ 3 4 ] cartprod echo cr - ' [ 3 4 ] ' [ 1 2 ] cartprod echo cr - ' [ 1 2 ] ' [ ] cartprod echo cr - ' [ ] ' [ 1 2 ] cartprod echo cr + [ behead swap witheach cart ] is n-cart ( [ --> [ ) + + ' [ 1 2 ] ' [ 3 4 ] cart echo cr cr + ' [ 1 2 ] ' [ ] cart echo cr cr + ' [ ] ' [ 1 2 ] cart echo cr cr + + ' [ [ 1776 1789 ] [ 7 12 ] [ 4 14 23 ] [ 0 1 ] ] n-cart + say "[ " + witheach + [ i^ 0 != if [ say " " ] + echo + i 0 = if [ say " ]" ] cr ] + cr + + ' [ [ 1 2 3 ] [ 30 ] [ 500 100 ] ] n-cart echo cr cr + ' [ [ 1 2 3 ] [ ] [ 500 100 ] ] n-cart echo cr cr diff --git a/Task/Case-sensitivity-of-identifiers/GW-BASIC/case-sensitivity-of-identifiers.basic b/Task/Case-sensitivity-of-identifiers/GW-BASIC/case-sensitivity-of-identifiers.basic deleted file mode 100644 index 33a43f9953..0000000000 --- a/Task/Case-sensitivity-of-identifiers/GW-BASIC/case-sensitivity-of-identifiers.basic +++ /dev/null @@ -1,5 +0,0 @@ -10 dog$ = "Benjamin" -20 dog$ = "Smokey" -30 dog$ = "Samba" -40 dog$ = "Bernie" -50 print "There is just one dog, named ";dog$ diff --git a/Task/Case-sensitivity-of-identifiers/Joy/case-sensitivity-of-identifiers.joy b/Task/Case-sensitivity-of-identifiers/Joy/case-sensitivity-of-identifiers.joy new file mode 100644 index 0000000000..5e074a15e6 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Joy/case-sensitivity-of-identifiers.joy @@ -0,0 +1,17 @@ +DEFINE dog == "Benjamin". +DEFINE Dog == "Samba". +DEFINE DOG == "Bernie". +"The three dogs are named" +"." DOG "and" Dog "," dog "The three dogs are named" +. +"The three dogs are named" +. +"Benjamin" +. +"," +. +"Samba" +. +"and" +. +"Bernie" diff --git a/Task/Catalan-numbers-Pascals-triangle/FutureBasic/catalan-numbers-pascals-triangle.basic b/Task/Catalan-numbers-Pascals-triangle/FutureBasic/catalan-numbers-pascals-triangle.basic new file mode 100644 index 0000000000..f8d7a51702 --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/FutureBasic/catalan-numbers-pascals-triangle.basic @@ -0,0 +1,20 @@ + local fn CatalanNumbers( levels as int ) + int k, n + double num, den, cat + + printf @"1" + + for n = 2 to levels + num = 1 : den = 1 + for k = 2 to n + num *= ( n + k ) + den *= k + cat = num / den + next + printf @"%.f", cat + next +end fn + +fn CatalanNumbers( 30 ) + +HandleEvents diff --git a/Task/Catalan-numbers-Pascals-triangle/PascalABC.NET/catalan-numbers-pascals-triangle.pas b/Task/Catalan-numbers-Pascals-triangle/PascalABC.NET/catalan-numbers-pascals-triangle.pas new file mode 100644 index 0000000000..f031c01feb --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/PascalABC.NET/catalan-numbers-pascals-triangle.pas @@ -0,0 +1,14 @@ +const + n = 15; + +begin + var t: array[0..n + 1] of integer; + t[1] := 1; + for var i := 1 to n do + begin + for var j := i downto 1 do t[j] += t[j - 1]; + t[i + 1] := t[i]; + for var j := i + 1 downto 1 do t[j] += t[j - 1]; + print(t[i + 1] - t[i]); + end; +end. diff --git a/Task/Catalan-numbers/EDSAC-order-code/catalan-numbers.edsac b/Task/Catalan-numbers/EDSAC-order-code/catalan-numbers.edsac index 2c170a456d..4a49996986 100644 --- a/Task/Catalan-numbers/EDSAC-order-code/catalan-numbers.edsac +++ b/Task/Catalan-numbers/EDSAC-order-code/catalan-numbers.edsac @@ -12,9 +12,9 @@ Must be loaded at an even address. Input: Number is at 0D.] T 56 K - GKA3FT42@A47@T31@ADE10@T31@A48@T31@SDTDH44#@NDYFLDT4DS43@TF - H17@S17@A43@G23@UFS43@T1FV4DAFG50@SFLDUFXFOFFFSFL4FT4DA49@T31@ - A1FA43@G20@XFP1024FP610D@524D!FO46@O26@XFO46@SFL8FT4DE39@ + GKA3FT42@A47@T31@ADE10@T31@A48@T31@SDTDH44#@NDYFLDT4DS43@TFH17@ + S17@A43@G23@UFS43@T1FV4DAFG50@SFLDUFXFOFFFSFL4FT4DA49@T31@A1FA43@ + G20@XFT44#ZPFT43ZP1024FP610D@524D!FO46@O26@XFO46@SFL8FT4DE39@ [Main routine] T 120 K [load at 120] diff --git a/Task/Catalan-numbers/Haskell/catalan-numbers-1.hs b/Task/Catalan-numbers/Haskell/catalan-numbers-1.hs new file mode 100644 index 0000000000..54c01db03f --- /dev/null +++ b/Task/Catalan-numbers/Haskell/catalan-numbers-1.hs @@ -0,0 +1,9 @@ +infixl 7 *. +(*.) :: Num a => a -> [a] -> [a] +x *. (p:ps) = x*p : x*.ps + +instance Num a => Num [a] where + negate = map negate + (+) = zipWith (+) + (*) (p:ps) (q:qs) = p*q : ((p*.qs) + ps*(q:qs)) + fromInteger n = fromInteger n:repeat 0 diff --git a/Task/Catalan-numbers/Haskell/catalan-numbers-2.hs b/Task/Catalan-numbers/Haskell/catalan-numbers-2.hs new file mode 100644 index 0000000000..59351ad478 --- /dev/null +++ b/Task/Catalan-numbers/Haskell/catalan-numbers-2.hs @@ -0,0 +1,2 @@ +catalan :: [Integer] +catalan = 1 : catalan^2 diff --git a/Task/Catalan-numbers/Haskell/catalan-numbers-3.hs b/Task/Catalan-numbers/Haskell/catalan-numbers-3.hs new file mode 100644 index 0000000000..ef200970ea --- /dev/null +++ b/Task/Catalan-numbers/Haskell/catalan-numbers-3.hs @@ -0,0 +1,2 @@ +ghci> take 15 catalan +[1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900,2674440] diff --git a/Task/Catalan-numbers/Haskell/catalan-numbers.hs b/Task/Catalan-numbers/Haskell/catalan-numbers-4.hs similarity index 100% rename from Task/Catalan-numbers/Haskell/catalan-numbers.hs rename to Task/Catalan-numbers/Haskell/catalan-numbers-4.hs diff --git a/Task/Catalan-numbers/Langur/catalan-numbers.langur b/Task/Catalan-numbers/Langur/catalan-numbers.langur index 81d8b2e82f..51ff6b65a4 100644 --- a/Task/Catalan-numbers/Langur/catalan-numbers.langur +++ b/Task/Catalan-numbers/Langur/catalan-numbers.langur @@ -1,4 +1,4 @@ -val factorial = fn x:if(x < 2: 1; x * self(x - 1)) +val factorial = fn x:if(x < 2: 1; x * fn((x - 1))) val catalan = fn n:factorial(2 * n) / factorial(n+1) / factorial(n) diff --git a/Task/Catamorphism/Lua/catamorphism.lua b/Task/Catamorphism/Lua/catamorphism-1.lua similarity index 100% rename from Task/Catamorphism/Lua/catamorphism.lua rename to Task/Catamorphism/Lua/catamorphism-1.lua diff --git a/Task/Catamorphism/Lua/catamorphism-2.lua b/Task/Catamorphism/Lua/catamorphism-2.lua new file mode 100644 index 0000000000..29a7baf0fa --- /dev/null +++ b/Task/Catamorphism/Lua/catamorphism-2.lua @@ -0,0 +1,19 @@ +function foldl(func, init, array) + assert(type(func) == "function", "type(fn) == " .. type(func)) + assert(type(array) == "table", "type(array) == " .. type(array)) + local result = init + for v in ipairs(array) do + result = func(result, v) + end + return result +end + +function add(x, y) return x + y end +mul = function(x, y) return x * y end + +nums = {1,2,3,4,5,6,7,8,9} +print("add 1 to 9 ", foldl(add, 0, nums)) +print("multiply", foldl(mul, 1, nums)) +-- uses anonymous function +print("concatenate", + foldl(function(x,y) return x .. y end, "", nums)) diff --git a/Task/Catamorphism/Pascal/catamorphism.pas b/Task/Catamorphism/Pascal/catamorphism.pas index ad363522b6..e17cca17ba 100644 --- a/Task/Catamorphism/Pascal/catamorphism.pas +++ b/Task/Catamorphism/Pascal/catamorphism.pas @@ -1,53 +1,38 @@ program reduceApp; +{$modeswitch classicProcVars+} + +{Works in many modes with Free Pascal Compiler: +fpc, objfpc, delphi, macpas, iso, extendedpascal} + type -// tmyArray = array of LongInt; - tmyArray = array[-5..5] of LongInt; - tmyFunc = function (a,b:LongInt):LongInt; + Num = LongInt; // this can be changed to Real if desired + BinaryFunc = function(a, b: Num): Num; -function add(x,y:LongInt):LongInt; -begin - add := x+y; -end; +function add(x, y: Num): Num; begin add := x + y; end; +function sub(x, y: Num): Num; begin sub := x - y; end; +function mul(x, y: Num): Num; begin mul := x * y; end; -function sub(k,l:LongInt):LongInt; -begin - sub := k-l; -end; - -function mul(r,t:LongInt):LongInt; -begin - mul := r*t; -end; - -function reduce(myFunc:tmyFunc;a:tmyArray):LongInt; +function reduce(func: BinaryFunc; a: array of Num): Num; var - i,res : LongInt; + i: Integer; + answer: Num; begin - res := a[low(a)]; - For i := low(a)+1 to high(a) do - res := myFunc(res,a[i]); - reduce := res; + answer := a[low(a)]; + for i := low(a)+1 to high(a) do + answer := func(answer, a[i]); + reduce := answer; // return answer end; -procedure InitMyArray(var a:tmyArray); -var - i: LongInt; -begin - For i := low(a) to high(a) do - begin - //no a[i] = 0 - a[i] := i + ord(i=0); - write(a[i],','); - end; - writeln(#8#32); -end; - -var - ma : tmyArray; +VAR + // dynamic array + ma: array of Num; + // static arrays + mb: array[1..9] of Num = (1,2,3,4,5,6,7,8,9); + mc: array[0..8] of Num = (1,2,3,4,5,6,7,8,9); BEGIN - InitMyArray(ma); - writeln(reduce(@add,ma)); - writeln(reduce(@sub,ma)); - writeln(reduce(@mul,ma)); + ma := [1,2,3,4,5,6,7,8,9]; + writeln(reduce(add, ma)); + writeln(reduce(sub, mb)); + writeln(reduce(mul, mc)); END. diff --git a/Task/Chaocipher/EasyLang/chaocipher.easy b/Task/Chaocipher/EasyLang/chaocipher.easy index f748565f29..3d9af716be 100644 --- a/Task/Chaocipher/EasyLang/chaocipher.easy +++ b/Task/Chaocipher/EasyLang/chaocipher.easy @@ -1,8 +1,6 @@ proc index c$ . a$[] ind . for ind = 1 to len a$[] - if a$[ind] = c$ - return - . + if a$[ind] = c$ : return . ind = 0 . @@ -14,12 +12,9 @@ func$ chao txt$ mode . right$[] = strchars right$ len tmp$[] 26 for c$ in strchars txt$ - # print strjoin left$[] & " " & strjoin right$[] if mode = 1 index c$ right$[] ind - if ind = 0 - return "" - . + if ind = 0 : return "" r$ &= left$[ind] else index c$ left$[] ind diff --git a/Task/Chaocipher/Fortran/chaocipher.f b/Task/Chaocipher/Fortran/chaocipher.f new file mode 100644 index 0000000000..ef2f081da9 --- /dev/null +++ b/Task/Chaocipher/Fortran/chaocipher.f @@ -0,0 +1,190 @@ +! +!This program implements the **Chaocipher encryption algorithm** in FORTRAN, extended to handle all printable ASCII characters (32-127). +! The Chaocipher is a polyalphabetic cipher invented by John F. Byrne in 1918, which dynamically permutes two alphabets after +! processing each character, making it highly secure and resistant to cryptanalysis. +! +!#### Key Features: +!1. **Initialization**: +! - Two alphabets (`left` and `right`) are initialized with shuffled ASCII characters (32-127). +! - The `plaintext` is set to "WELLDONEISBETTERTHANWELLSAID". +! +!2. **Enciphering**: +! - For each character in the plaintext: +! - Locate the character in the `right` alphabet. +! - Find the corresponding ciphertext character in the `left` alphabet. +! - Permute both alphabets based on the Chaocipher rules: +! - The `left` alphabet is rotated to bring the ciphertext character to the top, and a specific character is moved to a new position. +! - The `right` alphabet is similarly rotated, with an additional rotation step. +! +!3. **Deciphering**: +! - The ciphertext is decrypted back into plaintext using the reverse process: +! - Locate the ciphertext character in the `left` alphabet. +! - Find the corresponding plaintext character in the `right` alphabet. +! - Permute both alphabets identically as in enciphering. +! +!4. **Verification**: +! - After enciphering and deciphering, the program compares the original plaintext with the decrypted text to ensure correctness. +! +!#### Output: +!The program prints: +!- Initial left and right alphabets. +!- Enciphered ciphertext. +!- Deciphered plaintext. +!- A success message if decryption matches the original plaintext. +! +!#### Example Execution: +!For input plaintext "WELLDONEISBETTERTHANWELLSAID", the program outputs: +!- Ciphertext: `OAHQHCNYNXTSZJRRHJBYHQKSOUJY` +!- Decrypted Text: `WELLDONEISBETTERTHANWELLSAID` +!- Verification: "Decryption successful: plaintext matches decrypted text." +! +!This implementation demonstrates both encryption and decryption processes while adhering to Chaocipher's dynamic permutation rules, +!extended for modern ASCII characters. +! +! +PROGRAM Chaocipher + IMPLICIT NONE + CHARACTER(LEN=96) :: left, right, left_orig, right_orig + CHARACTER(LEN=1000) :: plaintext, ciphertext, decrypted + INTEGER :: i, len, ascii_start + LOGICAL :: trace + + ! Initialize alphabets and input + CALL initialize_alphabets(left, right) + left_orig = left + right_orig = right + plaintext = 'Well, when I was in Egypt, I had a conversation with the Sphinx! She taught me how to sew.' + ciphertext = '' + decrypted = '' + trace = .FALSE. + ascii_start = 32 ! ASCII start at space character + + len = LEN_TRIM(plaintext) + + PRINT *, 'Initial Left: ', left + PRINT *, 'Initial Right:', right + PRINT *, 'Plaintext: ', TRIM(plaintext) + + ! Encipher + DO i = 1, len + CALL encipher(plaintext(i:i), ciphertext(i:i), left, right, ascii_start) + IF (trace) THEN + PRINT *, 'Step ', i + PRINT *, 'Left: ', left + PRINT *, 'Right: ', right + END IF + END DO + + PRINT *, 'Ciphertext: ', TRIM(ciphertext) + + ! Reset alphabets for deciphering + left = left_orig + right = right_orig + + ! Decipher + DO i = 1, len + CALL decipher(ciphertext(i:i), decrypted(i:i), left, right, ascii_start) + END DO + + PRINT *, 'Decrypted: ', TRIM(decrypted) + + ! Check for correctness + IF (plaintext == decrypted) THEN + PRINT *, 'Decryption successful: plaintext matches decrypted text' + ELSE + PRINT *, 'Decryption failed: plaintext does not match decrypted text' + END IF + +CONTAINS + + SUBROUTINE initialize_alphabets(left, right) + CHARACTER(LEN=96), INTENT(OUT) :: left, right + INTEGER :: i, j + CHARACTER :: temp + REAL :: r + + ! Initialize alphabets with ASCII characters 32-127 + DO i = 1, 96 + left(i:i) = CHAR(i + 31) + right(i:i) = CHAR(i + 31) + END DO + + ! Fisher-Yates shuffle for left alphabet + DO i = 96, 2, -1 + CALL RANDOM_NUMBER(r) + j = 1 + FLOOR(i * r) + temp = left(i:i) + left(i:i) = left(j:j) + left(j:j) = temp + END DO + + ! Fisher-Yates shuffle for right alphabet + DO i = 96, 2, -1 + CALL RANDOM_NUMBER(r) + j = 1 + FLOOR(i * r) + temp = right(i:i) + right(i:i) = right(j:j) + right(j:j) = temp + END DO +END SUBROUTINE initialize_alphabets + + SUBROUTINE encipher(p, c, left, right, ascii_start) + CHARACTER(LEN=1), INTENT(IN) :: p + CHARACTER(LEN=1), INTENT(OUT) :: c + CHARACTER(LEN=96), INTENT(INOUT) :: left, right + INTEGER, INTENT(IN) :: ascii_start + INTEGER :: pos + + pos = INDEX(right, p) + c = left(pos:pos) + + CALL permute_left(left, c, ascii_start) + CALL permute_right(right, p, ascii_start) + END SUBROUTINE encipher + + SUBROUTINE decipher(c, p, left, right, ascii_start) + CHARACTER(LEN=1), INTENT(IN) :: c + CHARACTER(LEN=1), INTENT(OUT) :: p + CHARACTER(LEN=96), INTENT(INOUT) :: left, right + INTEGER, INTENT(IN) :: ascii_start + INTEGER :: pos + + pos = INDEX(left, c) + p = right(pos:pos) + + CALL permute_left(left, c, ascii_start) + CALL permute_right(right, p, ascii_start) + END SUBROUTINE decipher + + SUBROUTINE permute_left(alphabet, pivot, ascii_start) + CHARACTER(LEN=96), INTENT(INOUT) :: alphabet + CHARACTER(LEN=1), INTENT(IN) :: pivot + INTEGER, INTENT(IN) :: ascii_start + INTEGER :: pos + CHARACTER(LEN=1) :: temp + + pos = INDEX(alphabet, pivot) + alphabet = alphabet(pos:) // alphabet(:pos-1) + + temp = alphabet(2:2) + alphabet(2:49) = alphabet(3:50) + alphabet(50:50) = temp + END SUBROUTINE permute_left + + SUBROUTINE permute_right(alphabet, pivot, ascii_start) + CHARACTER(LEN=96), INTENT(INOUT) :: alphabet + CHARACTER(LEN=1), INTENT(IN) :: pivot + INTEGER, INTENT(IN) :: ascii_start + INTEGER :: pos + CHARACTER(LEN=1) :: temp + + pos = INDEX(alphabet, pivot) + alphabet = alphabet(pos:) // alphabet(:pos-1) + alphabet = alphabet(2:) // alphabet(1:1) + + temp = alphabet(3:3) + alphabet(3:49) = alphabet(4:50) + alphabet(50:50) = temp + END SUBROUTINE permute_right + +END PROGRAM Chaocipher diff --git a/Task/Chaos-game/Ada/chaos-game.ada b/Task/Chaos-game/Ada/chaos-game.ada new file mode 100644 index 0000000000..fe213c85fc --- /dev/null +++ b/Task/Chaos-game/Ada/chaos-game.ada @@ -0,0 +1,45 @@ +pragma Ada_2022; +with Ada.Numerics; use Ada.Numerics; +with Ada.Numerics.Discrete_Random; +with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; +with Easy_Graphics; use Easy_Graphics; + +procedure Chaos_Game is + Img : Easy_Image := New_Image ((1, 1), (512, 512), WHITE); + + procedure Chaos (Image : in out Easy_Image; + Vertex_Count : Positive; + Radius : Float; + Iters : Positive) is + type Vertex_Array is array (1 .. Vertex_Count) of Point; + Vertices : Vertex_Array; + subtype Vertex_Range is Integer range 1 .. Vertex_Count; + package Rand_V is new Ada.Numerics.Discrete_Random (Vertex_Range); + use Rand_V; + Gen : Generator; + Half_X : constant Integer := X_Last (Image) / 2; + Half_Y : constant Integer := Y_Last (Image) / 2; + Half_Pi : constant Float := Float (Pi) / 2.0; + Two_Pi : constant Float := Float (Pi) * 2.0; + V : Integer; + X : Integer := Half_X; + Y : Integer := Half_Y; + begin + for V in 1 .. Vertex_Count loop + Vertices (V).X := Half_X + Integer (Float (Half_X) * + Cos (Half_Pi + (Float (V - 1)) * Two_Pi / Float (Vertex_Count))); + Vertices (V).Y := Half_Y - Integer (Float (Half_Y) * + Sin (Half_Pi + (Float (V - 1)) * Two_Pi / Float (Vertex_Count))); + end loop; + for I in 1 .. Iters loop + V := Random (Gen); + X := X + Integer (Radius * Float (Vertices (V).X - X)); + Y := Y + Integer (Radius * Float (Vertices (V).Y - Y)); + Plot (Image, (X, Y), BLACK); + end loop; + end Chaos; + +begin + Chaos (Img, 3, 0.5, 250_000); + Write_GIF (Img, "chaos_game.gif"); +end Chaos_Game; diff --git a/Task/Chaos-game/AmigaBASIC/chaos-game.basic b/Task/Chaos-game/AmigaBASIC/chaos-game.basic new file mode 100644 index 0000000000..637e89a1da --- /dev/null +++ b/Task/Chaos-game/AmigaBASIC/chaos-game.basic @@ -0,0 +1,28 @@ +DEFINT a-z +w=600:h=180:w2=300 +x=w*RND:y=h*RND + +FOR i=1 TO 32000 + v=2*RND+1 + ON v GOTO One, Two, Three + +One: + x=x/2 + y=y/2 + GOTO Draw + +Two: + x=w2+(w2-x)/2 + y=h-(h-y)/2 + GOTO Draw + +Three: + x=w-(w-x)/2 + y=y/2 + +Draw: + PSET (x,y),v +NEXT + +loop: + GOTO loop diff --git a/Task/Chaos-game/Atari-BASIC/chaos-game.basic b/Task/Chaos-game/Atari-BASIC/chaos-game.basic new file mode 100644 index 0000000000..b612f7a348 --- /dev/null +++ b/Task/Chaos-game/Atari-BASIC/chaos-game.basic @@ -0,0 +1,18 @@ +10 GRAPHICS 7+16 +20 W=159:H=95:W2=79 +30 X=INT(W*RND(0)) +40 Y=INT(H*RND(0)) +50 FOR I=1 TO 5000 +60 V=INT(3*RND(0))+1 +70 GOTO 100*V +100 X=X/2:Y=Y/2 +110 GOTO 500 +200 X=W2+(W2-X)/2 +210 Y=H-(H-Y)/2 +220 GOTO 500 +300 X=W-(W-X)/2 +310 Y=Y/2 +500 COLOR V +510 PLOT X,Y +520 NEXT I +530 GOTO 530 diff --git a/Task/Character-codes/Dart/character-codes.dart b/Task/Character-codes/Dart/character-codes.dart new file mode 100644 index 0000000000..b1b602f4bd --- /dev/null +++ b/Task/Character-codes/Dart/character-codes.dart @@ -0,0 +1,6 @@ +void main() { + const string = 'D'; + print(string.runes.first); + var out = String.fromCharCode(67); + print(out); +} diff --git a/Task/Character-codes/Langur/character-codes.langur b/Task/Character-codes/Langur/character-codes.langur index e24d7430fe..053f7ab322 100644 --- a/Task/Character-codes/Langur/character-codes.langur +++ b/Task/Character-codes/Langur/character-codes.langur @@ -1,11 +1,11 @@ val a1 = 'a' val a2 = 97 val a3 = "a"[1] -val a4 = s2cp("a", 1) +val a4 = s2cp("a", of=1) val a5 = [a1, a2, a3, a4] writeln a1 == a2 writeln a2 == a3 writeln a3 == a4 -writeln "numbers: ", join(", ", map(string, [a1, a2, a3, a4, a5])) -writeln "letters: ", join(", ", map(cp2s, [a1, a2, a3, a4, a5])) +writeln "numbers: ", join(map([a1, a2, a3, a4, a5], by=string), by=", ") +writeln "letters: ", join(map([a1, a2, a3, a4, a5], by=cp2s), by=", ") diff --git a/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal-1.wren b/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal-1.wren deleted file mode 100644 index 34bcd3db89..0000000000 --- a/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal-1.wren +++ /dev/null @@ -1,7 +0,0 @@ -/* Check_output_device_is_a_terminal.wren */ - -class C { - foreign static isOutputDeviceTerminal -} - -System.print("Output device is a terminal = %(C.isOutputDeviceTerminal)") diff --git a/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal-2.wren b/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal-2.wren deleted file mode 100644 index a1e31b0511..0000000000 --- a/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal-2.wren +++ /dev/null @@ -1,82 +0,0 @@ -#include -#include -#include -#include -#include "wren.h" - -void C_isOutputDeviceTerminal(WrenVM* vm) { - bool isTerminal = (bool)isatty(fileno(stdout)); - wrenSetSlotBool(vm, 0, isTerminal); -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "C") == 0) { - if (isStatic && strcmp(signature, "isOutputDeviceTerminal") == 0) { - return C_isOutputDeviceTerminal; - } - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main() { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Check_output_device_is_a_terminal.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal.wren b/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal.wren new file mode 100644 index 0000000000..e8da13ba3c --- /dev/null +++ b/Task/Check-output-device-is-a-terminal/Wren/check-output-device-is-a-terminal.wren @@ -0,0 +1,5 @@ +import "io" for Stdout, Stderr + +System.print("Is output device a terminal?") +System.print(" stdout: %(Stdout.isTerminal)") +System.print(" stderr: %(Stderr.isTerminal)") diff --git a/Task/Check-that-file-exists/Langur/check-that-file-exists.langur b/Task/Check-that-file-exists/Langur/check-that-file-exists.langur index a275544023..b6ce97188b 100644 --- a/Task/Check-that-file-exists/Langur/check-that-file-exists.langur +++ b/Task/Check-that-file-exists/Langur/check-that-file-exists.langur @@ -1,4 +1,4 @@ -val printresult = impure fn(file) { +val printresult = fn*(file) { write file, ": " if val p = prop(file) { if p'isdir { diff --git a/Task/Chernicks-Carmichael-numbers/ALGOL-68/chernicks-carmichael-numbers.alg b/Task/Chernicks-Carmichael-numbers/ALGOL-68/chernicks-carmichael-numbers.alg new file mode 100644 index 0000000000..df8b4ad05f --- /dev/null +++ b/Task/Chernicks-Carmichael-numbers/ALGOL-68/chernicks-carmichael-numbers.alg @@ -0,0 +1,51 @@ +BEGIN # find some of Chernick's Carmichael numbers - translation of Go # + + PR precision 80 PR # set the precision of LONG LONG INT # + PR read "primes.incl.a68" PR # include prime utilities # + + # integer mode large enough to hold a Chernick's Carmichael number # + MODE CHERNICKINTEGER = LONG LONG INT; + # integer mode large to hold a factor of a Chernick's Carmichael number # + MODE CHERNICKFACTOR = LONG INT; + + # returns the value of the Chernick's Carmichaal number U( n, m ) # + # or 0 if n and m are not a Chernicj's Carmichael number # + PROC possible chernick = ( INT n, m )CHERNICKINTEGER: + IF CHERNICKINTEGER prod := 6 * m + 1; + NOT is probably prime( prod ) + THEN 0 + ELIF CHERNICKFACTOR f := 12 * m + 1; + NOT is probably prime( f ) + THEN 0 + ELSE CHERNICKFACTOR t := 9 * m; + prod *:= f; + f := t; + BOOL result := TRUE; + CHERNICKINTEGER ii := 1; + WHILE IF ii > n - 2 + THEN FALSE + ELSE f := ( t +:= t ) + 1; + result := is probably prime( f ) + FI + DO ii +:= 1; + prod *:= f + OD; + IF result THEN prod ELSE 0 FI + FI # possible chernick # ; + + BEGIN + FOR n FROM 3 TO 9 DO + INT m := IF n > 4 THEN 2 ^ ( n - 4 ) ELSE 1 FI; + WHILE IF CHERNICKINTEGER cn = possible chernick( n, m ); + cn > 0 + THEN print( ( "U( ", whole( n, 0 ) ) ); + print( ( ", " , whole( m, -8 ) ) ); + print( ( " ): ", whole( cn, 0 ), newline ) ); + FALSE + ELSE m +:= IF n <= 4 THEN 1 ELSE 2 ^ ( n - 4 ) FI; + TRUE + FI + DO SKIP OD + OD + END +END diff --git a/Task/Chinese-zodiac/00-TASK.txt b/Task/Chinese-zodiac/00-TASK.txt index 5fa4f581b8..04d125ed61 100644 --- a/Task/Chinese-zodiac/00-TASK.txt +++ b/Task/Chinese-zodiac/00-TASK.txt @@ -4,11 +4,11 @@ In the Chinese calendar, years are identified using two lists of labels, one of Years cycle through both lists concurrently, so that both stem and branch advance each year; if we used Roman letters for the stems and numbers for the branches, consecutive years would be labeled A1, B2, C3, etc. Since the two lists are different lengths, they cycle back to their beginning at different points: after J10 we get A11, and then after B12 we get C1. However, since both lists are of even length, only like-parity pairs occur (A1, A3, A5, but not A2, A4, A6), so only half of the 120 possible pairs are included in the sequence. The result is a repeating 60-year pattern within which each name pair occurs only once. -Mapping the branches to twelve traditional animal deities results in the well-known "Chinese zodiac", assigning each year to a given animal. For example, Saturday, February 10, 2024 CE (in the common Gregorian calendar) began the lunisolar Year of the Dragon. +Mapping the branches to twelve traditional animal deities results in the well-known "Chinese zodiac", assigning each year to a given animal. For example, Wednesday, January 29, 2025 CE (in the common Gregorian calendar) begins the lunisolar Year of the Snake. The stems do not have a one-to-one mapping like that of the branches to animals; however, the five pairs of consecutive stems are each associated with one of the traditional wǔxíng elements (Wood, Fire, Earth, Metal, and Water). Further, one of the two years within each element is assigned to yin, the other to yang. -Thus, the Chinese year beginning in 2024 CE is also the yang year of Wood. Since 12 is an even number, the association between animals and yin/yang aspect doesn't change; consecutive Years of the Dragon will cycle through the five elements, but will always be yang. +Thus, the Chinese year beginning in 2025 CE is also the yin year of Wood. Since 12 is an even number, the association between animals and yin/yang aspect doesn't change; consecutive Years of the Snake will cycle through the five elements, but will always be yin. ;Task: Create a subroutine or program that will return or output the animal, yin/yang association, and element for the lunisolar year that begins in a given CE year. @@ -20,10 +20,10 @@ You may optionally provide more information in the form of the year's numerical * Each element gets two consecutive years; a yang followed by a yin. * The first year (Wood Rat, yang) of the current 60-year cycle began in 1984 CE. -The lunisolar year beginning in 2024 CE - which, as already noted, is the year of the Wood Dragon (yang) - is the 41st of the current cycle. +The lunisolar year beginning in 2025 CE - which, as already noted, is the year of the Wood Snake (yin) - is the 42nd of the current cycle. ;Information for optional task: * The ten celestial stems are '''甲''' ''jiă'', '''乙''' ''yĭ'', '''丙''' ''bĭng'', '''丁''' ''dīng'', '''戊''' ''wù'', '''己''' ''jĭ'', '''庚''' ''gēng'', '''辛''' ''xīn'', '''壬''' ''rén'', and '''癸''' ''gŭi''. With the ASCII version of Pinyin tones, the names are written "jia3", "yi3", "bing3", "ding1", "wu4", "ji3", "geng1", "xin1", "ren2", and "gui3". * The twelve terrestrial branches are '''子''' ''zĭ'', '''丑''' ''chŏu'', '''寅''' ''yín'', '''卯''' ''măo'', '''辰''' ''chén'', '''巳''' ''sì'', '''午''' ''wŭ'', '''未''' ''wèi'', '''申''' ''shēn'', '''酉''' ''yŏu'', '''戌''' ''xū'', '''亥''' ''hài''. In ASCII Pinyin, those are "zi3", "chou3", "yin2", "mao3", "chen2", "si4", "wu3", "wei4", "shen1", "you3", "xu1", and "hai4". -Therefore 1984 was '''甲子''' (''jiă-zĭ'', or jia3-zi3), while 2024 is '''甲辰''' (''jĭa-chén'' or jia3-chen2). +Therefore 1984 was '''甲子''' (''jiă-zĭ'', or jia3-zi3), while 2025 is '''乙巳''' (''yĭ-sì'' or yi3-si4). diff --git a/Task/Chowla-numbers/Quackery/chowla-numbers.quackery b/Task/Chowla-numbers/Quackery/chowla-numbers.quackery new file mode 100644 index 0000000000..6fc47e0c39 --- /dev/null +++ b/Task/Chowla-numbers/Quackery/chowla-numbers.quackery @@ -0,0 +1,31 @@ + [ 2 max + dup sqrt+ + iff 0 else [ dup negate ] + unrot + times + [ dup i^ 1+ /mod + 0 = iff + [ i^ 1+ + + swap dip + ] + else drop ] + 1+ - ] is chowla ( n --> n ) + + 37 times + [ say "chowla(" + i^ 1+ dup echo + say ")= " + chowla echo cr ] + cr + ' [ 100 1000 10000 100000 1000000 10000000 ] + witheach + [ 0 over 2 - times + [ i^ 2 + chowla 0 = + ] + say "There are " echo + say " primes less than " + echo cr ] + cr + 35000000 2 - times + [ i^ 2 + dup chowla 1+ = if + [ i^ 2 + echo + say " is perfect" + cr ] ] diff --git a/Task/Closures-Value-capture/Kotlin/closures-value-capture.kts b/Task/Closures-Value-capture/Kotlin/closures-value-capture-1.kts similarity index 100% rename from Task/Closures-Value-capture/Kotlin/closures-value-capture.kts rename to Task/Closures-Value-capture/Kotlin/closures-value-capture-1.kts diff --git a/Task/Closures-Value-capture/Kotlin/closures-value-capture-2.kts b/Task/Closures-Value-capture/Kotlin/closures-value-capture-2.kts new file mode 100644 index 0000000000..03fcbea1ef --- /dev/null +++ b/Task/Closures-Value-capture/Kotlin/closures-value-capture-2.kts @@ -0,0 +1,5 @@ +val results = mutableListOf<() -> Int>() +for (i in 0..9) { + results.add { i * i } +} +println(results[3]()) // prints "9" diff --git a/Task/Closures-Value-capture/Kotlin/closures-value-capture-3.kts b/Task/Closures-Value-capture/Kotlin/closures-value-capture-3.kts new file mode 100644 index 0000000000..88988eb563 --- /dev/null +++ b/Task/Closures-Value-capture/Kotlin/closures-value-capture-3.kts @@ -0,0 +1,2 @@ +val results = (0..9).map { { it * it } } +println(results[3]()) // prints "9" diff --git a/Task/Color-of-a-screen-pixel/Atari-BASIC/color-of-a-screen-pixel.basic b/Task/Color-of-a-screen-pixel/Atari-BASIC/color-of-a-screen-pixel.basic new file mode 100644 index 0000000000..d28e199feb --- /dev/null +++ b/Task/Color-of-a-screen-pixel/Atari-BASIC/color-of-a-screen-pixel.basic @@ -0,0 +1 @@ +LOCATE X,Y,Q diff --git a/Task/Colorful-numbers/Haskell/colorful-numbers.hs b/Task/Colorful-numbers/Haskell/colorful-numbers.hs index 097645267c..bdecdbc569 100644 --- a/Task/Colorful-numbers/Haskell/colorful-numbers.hs +++ b/Task/Colorful-numbers/Haskell/colorful-numbers.hs @@ -1,23 +1,21 @@ -import Data.List ( nub ) -import Data.List.Split ( divvy ) -import Data.Char ( digitToInt ) +import Data.Char (digitToInt) +isColorful :: Int -> Bool +isColorful n + | n < 0 = error "Only non-negative integers are allowed" + | n == 0 || n == 1 = True + | 0 `elem` digits = False + | 1 `elem` digits = False + | not (distinct digits) = False + | not (distinct subpros) = False + | otherwise = True + where + digits = map digitToInt (show n) + subpros = [(prods !! i) `div` (prods !! j) |j <- [0..length(digits)], i <- [(j+1)..length(digits)]] + prods = scanl (*) 1 digits -isColourful :: Integer -> Bool -isColourful n - |n >= 0 && n <= 10 = True - |n > 10 && n < 100 = ((length s) == (length $ nub s)) && - (not $ any (\c -> elem c "01") s) - |n >= 100 = ((length s) == (length $ nub s)) && (not $ any (\c -> elem c "01") s) - && ((length products) == (length $ nub products)) - where - s :: String - s = show n - products :: [Int] - products = map (\p -> (digitToInt $ head p) * (digitToInt $ last p)) - $ divvy 2 1 s +distinct :: Eq a => [a] -> Bool +distinct [] = True +distinct [a] = True +distinct (x:xs) = distinct xs && (x `notElem` xs) -solution1 :: [Integer] -solution1 = filter isColourful [0 .. 100] - -solution2 :: Integer -solution2 = head $ filter isColourful [98765432, 98765431 ..] +-- Note, for s2, I started at 98762543 as it is the largest number that doesn't 'obviously' violate the colourful condition. Everything else either has 2*3 = 6; 2*4 = 8; 1 or 0 or a repeat digit. This was a rather random optimisation. diff --git a/Task/Colour-bars-Display/Aquarius-BASIC/colour-bars-display.basic b/Task/Colour-bars-Display/Aquarius-BASIC/colour-bars-display.basic new file mode 100644 index 0000000000..d21d2bb53c --- /dev/null +++ b/Task/Colour-bars-Display/Aquarius-BASIC/colour-bars-display.basic @@ -0,0 +1,8 @@ +10 PRINT CHR$(11) +20 CS=12328+1024 +30 FOR Y=0 TO 23 +40 FOR X=0 TO 15 +50 POKE CS+40*Y+X+16,X +60 NEXT +70 NEXT +80 GOTO 80 diff --git a/Task/Colour-bars-Display/Atari-BASIC/colour-bars-display.basic b/Task/Colour-bars-Display/Atari-BASIC/colour-bars-display.basic new file mode 100644 index 0000000000..a8eeba3831 --- /dev/null +++ b/Task/Colour-bars-Display/Atari-BASIC/colour-bars-display.basic @@ -0,0 +1,10 @@ +10 GRAPHICS 11:X=0 +20 FOR C=0 TO 15:COLOR C +30 FOR DX=0 TO 4 +40 PLOT X+DX,0 +50 DRAWTO X+DX,191 +60 NEXT DX +70 X=X+5 +80 NEXT C +90 REM WAIT FOR JOYSTICK FIRE BUTTON PRESS +100 IF STRIG(0)=1 THEN 100 diff --git a/Task/Colour-bars-Display/Crystal/colour-bars-display.cr b/Task/Colour-bars-Display/Crystal/colour-bars-display.cr new file mode 100644 index 0000000000..f2ca7972d4 --- /dev/null +++ b/Task/Colour-bars-Display/Crystal/colour-bars-display.cr @@ -0,0 +1,9 @@ +require "colorize" + +10.times do + [:black, :red, :green, :blue, :magenta, :cyan, :yellow, :white].each do |colour| + print ("█" * 8).colorize colour + end + Colorize.reset + puts +end diff --git a/Task/Colour-bars-Display/Nim/colour-bars-display.nim b/Task/Colour-bars-Display/Nim/colour-bars-display.nim index 77cebe5d54..17e18f999f 100644 --- a/Task/Colour-bars-Display/Nim/colour-bars-display.nim +++ b/Task/Colour-bars-Display/Nim/colour-bars-display.nim @@ -1,58 +1,41 @@ -import gintro/[glib, gobject, gtk, gio, cairo] +import cairo const - Width = 400 - Height = 300 + Width = 600 + Height = 400 -#--------------------------------------------------------------------------------------------------- -proc draw(area: DrawingArea; context: Context) = +proc drawBars(surface: ptr Surface) = ## Draw the color bars. - const Colors = [[0.0, 0.0, 0.0], [255.0, 0.0, 0.0], - [0.0, 255.0, 0.0], [0.0, 0.0, 255.0], - [255.0, 0.0, 255.0], [0.0, 255.0, 255.0], - [255.0, 255.0, 0.0], [255.0, 255.0, 255.0]] + const Colors = [(0.0, 0.0, 0.0), # Black. + (1.0, 0.0, 0.0), # Red. + (0.0, 1.0, 0.0), # Green. + (0.0, 0.0, 1.0), # Blue. + (1.0, 0.0, 1.0), # Magenta. + (0.0, 1.0, 1.0), # Cyan. + (1.0, 1.0, 0.0), # Yellow. + (1.0, 1.0, 1.0) # White. + ] const RectWidth = float(Width div Colors.len) RectHeight = float(Height) + let context = create(surface) + var x = 0.0 - for color in Colors: + for (r, g, b) in Colors: context.rectangle(x, 0, RectWidth, RectHeight) - context.setSource(color) + context.setSourceRgb(r, g, b) context.fill() x += RectWidth -#--------------------------------------------------------------------------------------------------- + context.destroy() -proc onDraw(area: DrawingArea; context: Context; data: pointer): bool = - ## Callback to draw/redraw the drawing area contents. - area.draw(context) - result = true - -#--------------------------------------------------------------------------------------------------- - -proc activate(app: Application) = - ## Activate the application. - - let window = app.newApplicationWindow() - window.setSizeRequest(Width, Height) - window.setTitle("Color bars") - - # Create the drawing area. - let area = newDrawingArea() - window.add(area) - - # Connect the "draw" event to the callback to draw the spiral. - discard area.connect("draw", ondraw, pointer(nil)) - - window.showAll() - -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.ColorBars") -discard app.connect("activate", activate) -discard app.run() +let surface = imageSurfaceCreate(FormatRgb24, 600, 400) +surface.drawBars() +if surface.writeToPng("color_bars.png") != StatusSuccess: + quit "Error while writing file.", QuitFailure +surface.destroy() diff --git a/Task/Colour-pinstripe-Display/Nim/colour-pinstripe-display.nim b/Task/Colour-pinstripe-Display/Nim/colour-pinstripe-display.nim index d560f6940c..8be6b5c802 100644 --- a/Task/Colour-pinstripe-Display/Nim/colour-pinstripe-display.nim +++ b/Task/Colour-pinstripe-Display/Nim/colour-pinstripe-display.nim @@ -1,63 +1,55 @@ -import gintro/[glib, gobject, gtk, gio, cairo] +import gtk2, gdk2, glib2, cairo const Width = 420 Height = 420 -const Colors = [[0.0, 0.0, 0.0], [255.0, 0.0, 0.0], - [0.0, 255.0, 0.0], [0.0, 0.0, 255.0], - [255.0, 0.0, 255.0], [0.0, 255.0, 255.0], - [255.0, 255.0, 0.0], [255.0, 255.0, 255.0]] +const Colors = [(0.0, 0.0, 0.0), (1.0, 0.0, 0.0), + (0.0, 1.0, 0.0), (0.0, 0.0, 1.0), + (1.0, 0.0, 1.0), (0.0, 1.0, 1.0), + (1.0, 1.0, 0.0), (1.0, 1.0, 1.0)] -#--------------------------------------------------------------------------------------------------- -proc draw(area: DrawingArea; context: Context) = +proc onExposeEvent(widget: PWidget; event: PEventExpose; data: Pgpointer): gboolean {.cdecl.} = ## Draw the color bars. const lineHeight = Height div 4 + let cr = cairo_create(widget.window) + var y = 0.0 for lineWidth in [1.0, 2.0, 3.0, 4.0]: - context.setLineWidth(lineWidth) + cr.setLineWidth(lineWidth) var x = 0.0 var colorIndex = 0 while x < Width: - context.setSource(Colors[colorIndex]) - context.moveTo(x, y) - context.lineTo(x, y + lineHeight) - context.stroke() + let (r, g, b) = Colors[colorIndex] + cr.setSourceRgb(r, g, b) + cr.moveTo(x, y) + cr.lineTo(x, y + lineHeight) + cr.stroke() colorIndex = (colorIndex + 1) mod Colors.len x += lineWidth y += lineHeight -#--------------------------------------------------------------------------------------------------- + cr.destroy() -proc onDraw(area: DrawingArea; context: Context; data: pointer): bool = - ## Callback to draw/redraw the drawing area contents. - area.draw(context) - result = true +proc onDestroyEvent(widget: PWidget; data: Pgpointer): gboolean {.cdecl.} = + ## Quit the application. + main_quit() -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +nim_init() +let window = window_new(gtk2.WINDOW_TOPLEVEL) +window.set_title("Color pinstripe") - let window = app.newApplicationWindow() - window.setSizeRequest(Width, Height) - window.setTitle("Color pinstripe") +let drawingArea = drawing_area_new() +window.add drawingArea +drawingArea.set_size_request(Width, Height) - # Create the drawing area. - let area = newDrawingArea() - window.add(area) +discard drawingArea.signal_connect("expose-event", SIGNAL_FUNC(onExposeEvent), nil) +discard window.signal_connect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) - # Connect the "draw" event to the callback to draw the color bars. - discard area.connect("draw", ondraw, pointer(nil)) - - window.showAll() - -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.ColorPinstripe") -discard app.connect("activate", activate) -discard app.run() +window.show_all() +main() diff --git a/Task/Colour-pinstripe-Printer/Nim/colour-pinstripe-printer.nim b/Task/Colour-pinstripe-Printer/Nim/colour-pinstripe-printer.nim index fedb55ffff..18f983f387 100644 --- a/Task/Colour-pinstripe-Printer/Nim/colour-pinstripe-printer.nim +++ b/Task/Colour-pinstripe-Printer/Nim/colour-pinstripe-printer.nim @@ -1,22 +1,66 @@ -import gintro/[glib, gobject, gtk, gio, cairo] +import gtk2, glib2, cairo -const Colors = [[0.0, 0.0, 0.0], [255.0, 0.0, 0.0], - [0.0, 255.0, 0.0], [0.0, 0.0, 255.0], - [255.0, 0.0, 255.0], [0.0, 255.0, 255.0], - [255.0, 255.0, 0.0], [255.0, 255.0, 255.0]] +############################################################################### +# Missing declarations needed for print operations. -#--------------------------------------------------------------------------------------------------- +when defined(win32): + const lib = "libgtk-win32-2.0-0.dll" +elif defined(macosx): + const lib = "(libgtk-quartz-2.0.0.dylib|libgtk-x11-2.0.dylib)" +else: + const lib = "libgtk-x11-2.0.so(|.0)" -proc beginPrint(op: PrintOperation; printContext: PrintContext; data: pointer) = - ## Process signal "begin_print", that is set the number of pages to print. - op.setNPages(1) +# Missing type definitions. +type + PrintOperation = PObject + PrintContext = PObject + PrintOperationAction = enum + PRINT_OPERATION_ACTION_PRINT_DIALOG + PRINT_OPERATION_ACTION_PRINT + PRINT_OPERATION_ACTION_PREVIEW + PRINT_OPERATION_ACTION_EXPORT + PrintOperationResult = enum + PRINT_OPERATION_RESULT_ERROR + PRINT_OPERATION_RESULT_APPLY + PRINT_OPERATION_RESULT_CANCEL + PRINT_OPERATION_RESULT_IN_PROGRESS -#--------------------------------------------------------------------------------------------------- +# Missing external procedures. +proc print_operation_new(): PrintOperation {.cdecl, + importc: "gtk_print_operation_new", dynlib: lib.} +proc print_operation_run(op: PrintOperation; action: PrintOperationAction; + parent: PWindow; error: pointer): PrintOperationResult {.cdecl, + importc: "gtk_print_operation_run", dynlib: lib.} +proc set_n_pages(op: PrintOperation; n: gint) {.cdecl, + importc: "gtk_print_operation_set_n_pages", dynlib: lib.} +proc get_cairo_context(printContext: PrintContext): ptr Context {.cdecl, + importc: "gtk_print_context_get_cairo_context", dynlib: lib.} +proc width(printContext: PrintContext): cdouble {.cdecl, + importc: "gtk_print_context_get_width", dynlib: lib.} +proc height(printContext: PrintContext): cdouble {.cdecl, + importc: "gtk_print_context_get_height", dynlib: lib.} -proc drawPage(op: PrintOperation; printContext: PrintContext; pageNum: int; data: pointer) = - ## Draw a page. - let context = printContext.getCairoContext() +############################################################################### + +const Colors = [(0.0, 0.0, 0.0), (1.0, 0.0, 0.0), + (0.0, 1.0, 0.0), (0.0, 0.0, 1.0), + (1.0, 0.0, 1.0), (0.0, 1.0, 1.0), + (1.0, 1.0, 0.0), (1.0, 1.0, 1.0)] + + +proc beginPrint(op: PrintOperation; printContext: PrintContext; + data: Pgpointer): gboolean {.cdecl.} = + ## Process "begin_print" signal. + op.setNPages(1) # Print one page. + result = true + + +proc drawPage(op: PrintOperation; printContext: PrintContext; + pageNum: int; data: Pgpointer): gboolean {.cdecl.} = + ## Process "draw_page" signal. + + let context = printContext.get_cairo_context() let lineHeight = printContext.height / 4 var y = 0.0 @@ -25,7 +69,8 @@ proc drawPage(op: PrintOperation; printContext: PrintContext; pageNum: int; data var x = 0.0 var colorIndex = 0 while x < printContext.width: - context.setSource(Colors[colorIndex]) + let (r, g, b) = Colors[colorIndex] + context.setSourceRgb(r, g, b) context.moveTo(x, y) context.lineTo(x, y + lineHeight) context.stroke() @@ -33,21 +78,13 @@ proc drawPage(op: PrintOperation; printContext: PrintContext; pageNum: int; data x += lineWidth y += lineHeight -#--------------------------------------------------------------------------------------------------- + result = true/* {{header|Nim}} */ -proc activate(app: Application) = - ## Activate the application. - # Launch a print operation. - let op = newPrintOperation() - op.connect("begin_print", beginPrint, pointer(nil)) - op.connect("draw_page", drawPage, pointer(nil)) +nim_init() - # Run the print dialog. - discard op.run(printDialog) - -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.ColorPinstripe") -discard app.connect("activate", activate) -discard app.run() +# Print the pinstripe. +let op = print_operation_new() +discard op.g_signal_connect("begin_print", G_CALLBACK(begin_print), nil) +discard op.g_signal_connect("draw_page", G_CALLBACK(draw_page), nil) +discard op.print_operation_run(PRINT_OPERATION_ACTION_PRINT_DIALOG, nil, nil) diff --git a/Task/Combinations-and-permutations/Quackery/combinations-and-permutations.quackery b/Task/Combinations-and-permutations/Quackery/combinations-and-permutations.quackery new file mode 100644 index 0000000000..68b70aa74c --- /dev/null +++ b/Task/Combinations-and-permutations/Quackery/combinations-and-permutations.quackery @@ -0,0 +1,21 @@ + [ 1 swap times [ i^ 1+ * ] ] is ! ( n --> n ) + + [ dip dup - ! dip ! / ] is p ( n n --> n ) + + [ tuck p swap ! / ] is c ( n n --> n ) + + ' [ [ 1 0 ] [ 12 4 ] [ 60 20 ] [ 105 103 ] [ 15000 333 ] ] + witheach + [ unpack 2dup + say " P(" + swap echo say "," echo + say ") = " + p shorten echo$ cr ] + cr + ' [ [ 10 5 ] [ 60 30 ] [ 50 48 ] [ 900 675 ] [ 970 730 ] ] + witheach + [ unpack 2dup + say " C(" + swap echo say "," echo + say ") = " + c shorten echo$ cr ] diff --git a/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-1.jq b/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-1.jq index 3972206ac5..bb25c96913 100644 --- a/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-1.jq +++ b/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-1.jq @@ -6,3 +6,5 @@ def pick(n): else ([.[m]] + pick(n-1; m)), pick(n; m+1) end; pick(n;0) ; + +def count(s): reduce s as $_ (0; .+1); diff --git a/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-2.jq b/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-2.jq index 6c2692b448..50f06bd1e4 100644 --- a/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-2.jq +++ b/Task/Combinations-with-repetitions/Jq/combinations-with-repetitions-2.jq @@ -1,4 +1,4 @@ - "Pick 2:", +"Pick 2:", (["iced", "jam", "plain"] | pick(2)), - ([[range(0;10)] | pick(3)] | length) as $n - | "There are \($n) ways to pick 3 objects with replacement from 10." + (count( [range(0;10)] | pick(3)) as $n + | "There are \($n) ways to pick 3 objects with replacement from 10.") diff --git a/Task/Combinations/M2000-Interpreter/combinations-1.m2000 b/Task/Combinations/M2000-Interpreter/combinations-1.m2000 index a5f1f5bb7e..47e46a34ce 100644 --- a/Task/Combinations/M2000-Interpreter/combinations-1.m2000 +++ b/Task/Combinations/M2000-Interpreter/combinations-1.m2000 @@ -1,41 +1,32 @@ Module Checkit { - Global a$ - Document a$ - Module Combinations (m as long, n as long){ + Function Combinations (m as long, n as long){ + Global a$ + Document a$ Module Level (n, s, h) { - If n=1 then { - while Len(s) { - Print h, car(s) - ToClipBoard() + If n=1 then + while Len(s) + a$<=h#str$("-")+"-"+car(s)#str$()+{ + } s=cdr(s) - } - } Else { - While len(s) { + End While + Else + While len(s) call Level n-1, cdr(s), cons(h, car(s)) s=cdr(s) - } - } - Sub ToClipBoard() - local m=each(h) - Local b$="" - While m { - b$+=If$(Len(b$)<>0->" ","")+Format$("{0::-10}",Array(m)) - } - b$+=If$(Len(b$)<>0->" ","")+Format$("{0::-10}",Array(s,0))+{ - } - a$<=b$ ' assign to global need <= - End Sub + End While + End if } If m<1 or n<1 then Error s=(,) - for i=0 to n-1 { - s=cons(s, (i,)) - } + for i=0 to n-1 + Append s, (i,) + next + s=s#sort() Head=(,) Call Level m, s, Head + =a$ } - Clear a$ - Combinations 3, 5 - ClipBoard a$ + ClipBoard Combinations( 3, 5) + report clipboard$ } Checkit diff --git a/Task/Combinations/M2000-Interpreter/combinations-2.m2000 b/Task/Combinations/M2000-Interpreter/combinations-2.m2000 index 96566c892d..9d851f853b 100644 --- a/Task/Combinations/M2000-Interpreter/combinations-2.m2000 +++ b/Task/Combinations/M2000-Interpreter/combinations-2.m2000 @@ -1,45 +1,55 @@ Module StepByStep { - Function CombinationsStep (a, nn) { - c1=lambda (&f, &a) ->{ - =car(a) : a=cdr(a) : f=len(a)=0 - } - m=len(a) + Function CombinationsStep (a, nn) { + c1=lambda (&f, &a) ->{ + =car(a) : a=cdr(a) : f=len(a)=0 + } + m=len(a) + c=c1 + n=m-nn+1 + p=2 + While m>n + c1=lambda c2=c,n=p, z=(,) (&f, &m) ->{ + if len(z)=0 then z=cdr(m) + =cons(car(m),c2(&f, &z)) + if f then z=(,) : m=cdr(m) : f=len(m)+len(z)n { - c1=lambda c2=c,n=p, z=(,) (&f, &m) ->{ - if len(z)=0 then z=cdr(m) - =cons(car(m),c2(&f, &z)) - if f then z=(,) : m=cdr(m) : f=len(m)+len(z) { + =c(&f, &a) } - =lambda c, a (&f) -> { - =c(&f, &a) - } - } - k=false - StepA=CombinationsStep((1, 2, 3, 4,5), 3) - while not k { - Print StepA(&k) - } - k=false - StepA=CombinationsStep((0, 1, 2, 3, 4), 3) - while not k { - Print StepA(&k) - } - k=false - StepA=CombinationsStep(("A", "B", "C", "D","E"), 3) - while not k { - Print StepA(&k) - } - k=false - StepA=CombinationsStep(("CAT", "DOG", "BAT"), 2) - while not k { - Print StepA(&k) - } + } + enum out {screen="", file="out.txt"} + m=each(out) + while m + open eval(m) for output as #f + k=false + StepA=CombinationsStep((1, 2, 3, 4,5), 3) + While not k + Print #f, StepA(&k)#str$() + End While + Print #f + k=false + StepA=CombinationsStep((0, 1, 2, 3, 4), 3) + While not k + Print #f, StepA(&k)#str$() + End While + Print #f + k=false + StepA=CombinationsStep(("A", "B", "C", "D","E"), 3) + While not k + Print #f, StepA(&k)#str$("-") + End While + Print #f + k=false + StepA=CombinationsStep(("CAT", "DOG", "BAT"), 2) + While not k + Print #f, StepA(&k)#str$("-") + End While + close #f + end while + win "notepad", dir$+file } StepByStep diff --git a/Task/Combinations/Quackery/combinations-1.quackery b/Task/Combinations/Quackery/combinations-1.quackery index 697808559d..ccf881afbe 100644 --- a/Task/Combinations/Quackery/combinations-1.quackery +++ b/Task/Combinations/Quackery/combinations-1.quackery @@ -1,48 +1,21 @@ - [ 0 swap - [ dup 0 != while - dup 1 & if - [ dip 1+ ] - 1 >> again ] - drop ] is bits ( n --> n ) - - [ [] unrot - bit times - [ i bits - over = if - [ dip - [ i join ] ] ] - drop ] is combnums ( n n --> [ ) - - [ [] 0 rot - [ dup 0 != while - dup 1 & if - [ dip - [ dup dip join ] ] - dip 1+ - 1 >> - again ] - 2drop ] is makecomb ( n --> [ ) - [ over 0 = iff - [ 2drop [] ] done - combnums - [] swap witheach - [ makecomb - nested join ] ] is comb ( n n --> [ ) + [ 2drop ' [ [ ] ] ] + done + dup [] = iff nip done + 1 split rot tuck + 1 - over recurse + dip [ rot [] ] + witheach + [ dip over join + nested join ] + nip unrot recurse join ] is comb ( n [ --> [ ) - [ behead swap witheach max ] is largest ( [ --> n ) + [ [] swap times + [ i^ join ] + comb + witheach + [ witheach + [ echo sp ] + cr ] ] is task ( n n --> ) - [ 0 rot witheach - [ [ dip [ over * ] ] + ] - nip ] is comborder ( [ n --> n ) - - [ dup [] != while - sortwith - [ 2dup join - largest 1+ dup dip - [ comborder swap ] - comborder < ] ] is sortcombs ( [ --> [ ) - - 3 5 comb - sortcombs - witheach [ witheach [ echo sp ] cr ] + 3 5 task diff --git a/Task/Combinations/Quackery/combinations-2.quackery b/Task/Combinations/Quackery/combinations-2.quackery index 5626470d75..697808559d 100644 --- a/Task/Combinations/Quackery/combinations-2.quackery +++ b/Task/Combinations/Quackery/combinations-2.quackery @@ -1,31 +1,48 @@ - [ stack ] is comb.stack - [ stack ] is comb.items - [ stack ] is comb.required - [ stack ] is comb.result + [ 0 swap + [ dup 0 != while + dup 1 & if + [ dip 1+ ] + 1 >> again ] + drop ] is bits ( n --> n ) - [ 1 - comb.items put - 1+ comb.required put - 0 comb.stack put - [] comb.result put - [ comb.required share - comb.stack size = if - [ comb.result take - comb.stack behead - drop nested join - comb.result put ] - comb.stack take - dup comb.items share - = iff - [ drop - comb.stack size 1 > iff - [ 1 comb.stack tally ] ] - else - [ dup comb.stack put - 1+ comb.stack put ] - comb.stack size 1 = until ] - comb.items release - comb.required release - comb.result take ] is comb ( n n --> ) + [ [] unrot + bit times + [ i bits + over = if + [ dip + [ i join ] ] ] + drop ] is combnums ( n n --> [ ) + + [ [] 0 rot + [ dup 0 != while + dup 1 & if + [ dip + [ dup dip join ] ] + dip 1+ + 1 >> + again ] + 2drop ] is makecomb ( n --> [ ) + + [ over 0 = iff + [ 2drop [] ] done + combnums + [] swap witheach + [ makecomb + nested join ] ] is comb ( n n --> [ ) + + [ behead swap witheach max ] is largest ( [ --> n ) + + [ 0 rot witheach + [ [ dip [ over * ] ] + ] + nip ] is comborder ( [ n --> n ) + + [ dup [] != while + sortwith + [ 2dup join + largest 1+ dup dip + [ comborder swap ] + comborder < ] ] is sortcombs ( [ --> [ ) 3 5 comb + sortcombs witheach [ witheach [ echo sp ] cr ] diff --git a/Task/Combinations/Quackery/combinations-3.quackery b/Task/Combinations/Quackery/combinations-3.quackery index 721a651555..5626470d75 100644 --- a/Task/Combinations/Quackery/combinations-3.quackery +++ b/Task/Combinations/Quackery/combinations-3.quackery @@ -1,16 +1,31 @@ - [ dup size dip - [ witheach - [ over swap peek swap ] ] - nip pack ] is arrange ( [ [ --> [ ) + [ stack ] is comb.stack + [ stack ] is comb.items + [ stack ] is comb.required + [ stack ] is comb.result + + [ 1 - comb.items put + 1+ comb.required put + 0 comb.stack put + [] comb.result put + [ comb.required share + comb.stack size = if + [ comb.result take + comb.stack behead + drop nested join + comb.result put ] + comb.stack take + dup comb.items share + = iff + [ drop + comb.stack size 1 > iff + [ 1 comb.stack tally ] ] + else + [ dup comb.stack put + 1+ comb.stack put ] + comb.stack size 1 = until ] + comb.items release + comb.required release + comb.result take ] is comb ( n n --> ) - ' [ 10 20 30 40 50 ] 3 5 comb - witheach - [ dip dup arrange - witheach [ echo sp ] - cr ] - drop - cr - $ "zero one two three four" nest$ - ' [ 4 3 1 0 1 4 3 ] arrange - witheach [ echo$ sp ] + witheach [ witheach [ echo sp ] cr ] diff --git a/Task/Combinations/Quackery/combinations-4.quackery b/Task/Combinations/Quackery/combinations-4.quackery new file mode 100644 index 0000000000..721a651555 --- /dev/null +++ b/Task/Combinations/Quackery/combinations-4.quackery @@ -0,0 +1,16 @@ + [ dup size dip + [ witheach + [ over swap peek swap ] ] + nip pack ] is arrange ( [ [ --> [ ) + + ' [ 10 20 30 40 50 ] + 3 5 comb + witheach + [ dip dup arrange + witheach [ echo sp ] + cr ] + drop + cr + $ "zero one two three four" nest$ + ' [ 4 3 1 0 1 4 3 ] arrange + witheach [ echo$ sp ] diff --git a/Task/Command-line-arguments/FutureBasic/command-line-arguments.basic b/Task/Command-line-arguments/FutureBasic/command-line-arguments.basic new file mode 100644 index 0000000000..ed30014088 --- /dev/null +++ b/Task/Command-line-arguments/FutureBasic/command-line-arguments.basic @@ -0,0 +1,14 @@ +include "NSLog.incl" + +void local fn DoCommandLineArguments + CFArrayRef args = fn ProcessInfoArguments + NSLog(@"This program is named %@.",args[0]) + NSLog(@"There are %d arguments.",len(args)-1) + for long i = 1 to len(args)-1 + NSLog(@"the argument #%d is %@", i, args[i]) + next +end fn + +fn DoCommandLineArguments + +HandleEvents diff --git a/Task/Command-line-arguments/LDPL/command-line-arguments-1.ldpl b/Task/Command-line-arguments/LDPL/command-line-arguments-1.ldpl new file mode 100644 index 0000000000..26aa218485 --- /dev/null +++ b/Task/Command-line-arguments/LDPL/command-line-arguments-1.ldpl @@ -0,0 +1,10 @@ +DATA: + argument_count IS NUMBER + +PROCEDURE: + GET LENGTH OF argv IN argument_count + IF argument_count IS EQUAL TO 0 THEN + DISPLAY "No arguments!" CRLF + ELSE + DISPLAY argv:0 CRLF + END IF diff --git a/Task/Command-line-arguments/LDPL/command-line-arguments-2.ldpl b/Task/Command-line-arguments/LDPL/command-line-arguments-2.ldpl new file mode 100644 index 0000000000..6cc4b9df78 --- /dev/null +++ b/Task/Command-line-arguments/LDPL/command-line-arguments-2.ldpl @@ -0,0 +1,6 @@ +$ ldpl argv.ldpl +* Loading argv.ldpl +* Compiling argv.ldpl +* Building argv-bin +* Saved as argv-bin +* File(s) compiled successfully. diff --git a/Task/Command-line-arguments/LDPL/command-line-arguments-3.ldpl b/Task/Command-line-arguments/LDPL/command-line-arguments-3.ldpl new file mode 100644 index 0000000000..ff51e1fe0c --- /dev/null +++ b/Task/Command-line-arguments/LDPL/command-line-arguments-3.ldpl @@ -0,0 +1,4 @@ +$ ./argv-bin test +test +$ ./argv-bin +No arguments! diff --git a/Task/Command-line-arguments/Tcl/command-line-arguments-1.tcl b/Task/Command-line-arguments/Tcl/command-line-arguments-1.tcl new file mode 100644 index 0000000000..3e39085837 --- /dev/null +++ b/Task/Command-line-arguments/Tcl/command-line-arguments-1.tcl @@ -0,0 +1,3 @@ +if { $argc >= 1 } { + puts [lindex $argv 0] +} diff --git a/Task/Command-line-arguments/Tcl/command-line-arguments-2.tcl b/Task/Command-line-arguments/Tcl/command-line-arguments-2.tcl new file mode 100644 index 0000000000..8db1f98495 --- /dev/null +++ b/Task/Command-line-arguments/Tcl/command-line-arguments-2.tcl @@ -0,0 +1,2 @@ +$ tclsh file.tcl test +test diff --git a/Task/Command-line-arguments/Tcl/command-line-arguments.tcl b/Task/Command-line-arguments/Tcl/command-line-arguments.tcl deleted file mode 100644 index 0827817f9e..0000000000 --- a/Task/Command-line-arguments/Tcl/command-line-arguments.tcl +++ /dev/null @@ -1,3 +0,0 @@ -if { $argc > 1 } { - puts [lindex $argv 1] -} diff --git a/Task/Command-line-arguments/Zig/command-line-arguments.zig b/Task/Command-line-arguments/Zig/command-line-arguments.zig new file mode 100644 index 0000000000..5b35ff255c --- /dev/null +++ b/Task/Command-line-arguments/Zig/command-line-arguments.zig @@ -0,0 +1,13 @@ +const std = @import("std"); + +pub fn main() !void { + const stdout = std.io.getStdOut().writer(); + + var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator); + defer arena.deinit(); + const allocator = arena.allocator(); + + const args = try std.process.argsAlloc(allocator); + + try stdout.print("{s}\n", .{args}); +} diff --git a/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-1.bqn b/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-1.bqn index 513bc811cf..a840cab418 100644 --- a/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-1.bqn +++ b/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-1.bqn @@ -1,8 +1 @@ -AllEq ← ⍋≡⍒ -Asc ← ¬∘AllEq∧∧≡⊢ - -•Show AllEq ⟨"AA", "AA", "AA", "AA"⟩ -•Show Asc ⟨"AA", "AA", "AA", "AA"⟩ - -•Show AllEq ⟨"AA", "ACB", "BB", "CC"⟩ -•Show Asc ⟨"AA", "ACB", "BB", "CC"⟩ +⊣` diff --git a/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-2.bqn b/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-2.bqn index 680eb502aa..51394587b4 100644 --- a/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-2.bqn +++ b/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-2.bqn @@ -1,4 +1,8 @@ -1 -0 -0 -1 +AllEq ← ⍋≡⍒ # or ⊣`⊸≡ +Asc ← ⍷∘∧⊸≡ + +•Show AllEq ⟨"AA", "AA", "AA", "AA"⟩ +•Show Asc ⟨"AA", "AA", "AA", "AA"⟩ + +•Show AllEq ⟨"AA", "ACB", "BB", "CC"⟩ +•Show Asc ⟨"AA", "ACB", "BB", "CC"⟩ diff --git a/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-3.bqn b/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-3.bqn new file mode 100644 index 0000000000..680eb502aa --- /dev/null +++ b/Task/Compare-a-list-of-strings/BQN/compare-a-list-of-strings-3.bqn @@ -0,0 +1,4 @@ +1 +0 +0 +1 diff --git a/Task/Compare-a-list-of-strings/Jq/compare-a-list-of-strings-1.jq b/Task/Compare-a-list-of-strings/Jq/compare-a-list-of-strings-1.jq index 9d9694486b..9a73ae5c6f 100644 --- a/Task/Compare-a-list-of-strings/Jq/compare-a-list-of-strings-1.jq +++ b/Task/Compare-a-list-of-strings/Jq/compare-a-list-of-strings-1.jq @@ -1,11 +1,11 @@ # Are the strings all equal? def lexically_equal: - . as $in - | reduce range(0;length-1) as $i - (true; if . then $in[$i] == $in[$i + 1] else false end); + if length <= 1 then true + else . as $in + | all( range(0;length-1); $in[0] == $in[. + 1]) + end; -# Are the strings in strictly ascending order? +# Are the elements in strictly ascending order? def lexically_ascending: . as $in - | reduce range(0;length-1) as $i - (true; if . then $in[$i] < $in[$i + 1] else false end); + | all( range(0;length-1); $in[.] < $in[. + 1]); diff --git a/Task/Compare-a-list-of-strings/K/compare-a-list-of-strings.k b/Task/Compare-a-list-of-strings/K/compare-a-list-of-strings.k new file mode 100644 index 0000000000..94f07991ed --- /dev/null +++ b/Task/Compare-a-list-of-strings/K/compare-a-list-of-strings.k @@ -0,0 +1,2 @@ +alleq:&/1_~': +asc:&/(*<,)':,:' diff --git a/Task/Compile-time-calculation/Python/compile-time-calculation.py b/Task/Compile-time-calculation/Python/compile-time-calculation.py new file mode 100644 index 0000000000..2aa67ebc19 --- /dev/null +++ b/Task/Compile-time-calculation/Python/compile-time-calculation.py @@ -0,0 +1 @@ +fc = 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 diff --git a/Task/Compound-data-type/M2000-Interpreter/compound-data-type.m2000 b/Task/Compound-data-type/M2000-Interpreter/compound-data-type.m2000 new file mode 100644 index 0000000000..3b9796e35b --- /dev/null +++ b/Task/Compound-data-type/M2000-Interpreter/compound-data-type.m2000 @@ -0,0 +1,27 @@ +class point { + single x, y +class: + module point (.x, .y) {} +} +function global add2(k as point) { + k.x+=2 + =k +} +module check { + a=point(2.343, 4.556) + print a.x, a.y + alfa(@add1(a)) + a=add2(a) + alfa(a) + print a is type point = true + + sub alfa(k as point) + print k.x + end sub + + function add1(k as point) + k.x+=1 + =k + end function +} +check diff --git a/Task/Concurrent-computing/M2000-Interpreter/concurrent-computing.m2000 b/Task/Concurrent-computing/M2000-Interpreter/concurrent-computing.m2000 index f6093e4fcb..06efefcb69 100644 --- a/Task/Concurrent-computing/M2000-Interpreter/concurrent-computing.m2000 +++ b/Task/Concurrent-computing/M2000-Interpreter/concurrent-computing.m2000 @@ -1,6 +1,6 @@ Thread.Plan Concurrent Module CheckIt { - Flush \\ empty stack of values + Flush ' empty stack of values Data "Enjoy", "Rosetta", "Code" For i=1 to 3 { Thread { @@ -13,21 +13,21 @@ Module CheckIt { Threads } Rem : Wait 3000 ' we can use just a wait loop, or the main.task loop - \\ main.task exit if all threads erased + ' main.task exit if all threads erased Main.Task 30 { } -\\ when module exit all threads from this module get a signal to stop. -\\ we can use Threads Erase to erase all threads. -\\ Also if we press Esc we do the same +' when module exit all threads from this module get a signal to stop. +' we can use Threads Erase to erase all threads. +' Also if we press Esc we do the same } CheckIt -\\ we can define again the module, and now we get three time each name, but not every time three same names. -\\ if we change to Threads.Plan Sequential we get always the three same names -\\ Also in concurrent plan we can use a block to ensure that statements run without other thread executed in parallel. +' we can define again the module, and now we get three time each name, but not every time three same names. +' if we change to Threads.Plan Sequential we get always the three same names +' Also in concurrent plan we can use a block to ensure that statements run without other thread executed in parallel. Module CheckIt { - Flush \\ empty stack of values + Flush ' empty stack of values Data "Enjoy", "Rosetta", "Code" For i=1 to 3 { Thread { @@ -42,11 +42,11 @@ Module CheckIt { Threads } Rem : Wait 3000 ' we can use just a wait loop, or the main.task loop - \\ main.task exit if all threads erased + ' main.task exit if all threads erased Main.Task 30 { } -\\ when module exit all threads from this module get a signal to stop. -\\ we can use Threads Erase to erase all threads. -\\ Also if we press Esc we do the same +' when module exit all threads from this module get a signal to stop. +' we can use Threads Erase to erase all threads. +' Also if we press Esc we do the same } CheckIt diff --git a/Task/Consecutive-primes-with-ascending-or-descending-differences/ALGOL-68/consecutive-primes-with-ascending-or-descending-differences.alg b/Task/Consecutive-primes-with-ascending-or-descending-differences/ALGOL-68/consecutive-primes-with-ascending-or-descending-differences.alg index 7b1613f55e..d6d1a27772 100644 --- a/Task/Consecutive-primes-with-ascending-or-descending-differences/ALGOL-68/consecutive-primes-with-ascending-or-descending-differences.alg +++ b/Task/Consecutive-primes-with-ascending-or-descending-differences/ALGOL-68/consecutive-primes-with-ascending-or-descending-differences.alg @@ -17,7 +17,7 @@ BEGIN # find sequences of primes where the gaps between the elements # FOR i TO n DO IF p[ i ] = yes THEN p[ p pos +:= 1 ] := i FI OD; p[ 1 : p pos ] END # prime list # ; - # shos the results of a search # + # shows the results of a search # PROC show sequence = ( []INT primes, STRING seq name, INT seq start, seq length )VOID: BEGIN print( ( " The longest sequence of primes with " diff --git a/Task/Constrained-genericity/Python/constrained-genericity.py b/Task/Constrained-genericity/Python/constrained-genericity.py new file mode 100644 index 0000000000..1cb6717482 --- /dev/null +++ b/Task/Constrained-genericity/Python/constrained-genericity.py @@ -0,0 +1,42 @@ +"""Constrained genericity. Requires Python >= 3.9.""" + +from typing import Generic +from typing import Protocol +from typing import TypeVar +from typing import runtime_checkable + +T = TypeVar("T", covariant=True) + + +@runtime_checkable +class Edible(Protocol[T]): + def eat(self) -> T: ... + + +class FoodBox(Generic[T]): + def __init__(self, *food: Edible[T]): + # Runtime type checking + for item in food: + if not isinstance(item, Edible): + raise TypeError(f"expected food, found {item.__class__.__name__}") + + self.contents = food + + +class Cheese: + def eat(self) -> None: + print("eating cheese") + + +class Shoe: + def wear(self) -> None: + print("wearing shoe") + + +if __name__ == "__main__": + box = FoodBox[None](Cheese()) + for food in box.contents: + food.eat() + + # This fails static type checking. + box = FoodBox[None](Cheese(), Shoe()) diff --git a/Task/Constrained-random-points-on-a-circle/FutureBasic/constrained-random-points-on-a-circle.basic b/Task/Constrained-random-points-on-a-circle/FutureBasic/constrained-random-points-on-a-circle.basic new file mode 100644 index 0000000000..11e9b8959d --- /dev/null +++ b/Task/Constrained-random-points-on-a-circle/FutureBasic/constrained-random-points-on-a-circle.basic @@ -0,0 +1,20 @@ +//Constrained random points on a circle +//https://rosettacode.org/wiki/Constrained_random_points_on_a_circle +// Translated from Yabasic to FutureBASIC + +short i,x,y,r +window 1,@"Circle",fn CGRectMake(0, 0, 100, 100),NSWindowStyleMaskTitled +windowcenter(1) +WindowSetBackgroundColor(1,fn ColorBlack) +for i = 1 to 100 + do + x = rnd(30)-15 + y = rnd(30)-15 + r = fn sqrt(x*x + y*y) + until 10 <= r and r <= 15 + + oval fill (x+50, y+50,1,1) +next i + + +handleevents diff --git a/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/EDSAC-order-code/continued-fraction-arithmetic-construct-from-rational-number.edsac b/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/EDSAC-order-code/continued-fraction-arithmetic-construct-from-rational-number.edsac index 859cc85936..a9bbf460bf 100644 --- a/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/EDSAC-order-code/continued-fraction-arithmetic-construct-from-rational-number.edsac +++ b/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/EDSAC-order-code/continued-fraction-arithmetic-construct-from-rational-number.edsac @@ -28,13 +28,14 @@ [---------------------------------------------------------------------- Modification of library subroutine P7. Prints signed integer up to 10 digits, left-justified. - 54 storage locations; working position 4D. + 52 storage locations; working position 4D. Must be loaded at an even address. Input: Number is at 0D.] - T 56 K - GKA3FT42@A49@T31@ADE10@T31@A48@T31@SDTDH44#@NDYFLDT4DS43@TF - H17@S17@A43@G23@UFS43@T1FV4DAFG50@SFLDUFXFOFFFSFL4FT4DA49@ - T31@A1FA43@G20@XFP1024FP610D@524D!FO46@O26@XFSFL8FT4DE39@ + [2024-12-25 Fixed bug in print subroutine. Did not affect Rosetta Code output.] + T 56 K + GKA3FT42@A47@T31@ADE10@T31@A46@T31@SDTDH44#@NDYFLDT4DS43@ + TFH17@S17@A43@G23@UFS43@T1FV4DAFG48@SFLDUFXFOFFFSFL4FT4DA47@ + T31@A1FA43@G20@XFT44#ZPFT43ZP1024FP610D@524DO26@XFSFL8FT4DE39@ [---------------------------------------------------------------------- Division subroutine for long positive integers. diff --git a/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational.fth b/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational-1.fth similarity index 100% rename from Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational.fth rename to Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational-1.fth diff --git a/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational-2.fth b/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational-2.fth new file mode 100644 index 0000000000..dbfe173a7b --- /dev/null +++ b/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational-2.fth @@ -0,0 +1,13 @@ +: RealToRational ( f n1 -- n2 n3) + 0 dup rot max-n s>f fswap fdup f0< >r + fabs fdup ftrunc f>s 1+ swap ( den num lim real R: neg F: best real) + \ helps set integer bounds around target + 1+ 1 ?do \ search through possible denominators + dup i * over 1- i * ?do \ search within integer limits bounding the real + fover fover i s>f j s>f f/ f- fabs fdup frot f< + if nip nip j i rot fswap frot then fdrop + loop \ e.g. for 3.1419e search only between 3 and 4 + loop + + fdrop fdrop drop r> if negate then swap +; diff --git a/Task/Convert-seconds-to-compound-duration/Langur/convert-seconds-to-compound-duration.langur b/Task/Convert-seconds-to-compound-duration/Langur/convert-seconds-to-compound-duration.langur index baca41f3e5..4c77456e8b 100644 --- a/Task/Convert-seconds-to-compound-duration/Langur/convert-seconds-to-compound-duration.langur +++ b/Task/Convert-seconds-to-compound-duration/Langur/convert-seconds-to-compound-duration.langur @@ -11,7 +11,7 @@ val d = fn(var sec) { for seconds in [7259, 86400, 6000000] { val dur = d(seconds) write "{{seconds:7}} sec = " - writeln join(", ", for[=[]] k of dur[1] { + writeln join(for[=[]] k of dur[1] { if dur[2][k] != 0: _for ~= ["{{dur[2][k]}} {{dur[1][k]}}"] - }) + }, by=", ") } diff --git a/Task/Conways-Game-of-Life/Zig/conways-game-of-life.zig b/Task/Conways-Game-of-Life/Zig/conways-game-of-life.zig new file mode 100644 index 0000000000..524afe1ece --- /dev/null +++ b/Task/Conways-Game-of-Life/Zig/conways-game-of-life.zig @@ -0,0 +1,85 @@ +const std = @import("std"); +const mem = std.mem; + +pub fn main() !void { + // ---------------------------- pseudo random number generator + var prng = std.Random.DefaultPrng.init(blk: { + var seed: u64 = undefined; + std.posix.getrandom(mem.asBytes(&seed)) catch unreachable; + break :blk seed; + }); + const random = prng.random(); + // ---------------------------------------------------------- + const stdout = std.io.getStdOut(); + var bw = std.io.bufferedWriter(stdout.writer()); + const writer = bw.writer(); + // ---------------------------------------------------------- + var life = Life(80, 15).init(random); + for (0..300) |_| { + life.step(); + try writer.writeByte('\x0c'); + try writer.print("{}", .{life}); + try bw.flush(); + std.time.sleep(comptime (1_000_000_000 / 30)); // 1/30th second + } +} +fn Life(comptime w: usize, comptime h: usize) type { + return struct { + const Self = @This(); + a: Field(w, h), + b: Field(w, h), + + fn init(random: std.Random) Self { + var life = Self{ + .a = Field(w, h).init(), + .b = Field(w, h).init(), + }; + for (0..w * h / 2) |_| { + const x = random.uintLessThan(usize, w); + const y = random.uintLessThan(usize, h); + life.a.set(x, y, true); + } + return life; + } + fn step(self: *Self) void { + for (0..h) |y| + for (0..w) |x| + self.b.set(x, y, self.a.next(x, y)); + mem.swap(Field(w, h), &self.a, &self.b); + } + pub fn format(self: *const Self, comptime _: []const u8, _: std.fmt.FormatOptions, writer: anytype) !void { + for (0..h) |y| { + for (0..w) |x| + try writer.writeByte(if (self.a.state(x, y)) '*' else ' '); + try writer.writeByte('\n'); + } + } + }; +} +fn Field(comptime w: usize, comptime h: usize) type { + return struct { + const Self = @This(); + s: std.StaticBitSet(w * h), + + fn init() Self { + return .{ .s = std.StaticBitSet(w * h).initEmpty() }; + } + fn set(self: *Self, x: usize, y: usize, b: bool) void { + self.s.setValue(y * w + x, b); + } + fn next(self: *const Self, x_: usize, y_: usize) bool { + var on: usize = 0; + // Use wraparound arithmetic, i.e. -% + inline for ([3]usize{ x_ -% 1, x_, x_ + 1 }) |x| + inline for ([3]usize{ y_ -% 1, y_, y_ + 1 }) |y| + if (self.state(x, y)) { + on += 1; + }; + return on == 3 or on == 2 and self.state(x_, y_); + } + fn state(self: *const Self, x: usize, y: usize) bool { + if (x >= w or y >= h) return false; + return self.s.isSet(y * w + x); + } + }; +} diff --git a/Task/Copy-a-string/68000-Assembly/copy-a-string-2.68000 b/Task/Copy-a-string/68000-Assembly/copy-a-string-2.68000 index 7f91645c39..10041191cb 100644 --- a/Task/Copy-a-string/68000-Assembly/copy-a-string-2.68000 +++ b/Task/Copy-a-string/68000-Assembly/copy-a-string-2.68000 @@ -7,10 +7,7 @@ LEA myString,A3 LEA StringRam,A4 CopyString: -MOVE.B (A3)+,D0 -MOVE.B D0,(A4)+ ;we could have used "MOVE.B (A3)+,(A4)+" but this makes it easier to check for the terminator. -BEQ Terminated -BRA CopyString +MOVE.B (A3)+,(A4)+ ;Copy one byte. +BNE CopyString ;Not zero, do more bytes. -Terminated: ;the null terminator is already stored along with the string itself, so we are done. ;program ends here. diff --git a/Task/Count-in-octal/Go/count-in-octal-4.go b/Task/Count-in-octal/Go/count-in-octal-4.go index 6f7d6a6ce6..a38069db73 100644 --- a/Task/Count-in-octal/Go/count-in-octal-4.go +++ b/Task/Count-in-octal/Go/count-in-octal-4.go @@ -1,5 +1,6 @@ +package main import ( - "big" + "math/big" "fmt" ) diff --git a/Task/Count-in-octal/Zig/count-in-octal.zig b/Task/Count-in-octal/Zig/count-in-octal.zig index 59ece70ab3..ea4057cc52 100644 --- a/Task/Count-in-octal/Zig/count-in-octal.zig +++ b/Task/Count-in-octal/Zig/count-in-octal.zig @@ -1,13 +1,7 @@ const std = @import("std"); -const fmt = std.fmt; -const warn = std.debug.warn; pub fn main() void { - var i: u8 = 0; - var buf: [3]u8 = undefined; - - while (i < 255) : (i += 1) { - _ = fmt.formatIntBuf(buf[0..], i, 8, false, 0); // buffer, value, base, uppercase, width - warn("{}\n", buf); + for(0..255) |i| { + std.debug.print("{o}\n", .{i}); } } diff --git a/Task/Count-occurrences-of-a-substring/Langur/count-occurrences-of-a-substring.langur b/Task/Count-occurrences-of-a-substring/Langur/count-occurrences-of-a-substring.langur index 868b9d305f..8ce8e87c0b 100644 --- a/Task/Count-occurrences-of-a-substring/Langur/count-occurrences-of-a-substring.langur +++ b/Task/Count-occurrences-of-a-substring/Langur/count-occurrences-of-a-substring.langur @@ -1,2 +1,2 @@ -writeln len(indices("th", "the three truths")) -writeln len(indices("abab", "ababababab")) +writeln len(indices("the three truths", by="th")) +writeln len(indices("ababababab", by="abab")) diff --git a/Task/Count-occurrences-of-a-substring/M2000-Interpreter/count-occurrences-of-a-substring.m2000 b/Task/Count-occurrences-of-a-substring/M2000-Interpreter/count-occurrences-of-a-substring.m2000 new file mode 100644 index 0000000000..e95415b220 --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/M2000-Interpreter/count-occurrences-of-a-substring.m2000 @@ -0,0 +1,15 @@ +module Count_occurrences_of_a_substring { + print @countSubstring("the three truths","th") '3 + print @countSubstring("ababababab","abab") '2 + function countSubstring(a$, b$) + local k=1, count + do + k=instr(a$, b$, k) + if k<1 then exit + count++ + k+=len(b$) + always + =count + end function +} +Count_occurrences_of_a_substring diff --git a/Task/Count-occurrences-of-a-substring/Zig/count-occurrences-of-a-substring.zig b/Task/Count-occurrences-of-a-substring/Zig/count-occurrences-of-a-substring.zig new file mode 100644 index 0000000000..103eb1c190 --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/Zig/count-occurrences-of-a-substring.zig @@ -0,0 +1,7 @@ +const std = @import("std"); + +pub fn main() void { + std.debug.print("{d}\n", .{ + std.mem.count(u8, "the three truths", "th") + }); +} diff --git a/Task/Cuban-primes/Quackery/cuban-primes.quackery b/Task/Cuban-primes/Quackery/cuban-primes.quackery new file mode 100644 index 0000000000..953bc53225 --- /dev/null +++ b/Task/Cuban-primes/Quackery/cuban-primes.quackery @@ -0,0 +1,24 @@ + say "The first 200 cuban primes:" + [] [] 1 + 0 temp put + [ 6 temp tally + temp share + + dup prime if + [ dup dip join ] + over size 200 = until ] + drop + witheach + [ number$ +commas nested join ] + 72 wrap$ + temp release + cr cr + say "The 100,000th cuban prime is " + 0 1 + 0 temp put + [ 6 temp tally + temp share + dup prime if + [ dip 1+ ] + over 100000 = until ] + nip number$ +commas echo$ + char . emit + temp release diff --git a/Task/Currying/M2000-Interpreter/currying-1.m2000 b/Task/Currying/M2000-Interpreter/currying-1.m2000 deleted file mode 100644 index fa7e6533d1..0000000000 --- a/Task/Currying/M2000-Interpreter/currying-1.m2000 +++ /dev/null @@ -1,42 +0,0 @@ -Module LikeGroovy { - divide=lambda (x, y)->x/y - partsof120=lambda divide ->divide(120, ![]) - Print "half of 120 is ";partsof120(2) - Print "a third is ";partsof120(3) - Print "and a quarter is ";partsof120(4) -} -LikeGroovy - -Module Joke { - \\ we can call F1(), with any number of arguments, and always read one and then - \\ call itself passing the remain arguments - \\ ![] take stack of values and place it in the next call. - F1=lambda -> { - if empty then exit - Read x - =x+lambda(![]) - } - - Print F1(F1(2),2,F1(-4))=0 - Print F1(-4,F1(2),2)=0 - Print F1(2, F1(F1(2),2))=F1(F1(F1(2),2),2) - Print F1(F1(F1(2),2),2)=6 - Print F1(2, F1(2, F1(2),2))=F1(F1(F1(2),2, F1(2)),2) - Print F1(F1(F1(2),2, F1(2)),2)=8 - Print F1(2, F1(10, F1(2, F1(2),2)))=F1(F1(F1(2),2, F1(2)),2, 10) - Print F1(F1(F1(2),2, F1(2)),2, 10)=18 - Print F1(2,2,2,2,10)=18 - Print F1()=0 - - Group F2 { - Sum=0 - Function Add (x){ - .Sum+=x - =x - } - } - Link F2.Add() to F2() - Print F1(F1(F1(F2(2)),F2(2), F1(F2(2))),F2(2))=8 - Print F2.Sum=8 -} -Joke diff --git a/Task/Currying/M2000-Interpreter/currying-2.m2000 b/Task/Currying/M2000-Interpreter/currying-2.m2000 deleted file mode 100644 index b8aaf91170..0000000000 --- a/Task/Currying/M2000-Interpreter/currying-2.m2000 +++ /dev/null @@ -1,26 +0,0 @@ -Module Puzzle { - Global Group F2 { - Sum=0 - Sum2=0 - Function Add (x){ - .Sum+=x - =x - } - } - F1=lambda -> { - if empty then exit - Read x - Print ">>>", F2.Sum - F2.Sum2++ ' add one each time we read x - =x+lambda(![]) - } - Link F2.Add() to F2() - P=F1(F1(F1(F2(2)),F2(2), F1(F2(2))),F2(2))=8 - Print F2.Sum=8 - Print F2.Sum2=7 - \\ We read 7 times x, but we get 8, 2+2+2+2 - \\ So 3 times x was zero, or not? - \\ but where we pass zero? - \\ zero return from F1 if no argument pass, so how x get zero?? -} -Puzzle diff --git a/Task/Currying/M2000-Interpreter/currying.m2000 b/Task/Currying/M2000-Interpreter/currying.m2000 new file mode 100644 index 0000000000..11e0feb542 --- /dev/null +++ b/Task/Currying/M2000-Interpreter/currying.m2000 @@ -0,0 +1,59 @@ +Module LikeGroovy { + divide=lambda (x, y)->x/y + Curry=lambda (f as lambda, k)->(lambda f, k ->(f(k,![]))) + partsof120=Curry(divide, 120) + Print "half of 120 is ";partsof120(2) + Print "a third is ";partsof120(3) + Print "and a quarter is ";partsof120(4) + + joinTwoWordsWithSymbol=lambda (s, a, b)->a+s+b + Assert joinTwoWordsWithSymbol("#","Hello", "World")="Hello#World" + concatWords =Curry(joinTwoWordsWithSymbol, " ") + Assert concatWords("Hello", "World")="Hello World" + prependHello =Curry(concatWords, "Hello") + Assert prependHello("World")="Hello World" + Print "done" +} +LikeGroovy +Module M2000way { + class curry{ + private: + p=stack ' stack of values + func$ ' field for the weak reference + public: + property counter {value } ' readonly + class: + module curry(.func$) { + .p<=[] + class value { + value () { + ' symbol ! used for feeding stack of values from arrays or stacks. + ' [] is the current stack (leave emtpy stack as current stack) + ' Stack(.p) make a copy of .p (which have a stack object) + =function(.func$, !stack(.p), ![]) + .[counter]++ + } + } + this=value() ' make this as a property + } + } + ' using a general function + Function Divide(a, b) { + =a/b + } + Print "Divide(10, 6) is ";Divide(10, 5) + partsof120=Curry(&Divide(), 120) + Print "half of 120 is ";partsof120(2) + Print "a third is ";partsof120(3) + Print "and a quarter is ";partsof120(4) + Print "Use of partsof120 so far: "; partsof120.counter; " times" + ' using a lambda function + joinTwoWordsWithSymbol=lambda (s, a, b)->a+s+b + Assert joinTwoWordsWithSymbol("#","Hello", "World")="Hello#World" + concatWords =Curry(&joinTwoWordsWithSymbol, " ") + Assert concatWords("Hello", "World")="Hello World" + prependHello =Curry(&concatWords, "Hello") + Assert prependHello("World")="Hello World" + Print "done" +} +M2000way diff --git a/Task/Cyclops-numbers/REXX/cyclops-numbers-1.rexx b/Task/Cyclops-numbers/REXX/cyclops-numbers-1.rexx deleted file mode 100644 index bc1ab73571..0000000000 --- a/Task/Cyclops-numbers/REXX/cyclops-numbers-1.rexx +++ /dev/null @@ -1,55 +0,0 @@ -/*REXX pgm finds 1st N cyclops (Θ) #s, Θ primes, blind Θ primes, palindromic Θ primes*/ -parse arg n cols . /*obtain optional argument from the CL.*/ -if n=='' | n=="," then n= 50 /*Not specified? Then use the default.*/ -if cols=='' | cols=="," then cols= 10 /* " " " " " " */ -call genP /*build array of semaphores for primes.*/ -w= max(10, length( commas(@.#) ) ) /*max width of a number in any column. */ -pri?= 0; bli?= 0; pal?= 0; call 0 ' first ' commas(n) " cyclops numbers" -pri?= 1; bli?= 0; pal?= 0; call 0 ' first ' commas(n) " prime cyclops numbers" -pri?= 1; bli?= 1; pal?= 0; call 0 ' first ' commas(n) " blind prime cyclops numbers" -pri?= 1; bli?= 0; pal?= 1; call 0 ' first ' commas(n) " palindromic prime cyclops numbers" -exit 0 /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -commas: parse arg ?; do jc=length(?)-3 to 1 by -3; ?=insert(',', ?, jc); end; return ? -/*──────────────────────────────────────────────────────────────────────────────────────*/ -0: parse arg title; idx= 1 /*get the title of this output section.*/ - say ' index │'center(title, 1 + cols*(w+1) ) /*display the output title. */ - say '───────┼'center("" , 1 + cols*(w+1), '─') /* " " " separator*/ - finds= 0; $= /*the number of finds (so far); $ list.*/ - do j=0 until finds== n; L= length(j) /*find N cyclops numbers, start at 101.*/ - if L//2==0 then do; j= left(1, L+1, 0) /*Is J an even # of digits? Yes, bump J*/ - iterate /*use a new J that has odd # of digits.*/ - end - z= pos(0, j); if z\==(L+1)%2 then iterate /* " " " " (zero in mid)? " */ - if pos(0, j, z+1)>0 then iterate /* " " " " (has two 0's)? " */ - if pri? then if \!.j then iterate /*Need a cyclops prime? Then skip.*/ - if bli? then do; ?= space(translate(j, , 0), 0) /*Need a blind cyclops prime ?*/ - if \!.? then iterate /*Not a blind cyclops prime? Then skip.*/ - end - if pal? then do; r= reverse(j) /*Need a palindromic cyclops prime? */ - if r\==j then iterate /*Cyclops number not palindromic? Skip.*/ - if \!.r then iterate /* " palindrome not prime? " */ - end - finds= finds + 1 /*bump the number of palindromic primes*/ - $= $ right( commas(j), w) /*add a palindromic prime ──► $ list.*/ - if finds//cols\==0 then iterate /*have we populated a line of output? */ - say center(idx, 7)'│' substr($, 2); $= /*display what we have so far (cols). */ - idx= idx + cols /*bump the index count for the output*/ - end /*j*/ - if $\=='' then say center(idx, 7)"│" substr($, 2) /*possible show residual output.*/ - say '───────┴'center("" , 1 + cols*(w+1), '─'); say - return -/*──────────────────────────────────────────────────────────────────────────────────────*/ -genP: !.= 0; hip= 7890987 - 1 /*placeholders for primes (semaphores).*/ - @.1=2; @.2=3; @.3=5; @.4=7; @.5=11; @.6=13 /*define some low primes. */ - !.2=1; !.3=1; !.5=1; !.7=1; !.11=1; !.13=1 /* " " " " flags. */ - #= 6; sq.#= @.# ** 2 /*number of primes so far; prime square*/ - do j=@.#+2 by 2 for max(0, hip%2-@.#%2-1) /*find odd primes from here on. */ - parse var j '' -1 _ /*get the last dec. digit of J.*/ - if _==5 then iterate; if j// 3==0 then iterate /*÷ by 5? ÷ by 3? Skip.*/ - if j// 7==0 then iterate; if j//11==0 then iterate /*÷ " 7? ÷ by 11? " */ - do k=6 while sq.k<=j /* [↓] divide by the known odd primes.*/ - if j // @.k == 0 then iterate j /*Is J ÷ X? Then not prime. ___ */ - end /*k*/ /* [↑] only process numbers ≤ √ J */ - #= #+1; @.#= j; sq.#= j*j; !.j= 1 /*bump # Ps; assign next P; P sq; P# */ - end /*j*/; return diff --git a/Task/Cyclops-numbers/REXX/cyclops-numbers-2.rexx b/Task/Cyclops-numbers/REXX/cyclops-numbers.rexx similarity index 100% rename from Task/Cyclops-numbers/REXX/cyclops-numbers-2.rexx rename to Task/Cyclops-numbers/REXX/cyclops-numbers.rexx diff --git a/Task/Cyclotomic-polynomial/FreeBASIC/cyclotomic-polynomial.basic b/Task/Cyclotomic-polynomial/FreeBASIC/cyclotomic-polynomial.basic new file mode 100644 index 0000000000..9c96e1eb57 --- /dev/null +++ b/Task/Cyclotomic-polynomial/FreeBASIC/cyclotomic-polynomial.basic @@ -0,0 +1,137 @@ +#include "isprime.bas" + +Type IntArray + Dim values(Any) As Integer + Dim length As Integer +End Type + +Function distinctPrimeFactors(n As Integer) As IntArray + Dim result As IntArray + Redim result.values(0) + result.length = 0 + + For i As Integer = 2 To n + If n Mod i = 0 Andalso isPrime(i) Then + result.length += 1 + Redim Preserve result.values(result.length - 1) + result.values(result.length - 1) = i + While n Mod i = 0 + n \= i + Wend + End If + Next + Return result +End Function + +Function substituteExponent(polynomial As IntArray, exponent As Integer) As IntArray + Dim result As IntArray + result.length = exponent * (polynomial.length - 1) + 1 + Redim result.values(result.length - 1) + + For i As Integer = polynomial.length - 1 To 0 Step -1 + result.values(i * exponent) = polynomial.values(i) + Next + + Return result +End Function + +Function exactDivision(dividend As IntArray, divisor As IntArray) As IntArray + Dim As Integer i, j + Dim result As IntArray + result.length = dividend.length - divisor.length + 1 + Redim result.values(result.length - 1) + + Dim temp(dividend.length - 1) As Integer + For i = 0 To dividend.length - 1 + temp(i) = dividend.values(i) + Next + + For i = 0 To dividend.length - divisor.length + result.values(i) = temp(i) + If temp(i) <> 0 Then + For j = 1 To divisor.length - 1 + temp(i + j) -= divisor.values(j) * temp(i) + Next + End If + Next + + Return result +End Function + +Function cycloPoly(cpIndex As Integer) As IntArray + Dim i As Integer + Dim polynomial As IntArray + polynomial.length = 2 + Redim polynomial.values(1) + polynomial.values(0) = 1 + polynomial.values(1) = -1 + + If cpIndex = 1 Then Return polynomial + + If isPrime(cpIndex) Then + Dim result As IntArray + result.length = cpIndex + Redim result.values(cpIndex - 1) + For i = 0 To cpIndex - 1 + result.values(i) = 1 + Next + Return result + End If + + Dim primes As IntArray = distinctPrimeFactors(cpIndex) + Dim product As Integer = 1 + + For i = 0 To primes.length - 1 + Dim numerator As IntArray = substituteExponent(polynomial, primes.values(i)) + polynomial = exactDivision(numerator, polynomial) + product *= primes.values(i) + Next + + Return substituteExponent(polynomial, cpIndex \ product) +End Function + +Function hasHeight(polynomial As IntArray, coefficient As Integer) As Boolean + For i As Integer = 0 To (polynomial.length + 1) \ 2 - 1 + If Abs(polynomial.values(i)) = coefficient Then Return True + Next + Return False +End Function + +' Main program +Print "Task 1: Cyclotomic polynomials for n <= 30:" +Print "CP( 1) = x - 1" + +For cpIndex As Integer = 2 To 30 + Print Using "CP(##) = "; cpIndex; + Dim poly As IntArray = cycloPoly(cpIndex) + + Dim first As Boolean = True + For i As Integer = poly.length - 1 To 0 Step -1 + If poly.values(i) <> 0 Then + If Not first Then Print Iif(poly.values(i) > 0, " + ", " "); + If poly.values(i) <> 1 Or i = 0 Then + Print Iif(poly.values(i) = -1 And i > 0, "- ", Str(poly.values(i))); + End If + + If i > 0 Then + Print "x"; + If i > 1 Then Print "^" & i; + End If + first = False + End If + Next + Print +Next + +Print !"\nTask 2: Smallest cyclotomic polynomial with n or -n as a coefficient:" +Print "CP( 1) has a coefficient with magnitude 1" + +Dim cpIndex As Integer = 2 +For coeff As Integer = 2 To 10 + While isPrime(cpIndex) Or Not hasHeight(cycloPoly(cpIndex), coeff) + cpIndex += 1 + Wend + Print Using "CP(#####) has a coefficient with magnitude &"; cpIndex; coeff +Next + +Sleep diff --git a/Task/DNS-query/Wren/dns-query-1.wren b/Task/DNS-query/Wren/dns-query-1.wren deleted file mode 100644 index 728593ed2b..0000000000 --- a/Task/DNS-query/Wren/dns-query-1.wren +++ /dev/null @@ -1,9 +0,0 @@ -/* DNS_query.wren */ - -class Net { - foreign static lookupHost(host) -} - -var host = "orange.kame.net" -var addrs = Net.lookupHost(host).split(", ") -System.print(addrs.join("\n")) diff --git a/Task/DNS-query/Wren/dns-query-2.wren b/Task/DNS-query/Wren/dns-query-2.wren deleted file mode 100644 index 266b61a3c3..0000000000 --- a/Task/DNS-query/Wren/dns-query-2.wren +++ /dev/null @@ -1,31 +0,0 @@ -/* go run DNS_query.go */ - -package main - -import( - wren "github.com/crazyinfin8/WrenGo" - "net" - "strings" -) - -type any = interface{} - -func lookupHost(vm *wren.VM, parameters []any) (any, error) { - host := parameters[1].(string) - addrs, err := net.LookupHost(host) - if err != nil { - return nil, nil - } - return strings.Join(addrs, ", "), nil -} - -func main() { - vm := wren.NewVM() - fileName := "DNS_query.wren" - methodMap := wren.MethodMap{"static lookupHost(_)": lookupHost} - classMap := wren.ClassMap{"Net": wren.NewClass(nil, nil, methodMap)} - module := wren.NewModule(classMap) - vm.SetModule(fileName, module) - vm.InterpretFile(fileName) - vm.Free() -} diff --git a/Task/DNS-query/Wren/dns-query.wren b/Task/DNS-query/Wren/dns-query.wren new file mode 100644 index 0000000000..e2ce79fd16 --- /dev/null +++ b/Task/DNS-query/Wren/dns-query.wren @@ -0,0 +1,18 @@ +import "os" for Process + +var domainName = "www.kame.net" +System.print(domainName) +var ipvs = ["IPv4", "IPv6"] +var args = ["A", "AAAA"] +for (i in 0..1) { + var cmd = "nslookup -querytype=%(args[i]) %(domainName)" + var lines = Process.read(cmd).split("\n") + var addresses = [] + for (line in lines.skip(3)) { + if (line.startsWith("Address:")) { + var address = line[8..-1].trim() + addresses.add(address) + } + } + for (address in addresses) System.print("%(ipvs[i]): %(address)") +} diff --git a/Task/Date-format/Langur/date-format-1.langur b/Task/Date-format/Langur/date-format-1.langur index 9375725f6a..48c2cf95d3 100644 --- a/Task/Date-format/Langur/date-format-1.langur +++ b/Task/Date-format/Langur/date-format-1.langur @@ -1,2 +1,2 @@ -writeln string(dt//, "2006-01-02") -writeln string(dt//, "Monday, January 2, 2006") +writeln string(dt//, fmt="2006-01-02") +writeln string(dt//, fmt="Monday, January 2, 2006") diff --git a/Task/Date-manipulation/Langur/date-manipulation.langur b/Task/Date-manipulation/Langur/date-manipulation.langur index d25c9c940e..674403c0ae 100644 --- a/Task/Date-manipulation/Langur/date-manipulation.langur +++ b/Task/Date-manipulation/Langur/date-manipulation.langur @@ -2,13 +2,13 @@ val input = "March 7 2009 7:30pm -05:00" val iformat = "January 2 2006 3:04pm -07:00" val oformat = "January 2 2006 3:04pm MST" -val d1 = datetime(input, iformat) +val d1 = datetime(input, fmt=iformat) val d2 = d1 + dr/T12h/ -val d3 = datetime(d2, "US/Arizona") -val d4 = datetime(d2, zls) -val d5 = datetime(d2, "Z") -val d6 = datetime(d2, "+02:30") -val d7 = datetime(d2, "EST") +val d3 = datetime(d2, fmt="US/Arizona") +val d4 = datetime(d2, fmt=zls) +val d5 = datetime(d2, fmt="Z") +val d6 = datetime(d2, fmt="+02:30") +val d7 = datetime(d2, fmt="EST") writeln "input string: ", input writeln "input format string: ", iformat diff --git a/Task/Deal-cards-for-FreeCell/M2000-Interpreter/deal-cards-for-freecell.m2000 b/Task/Deal-cards-for-FreeCell/M2000-Interpreter/deal-cards-for-freecell.m2000 new file mode 100644 index 0000000000..6c81a3e2b7 --- /dev/null +++ b/Task/Deal-cards-for-FreeCell/M2000-Interpreter/deal-cards-for-freecell.m2000 @@ -0,0 +1,45 @@ +Module FreeCellDeal { + deal = lambda ->{ + ms_lcg = lambda ms_state=0# (seed As currency = -1) ->{ + If seed <> -1 Then + ms_state = seed Mod 2 ^ 31 + Else + ms_state = (214013 * ms_state + 2531011) Mod 2 ^ 31 + End If + = binary.shift(ms_state, -16) + } + fillbytes = lambda n=0ud ->{=n:n++} + dim cards(52) as byte< { + call void ms_lcg(game) + dim ncards() + ncards()=cards() + for i = 51 to 0 + c = ms_lcg() Mod (i +1) + Swap ncards(i), ncards(c) + next + =ncards() + } + }() ' execute now + dim dealcards() + string suit = "CDHS", value = "A23456789TJQK" + aList=(1, 617) + nList=each(alist) + while nList + Print "Game:"+array(nList) + dealcards() = deal(array(nlist)) + CardDis$ = lambda$ dealcards(), suit, value (c)-> { + s = dealcards(51 - c) Mod 4 + 1 + v = dealcards(51 - c) div 4 + 1 + =Mid$(value,v, 1)+Mid$(suit,s, 1) + } + c=0 + Do + Print CardDis$(c); + if c mod 8 < 7 then ? " "; Else ? + c++ + until c>51 + ? : ? + end while +} +FreeCellDeal diff --git a/Task/Death-Star/FreeBASIC/death-star.basic b/Task/Death-Star/FreeBASIC/death-star-1.basic similarity index 100% rename from Task/Death-Star/FreeBASIC/death-star.basic rename to Task/Death-Star/FreeBASIC/death-star-1.basic diff --git a/Task/Death-Star/FreeBASIC/death-star-2.basic b/Task/Death-Star/FreeBASIC/death-star-2.basic new file mode 100644 index 0000000000..008d4ea2d0 --- /dev/null +++ b/Task/Death-Star/FreeBASIC/death-star-2.basic @@ -0,0 +1,100 @@ +Type vector + v(2) As Double +End Type + +Type sphere + cx As Integer + cy As Integer + cz As Integer + r As Integer +End Type + +Function dot(x As vector, y As vector) As Double + Return x.v(0)*y.v(0) + x.v(1)*y.v(1) + x.v(2)*y.v(2) +End Function + +Sub normalizeVector(v As vector) + Dim invLen As Double = 1.0 / Sqr(dot(v, v)) + v.v(0) *= invLen + v.v(1) *= invLen + v.v(2) *= invLen +End Sub + +Function hitSphere(s As sphere, x As Integer, y As Integer, z1 As Double Ptr, z2 As Double Ptr) As Boolean + Dim xx As Integer = x - s.cx + Dim yy As Integer = y - s.cy + Dim zsq As Integer = s.r*s.r - (xx*xx + yy*yy) + + If zsq >= 0 Then + Dim zsqrt As Double = Sqr(zsq) + *z1 = s.cz - zsqrt + *z2 = s.cz + zsqrt + Return True + End If + Return False +End Function + +Function createDeathStar(posic As sphere, neg As sphere, k As Double, amb As Double, direc As vector) As Any Ptr + Dim As Integer w = posic.r * 4 + Dim As Integer h = posic.r * 3 + + Dim As Any Ptr img = Imagecreate(w, h, Rgb(0,0,0)) + + Dim vec As vector + Dim As Double z1, z2, zs1, zs2 + + For y As Integer = posic.cy - posic.r To posic.cy + posic.r + For x As Integer = posic.cx - posic.r To posic.cx + posic.r + If hitSphere(posic, x, y, @z1, @z2) Then + Dim hit As Boolean = hitSphere(neg, x, y, @zs1, @zs2) + + If hit Then + If zs1 > z1 Then hit = False + If zs2 > z2 Then Continue For + End If + + If hit Then + vec.v(0) = neg.cx - x + vec.v(1) = neg.cy - y + vec.v(2) = neg.cz - zs2 + Else + vec.v(0) = x - posic.cx + vec.v(1) = y - posic.cy + vec.v(2) = z1 - posic.cz + End If + + normalizeVector(vec) + Dim s As Double = dot(direc, vec) + If s < 0 Then s = 0 + + Dim lum As Double = 255 * (s^k + amb) / (1 + amb) + If lum < 0 Then lum = 0 + If lum > 255 Then lum = 255 + + Dim shade As Integer = lum + Pset img, (x + w\2, y + h\2), Rgb(shade, shade, shade) + End If + Next x + Next y + + Return img +End Function + +' Main program +Screenres 500, 400, 32 +Windowtitle "Death Star FreeBASIC" + +Dim direct As vector +direct.v(0) = 20 +direct.v(1) = -40 +direct.v(2) = -10 +normalizeVector(direct) + +Dim posic As sphere = Type(0, 0, 0, 120) +Dim neg As sphere = Type(-50, -50, -30, 75) + +Dim img As Any Ptr = createDeathStar(posic, neg, 1.5, 0.2, direct) +Put (0, 0), img +Imagedestroy(img) + +Sleep diff --git a/Task/Death-Star/FutureBasic/death-star-1.basic b/Task/Death-Star/FutureBasic/death-star-1.basic new file mode 100644 index 0000000000..b46ca64359 --- /dev/null +++ b/Task/Death-Star/FutureBasic/death-star-1.basic @@ -0,0 +1,86 @@ +_window = 1 +begin enum 1 + _circularView + _OvalView +end enum + +void local fn BuildWindow + CGRect r = fn CGRectMake( 0, 0, 400, 400 ) + window _window, @"Rosetta Code Death Star", r, NSWindowStyleMaskTitled + NSWindowStyleMaskClosable + NSWindowStyleMaskMiniaturizable + WindowSetBackgroundColor( _window, fn ColorBlack ) + + r = fn CGRectMake( 20, 20, 360, 360 ) + subclass view _circularView, r, _window + + r = fn CGRectMake( 50, 170, 200, 180 ) + subclass view _OvalView,r, _circularView +end fn + +local fn OvalView( tag as NSInteger ) + CGRect r = fn ViewBounds( tag ) + ViewSetWantsLayer( tag, YES ) + CFArrayRef cols = @[fn ColorWithRGB(0.125,0.125,0.125,1),fn ColorWithRGB(0.425,0.425,0.4425,1),fn ColorWithRGB(0.725,0.725,0.725,1),fn ColorWithRGB(0.925,0.925,0.925,1),fn ColorWhite,fn ColorWhite ] + + CALayerRef layer = fn CALayerInit + ViewSetLayer( tag, layer ) + CALayerSetCornerRadius( layer, r.size.height / 2.0 ) + CALayerSetMasksToBounds( layer, YES ) + CALayerSetBorderWidth( layer, 0.25 ) + CALayerSetBorderColor( layer, fn ColorBlue ) + + CAGradientLayerRef gradLayer = fn CAGradientLayerInit + CAGradientLayerSetColors( gradLayer, cols ) + CALayerSetCornerRadius( gradLayer, r.size.Height / 2.0 ) + CAGradientLayerSetStartPoint( gradLayer, fn CGPointMake(1,0) ) + CAGradientLayerSetEndPoint( gradLayer, fn CGPointMake(0,1) ) + CALayerSetShadowOffset( gradLayer, fn CGSizeMake( 10, -10 ) ) + CALayerSetShadowRadius( gradLayer, 3.0 ) + CALayerSetShadowOpacity( gradLayer, 0.4 ) + CALayerSetFrame( gradLayer, fn CGRectMake(0,0,200,200) ) + + CALayerAddSublayer( layer, gradLayer ) +end fn + +local fn CircularView( tag as NSinteger ) + CGRect r = fn ViewBounds( tag ) + ViewSetWantsLayer( tag, YES ) + CFArrayRef cols = @[fn ColorWithRGB(0.125,0.125,0.125,1),fn ColorWithRGB(0.425,0.425,0.4425,1),fn ColorWithRGB(0.725,0.725,0.725,1),fn ColorWithRGB(0.925,0.925,0.925,1),fn ColorWhite,fn ColorWhite ] + CALayerRef layer = fn CALayerInit + + ViewSetLayer( tag, layer ) + CALayerSetCornerRadius( layer, r.size.width / 2.0 ) + CALayerSetMasksToBounds( layer, YES ) + CALayerSetBorderWidth( layer, 0.25 ) + CALayerSetBorderColor( layer, fn ColorBlack ) + + CAGradientLayerRef gradLayer = fn CAGradientLayerInit + CALayerSetCornerRadius( gradLayer, r.size.width / 2.0 ) + CAGradientLayerSetColors( gradLayer, cols ) + CAGradientLayerSetStartPoint( gradLayer, fn CGPointMake( 0,0.2 ) ) + CAGradientLayerSetEndPoint( gradLayer, fn CGPointMake( 1,1 ) ) + CALayerSetShadowOffset( gradLayer, fn CGSizeMake( 10, -10 ) ) + CALayerSetShadowRadius( gradLayer, 3.0 ) + CALayerSetShadowOpacity( gradLayer, 0.4 ) + CALayerSetFrame( gradLayer, fn CGRectMake(0,0,360,360) ) + CALayerAddSublayer( layer, gradLayer ) +end fn + + +void local fn DoDialog( ev as long, tag as long, wnd as long ) + select ( ev ) + case _viewDrawRect + select ( tag ) + case _circularView : fn CircularView( tag ) + + case _OvalView : fn OvalView( tag) + + end select + case _windowWillClose : end + end select +end fn + +on dialog fn DoDialog + +fn BuildWindow + +HandleEvents diff --git a/Task/Death-Star/FutureBasic/death-star-2.basic b/Task/Death-Star/FutureBasic/death-star-2.basic new file mode 100644 index 0000000000..18d86f6adf --- /dev/null +++ b/Task/Death-Star/FutureBasic/death-star-2.basic @@ -0,0 +1,60 @@ +_window = 1 +begin enum 1 + _circularView + _ovalView +end enum + +void local fn BuildWindow + CGRect r = fn CGRectMake( 0, 0, 400, 400 ) + + window _window, @"Death Star", r, NSWindowStyleMaskTitled + NSWindowStyleMaskClosable + NSWindowStyleMaskMiniaturizable + WindowSetBackgroundColor( _window, fn ColorBlack ) + + r = fn CGRectMake( 20, 20, 360, 360 ) + subclass view _circularView, r + + r = fn CGRectMake( 0, 120, 200, 200 ) + subclass view _ovalView, r +end fn + +local fn OvalView( tag as NSInteger ) + CGRect r = fn ViewBounds( tag ) + r.size.height *= 0.5 + CFArrayRef cols = @[fn ColorWithWhite(0.8,1),fn ColorBlack] + BezierPathRef path = fn BezierPathWithOvalInRect( r ) + GradientRef grad = fn GradientWithColors( cols ) + GraphicsContextSaveGraphicsState + AffineTransformRef tx = fn AffineTransformInit + NSPoint center = fn CGPointMake( fn CGRectGetMidX(r), fn CGRectGetMidY(r)) + center.x -= 25 + AffineTransformTranslate( tx, center.x, center.y ) + AffineTransformRotateByDegrees( tx, 52 ) + AffineTransformConcat( tx ) + GradientDrawInBezierPath( grad, path, 0.0 ) + GraphicsContextRestoreGraphicsState +end fn + +local fn CircularView( tag as NSinteger ) + CGRect r = fn ViewBounds( tag ) + CFArrayRef cols = @[fn ColorWithWhite(0.1,1),fn ColorWhite] + BezierPathRef path = fn BezierPathWithOvalInRect( r ) + GradientRef grad = fn GradientWithColors( cols ) + GradientDrawInBezierPath( grad, path, 0.0 ) +end fn + +void local fn DoDialog( ev as long, tag as long ) + select ( ev ) + case _viewDrawRect + select ( tag ) + case _circularView : fn CircularView( tag ) + case _ovalView : fn OvalView( tag) + end select + case _windowWillClose : end + end select +end fn + +on dialog fn DoDialog + +fn BuildWindow + +HandleEvents diff --git a/Task/Deceptive-numbers/Forth/deceptive-numbers.fth b/Task/Deceptive-numbers/Forth/deceptive-numbers.fth new file mode 100644 index 0000000000..a3289a799e --- /dev/null +++ b/Task/Deceptive-numbers/Forth/deceptive-numbers.fth @@ -0,0 +1,44 @@ +: modpow { c b a -- a^b mod c } + c 1 = if 0 exit then + 1 + a c mod to a + begin + b 0> + while + b 1 and 1 = if + a * c mod + then + a a * c mod to a + b 2/ to b + repeat ; + +: deceptive? ( n -- ? ) + dup 2 mod 0= if drop false exit then + dup 3 mod 0= if drop false exit then + dup 5 mod 0= if drop false exit then + dup dup 1- 10 modpow 1 <> if drop false exit then + 7 begin + 2dup dup * > + while + 2dup mod 0= if 2drop true exit then + 4 + + 2dup mod 0= if 2drop true exit then + 2 + + repeat + 2drop false ; + +: main ( -- ) + 0 7 begin + over 100 < + while + dup deceptive? if + dup 6 .r + swap 1+ swap + over 10 mod 0= if cr else space then + then + 1+ + repeat + 2drop ; + +main +bye diff --git a/Task/Deceptive-numbers/Langur/deceptive-numbers.langur b/Task/Deceptive-numbers/Langur/deceptive-numbers.langur index acba2f2f8c..615ec14669 100644 --- a/Task/Deceptive-numbers/Langur/deceptive-numbers.langur +++ b/Task/Deceptive-numbers/Langur/deceptive-numbers.langur @@ -1,6 +1,6 @@ val isPrime = fn(i) { i == 2 or i > 2 and - not any(fn x: i div x, pseries(2 .. i ^/ 2)) + not any(series(2 .. i ^/ 2, asconly=true), by=fn x:i div x) } var nums = [] diff --git a/Task/Deconvolution-2D+/C++/deconvolution-2d+.cpp b/Task/Deconvolution-2D+/C++/deconvolution-2d+.cpp index 50449ee68e..04e6133754 100644 --- a/Task/Deconvolution-2D+/C++/deconvolution-2d+.cpp +++ b/Task/Deconvolution-2D+/C++/deconvolution-2d+.cpp @@ -6,30 +6,6 @@ #include #include -std::complex add(const std::complex& c1, const std::complex& c2) { - return std::complex(c1.real() + c2.real(), c1.imag() + c2.imag()); -} - -std::complex subtract(const std::complex& c1, const std::complex& c2) { - return std::complex(c1.real() - c2.real(), c1.imag() - c2.imag()); -} - -std::complex multiply(const std::complex& c1, const std::complex& c2) { - return std::complex(c1.real() * c2.real() - c1.imag() * c2.imag(), - c1.imag() * c2.real() + c1.real() * c2.imag()); -} - -std::complex divide(const std::complex& complex, const int32_t& n) { - return std::complex(complex.real() / n, complex.imag() / n); -} - -std::complex divide(const std::complex& c1, const std::complex& c2) { - const double rr = c1.real() * c2.real() + c1.imag() * c2.imag(); - const double ii = c1.imag() * c2.real() - c1.real() * c2.imag(); - const double norm = c2.real() *c2.real() + c2.imag() * c2.imag(); - return std::complex(rr / norm, ii / norm); -} - struct Return_Value { int32_t power_of_two; std::vector> list; @@ -62,7 +38,7 @@ void print_3D_vector(const std::vector>>& lists) { print_2D_vector(lists.back()); std::cout << "]" << std::endl; } -Return_Value padAndComplexify(const std::vector& list, const int32_t& power_of_two) { +Return_Value pad_and_complexify(const std::vector& list, const int32_t& power_of_two) { const int32_t padded_vector_size = ( power_of_two == 0 ) ? 1 << static_cast(std::ceil(std::log(list.size()) / std::log(2))) : power_of_two; std::vector> padded_vector(padded_vector_size, std::complex(0.0, 0.0)); @@ -134,10 +110,9 @@ void fft(std::vector>& deconvolution1D, std::vector t = multiply( - std::complex(std::cos(theta), std::sin(theta)), result[j + step + start]); - deconvolution1D[( j / 2 ) + start] = add(result[j + start], t); - deconvolution1D[( ( j + power_of_two ) / 2 ) + start] = subtract(result[j + start], t); + std::complex t = std::complex(std::cos(theta), std::sin(theta)) * result[j + step + start]; + deconvolution1D[( j / 2 ) + start] = result[j + start] + t; + deconvolution1D[( ( j + power_of_two ) / 2 ) + start] = result[j + start] - t; } } } @@ -155,9 +130,9 @@ std::vector deconvolution(const std::vector& convolved, const const int32_t& convolved_row_size, const int32_t& remain_size) { int32_t power_of_two = 0; - Return_Value convoluted_result = padAndComplexify(convolved, power_of_two); + Return_Value convoluted_result = pad_and_complexify(convolved, power_of_two); std::vector> convoluted_padded = convoluted_result.list; - Return_Value remove_result = padAndComplexify(remove, convoluted_result.power_of_two); + Return_Value remove_result = pad_and_complexify(remove, convoluted_result.power_of_two); std::vector> remove_padded = remove_result.list; power_of_two = remove_result.power_of_two; @@ -165,7 +140,7 @@ std::vector deconvolution(const std::vector& convolved, const fft(remove_padded, power_of_two); std::vector> quotient(power_of_two, std::complex(0.0, 0.0)); for ( int32_t i = 0; i < power_of_two; ++i ) { - quotient[i] = divide(convoluted_padded[i], remove_padded[i]); + quotient[i] = convoluted_padded[i] / remove_padded[i]; } fft(quotient, power_of_two); @@ -178,8 +153,8 @@ std::vector deconvolution(const std::vector& convolved, const std::vector remain_vector(remain_size, 0); int32_t i = 0; while ( i > remove_size - convolved_size - convolved_row_size ) { - remain_vector[-i] = std::lround( - divide(quotient[( i + power_of_two ) % power_of_two], 32.0).real()); + remain_vector[-i] = std::lround(( + quotient[( i + power_of_two ) % power_of_two] / std::complex(32.0, 0.0)).real()); i -= 1; } return remain_vector; diff --git a/Task/Delegates/EMal/delegates.emal b/Task/Delegates/EMal/delegates.emal new file mode 100644 index 0000000000..fbe738a0a4 --- /dev/null +++ b/Task/Delegates/EMal/delegates.emal @@ -0,0 +1,25 @@ +type Thingable +interface + fun thing ← text by block do end +end +type Delegate implements Thingable +model + fun thing ← text by block + return "delegate implementation" + end +end +type Delegator +model + Thingable delegate + fun operation ← <|when(me.delegate æ null, "default implementation", me.delegate.thing()) +end +fun byDelegate ← Delegator by Thingable delegate + var delegator ← Delegator() + delegator.delegate ← delegate + return delegator +end +type Main +Delegator a ← Delegator() +writeLine(a.operation()) +Delegator b ← Delegator.byDelegate(Delegate()) +writeLine(b.operation()) diff --git a/Task/Descending-primes/Scala/descending-primes.scala b/Task/Descending-primes/Scala/descending-primes.scala new file mode 100644 index 0000000000..cad06bbd50 --- /dev/null +++ b/Task/Descending-primes/Scala/descending-primes.scala @@ -0,0 +1,42 @@ +def isPrime(n: Long): Boolean = { + @annotation.tailrec + def hasDivisor(f: Long): Boolean = + if (f * f > n) false + else if (n % f == 0 || n % (f + 2) == 0) true + else hasDivisor(f + 6) + + if (n < 2) false + else if (n == 2 || n == 3) true + else if (n % 2 == 0 || n % 3 == 0) false + else { + !hasDivisor(5) + } +} + +def descendingPrimes(): Seq[Int] = { + val digits = Seq(9, 8, 7, 6, 5, 4, 3, 2, 1) + + val (_, primes) = digits.foldLeft((Seq(0), Seq.empty[Int])) { case ((candidates, primes), digit) => + val newCandidates = candidates.map(_ * 10 + digit) + val newPrimes = primes ++ newCandidates.filter(isPrime) + (candidates ++ newCandidates, newPrimes) + } + + primes.sorted +} + +@main def main(): Unit = { + def test(): Unit = { + val primes = descendingPrimes() + + val maxDigits = primes.map(_.toString.length).max + val columnsPerLine = 8 + val groupedPrimes = primes.grouped(columnsPerLine) + groupedPrimes.foreach { group => + val formattedGroup = group.map(p => String.format(s"%${maxDigits}d", Int.box(p))).mkString(" ") + println(formattedGroup) + } + } + + test() +} diff --git a/Task/Determinant-and-permanent/00-TASK.txt b/Task/Determinant-and-permanent/00-TASK.txt index 7359865431..cce4a54788 100644 --- a/Task/Determinant-and-permanent/00-TASK.txt +++ b/Task/Determinant-and-permanent/00-TASK.txt @@ -8,7 +8,6 @@ In both cases the sum is over the permutations \sigma of the permut More efficient algorithms for the determinant are known: [[LU decomposition]], see for example [[wp:LU decomposition#Computing the determinant]]. Efficient methods for calculating the permanent are not known. - ;Related task: * [[Permutations by swapping]]

diff --git a/Task/Determinant-and-permanent/ALGOL-68/determinant-and-permanent.alg b/Task/Determinant-and-permanent/ALGOL-68/determinant-and-permanent.alg new file mode 100644 index 0000000000..c25b5c3420 --- /dev/null +++ b/Task/Determinant-and-permanent/ALGOL-68/determinant-and-permanent.alg @@ -0,0 +1,84 @@ +BEGIN # matrix determinant and permanent # + # - translated from the Phix sample, via EasyLang # + + MODE NUMBER = REAL; # type of matrix elements to be handled # + # adjust to suit, if necessary # + + PROC minor = ( [,]NUMBER a, INT x, y )[,]NUMBER: + BEGIN + [ 1 LWB a : 1 UPB a - 1, 2 LWB a : 2 UPB a - 1 ]NUMBER r; + FOR i FROM 1 LWB a TO 1 UPB a - 1 DO + FOR j FROM 2 LWB a TO 2 UPB a - 1 DO + r[ i, j ] := a[ i + ABS ( i >= x ), j + ABS ( j >= y ) ] + OD + OD; + r + END # minor # ; + + PROC det = ( [,]NUMBER a )NUMBER: + IF 1 UPB a = 1 LWB a THEN # only one NUMBER # + a[ 1 LWB a, 2 LWB a ] + ELSE + INT sgn := 1; + NUMBER res := 0; + FOR i FROM 2 LWB a TO 2 UPB a DO + res +:= sgn * a[ 1 LWB a, i ] * det( minor( a, 1 LWB a, i ) ); + sgn := - sgn + OD; + res + FI # det # ; + + PROC perm = ( [,]NUMBER a )NUMBER: + IF 1 UPB a = 1 LWB a THEN # only one NUMBER # + a[ 1 LWB a, 2 LWB a ] + ELSE + NUMBER res := 0; + FOR i FROM 2 LWB a TO 2 UPB a DO + res +:= a[ 1 LWB a, i ] * perm( minor( a, 1 LWB a, i ) ) + OD; + res + FI # perm # ; + + BEGIN # test cases # + PROC test det and perm = ( [,]NUMBER a )VOID: + print( ( whole( det( a ), -8 ), " ", whole( perm( a ), -8 ), newline ) ); + + test det and perm( ( ( 1, 2 ) + , ( 3, 4 ) + ) + ); + test det and perm( ( ( 2, 9, 4 ) + , ( 7, 5, 3 ) + , ( 6, 1, 8 ) + ) ); + test det and perm( ( ( -2, 2, -3 ) + , ( -1, 1, 3 ) + , ( 2, 0, -1 ) + ) + ); + test det and perm( ( ( 1, 2, 3, 4 ) + , ( 4, 5, 6, 7 ) + , ( 7, 8, 9, 10 ) + , ( 10, 11, 12, 13 ) + ) + ); + test det and perm( ( ( 0, 1, 2, 3, 4 ) + , ( 5, 6, 7, 8, 9 ) + , ( 10, 11, 12, 13, 14 ) + , ( 15, 16, 17, 18, 19 ) + , ( 20, 21, 22, 23, 24 ) + ) + ); + test det and perm( ( ( 5 ) ) ); + test det and perm( ( ( 1, 0, 0 ) + , ( 0, 1, 0 ) + , ( 0, 0, 1 ) + ) + ); + test det and perm( ( ( 0, 0, 1 ) + , ( 0, 1, 0 ) + , ( 1, 0, 0 ) + ) + ) + END +END diff --git a/Task/Determinant-and-permanent/XPL0/determinant-and-permanent.xpl0 b/Task/Determinant-and-permanent/XPL0/determinant-and-permanent.xpl0 new file mode 100644 index 0000000000..74c60b83ae --- /dev/null +++ b/Task/Determinant-and-permanent/XPL0/determinant-and-permanent.xpl0 @@ -0,0 +1,48 @@ +func DetPerm(Det, A, N); \Return value of determinant or permanent of A, order N +int Det, A, N; +int B Sum, Term; +int I, K, L; +[if N = 1 then return A(0, 0); +B:= Reserve((N-1)*4); +Sum:= 0; +for I:= 0 to N-1 do + [L:= 0; + for K:= 0 to N-1 do + if K # I then + [B(L):= @A(K, 1); L:= L+1]; + Term:= A(I, 0) * DetPerm(Det, B, N-1); + if Det & I&1 then Term:= -Term; + Sum:= Sum + Term; + ]; +return Sum; +]; + +int Arrays, I; +[Arrays:= [ + [ [1, 2], + [3, 4] ], + + [ [-2, 2, -3], + [-1, 1, 3], + [ 2, 0, -1] ], + + [ [ 1, 2, 3, 4], + [ 4, 5, 6, 7], + [ 7, 8, 9, 10], + [10, 11, 12, 13] ], + + [ [ 0, 1, 2, 3, 4], + [ 5, 6, 7, 8, 9], + [10, 11, 12, 13, 14], + [15, 16, 17, 18, 19], + [20, 21, 22, 23, 24] ] + ]; +for I:= 0 to 3 do + [Text(0, "Determinant: "); + IntOut(0, DetPerm(true, Arrays(I), I+2)); + CrLf(0); + Text(0, "Permanent : "); + IntOut(0, DetPerm(false, Arrays(I), I+2)); + CrLf(0); CrLf(0); + ]; +] diff --git a/Task/Determine-if-a-string-has-all-the-same-characters/C/determine-if-a-string-has-all-the-same-characters-1.c b/Task/Determine-if-a-string-has-all-the-same-characters/C/determine-if-a-string-has-all-the-same-characters-1.c deleted file mode 100644 index 19fdbf57c8..0000000000 --- a/Task/Determine-if-a-string-has-all-the-same-characters/C/determine-if-a-string-has-all-the-same-characters-1.c +++ /dev/null @@ -1,33 +0,0 @@ -#include -#include - -int main(int argc,char** argv) -{ - int i,len; - char reference; - - if(argc>2){ - printf("Usage : %s \n",argv[0]); - return 0; - } - - if(argc==1||strlen(argv[1])==1){ - printf("Input string : \"%s\"\nLength : %d\nAll characters are identical.\n",argc==1?"":argv[1],argc==1?0:(int)strlen(argv[1])); - return 0; - } - - reference = argv[1][0]; - len = strlen(argv[1]); - - for(i=1;i -#include -#include - -/* - * The wide character version of the program is compiled if WIDE_CHAR is defined - */ -#define WIDE_CHAR - -#ifdef WIDE_CHAR -#define CHAR wchar_t -#else -#define CHAR char -#endif - -/** - * Find a character different from the preceding characters in the given string. - * - * @param s the given string, NULL terminated. - * - * @return the pointer to the occurence of the different character - * or a pointer to NULL if all characters in the string - * are exactly the same. - * - * @notice This function return a pointer to NULL also for empty strings. - * Returning NULL-or-CHAR would not enable to compute the position - * of the non-matching character. - * - * @warning This function compare characters (single-bytes, unicode etc.). - * Therefore this is not designed to compare bytes. The NULL character - * is always treated as the end-of-string marker, thus this function - * cannot be used to scan strings with NULL character inside string, - * for an example "aaa\0aaa\0\0". - */ -const CHAR* find_different_char(const CHAR* s) -{ - /* The code just below is almost the same regardles - char or wchar_t is used. */ - - const CHAR c = *s; - while (*s && c == *s) - { - s++; - } - return s; -} - -/** - * Apply find_different_char function to a given string and output the raport. - * - * @param s the given NULL terminated string. - */ -void report_different_char(const CHAR* s) -{ -#ifdef WIDE_CHAR - wprintf(L"\n"); - wprintf(L"string: \"%s\"\n", s); - wprintf(L"length: %d\n", wcslen(s)); - const CHAR* d = find_different_char(s); - if (d) - { - /* - * We have got the famous pointers arithmetics and we can compute - * difference of pointers pointing to the same array. - */ - wprintf(L"character '%wc' (%#x) at %d\n", *d, *d, (int)(d - s)); - } - else - { - wprintf(L"all characters are the same\n"); - } - wprintf(L"\n"); -#else - putchar('\n'); - printf("string: \"%s\"\n", s); - printf("length: %d\n", strlen(s)); - const CHAR* d = find_different_char(s); - if (d) - { - /* - * We have got the famous pointers arithmetics and we can compute - * difference of pointers pointing to the same array. - */ - printf("character '%c' (%#x) at %d\n", *d, *d, (int)(d - s)); - } - else - { - printf("all characters are the same\n"); - } - putchar('\n'); -#endif -} - -/* There is a wmain function as an entry point when argv[] points to wchar_t */ - -#ifdef WIDE_CHAR -int wmain(int argc, wchar_t* argv[]) -#else -int main(int argc, char* argv[]) -#endif -{ - if (argc < 2) - { - report_different_char(L""); - report_different_char(L" "); - report_different_char(L"2"); - report_different_char(L"333"); - report_different_char(L".55"); - report_different_char(L"tttTTT"); - report_different_char(L"4444 444k"); - } - else - { - report_different_char(argv[1]); - } - - return EXIT_SUCCESS; -} diff --git a/Task/Determine-if-a-string-has-all-the-same-characters/C/determine-if-a-string-has-all-the-same-characters.c b/Task/Determine-if-a-string-has-all-the-same-characters/C/determine-if-a-string-has-all-the-same-characters.c new file mode 100644 index 0000000000..5517b124d6 --- /dev/null +++ b/Task/Determine-if-a-string-has-all-the-same-characters/C/determine-if-a-string-has-all-the-same-characters.c @@ -0,0 +1,37 @@ +#include +#include +#include + +void +allCharsSame(const char *s) +{ + const char *p; + ptrdiff_t offs; + + printf("Input: \"%s\", length = %ld\n", s, strlen(s)); + + for (p = s; *p; p++) { + if (p[1] && p[0] != p[1]) { + offs = &p[1] - s; + /* +8 to skip past 'Input: "' */ + printf("%-*s^\n", (int)offs+8, ""); + printf("Difference at position %ld: '%c' (%#02x) != '%c' (%#02x)\n", + offs, p[0], p[0], p[1], p[1]); + return; + } + } + printf("All characters are identical\n"); +} + +int +main(void) +{ + allCharsSame(""); + allCharsSame(" "); + allCharsSame("2"); + allCharsSame("333"); + allCharsSame(".55"); + allCharsSame("tttTTT"); + allCharsSame("4444 444k"); + return 0; +} diff --git a/Task/Determine-if-a-string-has-all-unique-characters/C/determine-if-a-string-has-all-unique-characters.c b/Task/Determine-if-a-string-has-all-unique-characters/C/determine-if-a-string-has-all-unique-characters.c index 31f2fa664f..51b8cdd0b7 100644 --- a/Task/Determine-if-a-string-has-all-unique-characters/C/determine-if-a-string-has-all-unique-characters.c +++ b/Task/Determine-if-a-string-has-all-unique-characters/C/determine-if-a-string-has-all-unique-characters.c @@ -1,128 +1,40 @@ -#include -#include -#include -#include +#include +#include +#include -typedef struct positionList{ - int position; - struct positionList *next; -}positionList; - -typedef struct letterList{ - char letter; - int repititions; - positionList* positions; - struct letterList *next; -}letterList; - -letterList* letterSet; -bool duplicatesFound = false; - -void checkAndUpdateLetterList(char c,int pos){ - bool letterOccurs = false; - letterList *letterIterator,*newLetter; - positionList *positionIterator,*newPosition; - - if(letterSet==NULL){ - letterSet = (letterList*)malloc(sizeof(letterList)); - letterSet->letter = c; - letterSet->repititions = 0; - - letterSet->positions = (positionList*)malloc(sizeof(positionList)); - letterSet->positions->position = pos; - letterSet->positions->next = NULL; - - letterSet->next = NULL; - } - - else{ - letterIterator = letterSet; - - while(letterIterator!=NULL){ - if(letterIterator->letter==c){ - letterOccurs = true; - duplicatesFound = true; - - letterIterator->repititions++; - positionIterator = letterIterator->positions; - - while(positionIterator->next!=NULL) - positionIterator = positionIterator->next; - - newPosition = (positionList*)malloc(sizeof(positionList)); - newPosition->position = pos; - newPosition->next = NULL; - - positionIterator->next = newPosition; - } - if(letterOccurs==false && letterIterator->next==NULL) - break; - else - letterIterator = letterIterator->next; - } - - if(letterOccurs==false){ - newLetter = (letterList*)malloc(sizeof(letterList)); - newLetter->letter = c; - - newLetter->repititions = 0; - - newLetter->positions = (positionList*)malloc(sizeof(positionList)); - newLetter->positions->position = pos; - newLetter->positions->next = NULL; - - newLetter->next = NULL; - - letterIterator->next = newLetter; - } - } +/* +* return -1 if s has no repeated characters, otherwise the array +* index where a duplicated character first reappears +*/ +int uniquechars(char *s) { + int i, j, slen; + slen = strlen(s); + if (slen < 2) return -1; + for (i = 0; i < (slen - 1); i++) + for (j = i + 1; j < slen; j++) + if (s[i] == s[j]) return j; + return -1; } -void printLetterList(){ - positionList* positionIterator; - letterList* letterIterator = letterSet; - - while(letterIterator!=NULL){ - if(letterIterator->repititions>0){ - printf("\n'%c' (0x%x) at positions :",letterIterator->letter,letterIterator->letter); - - positionIterator = letterIterator->positions; - - while(positionIterator!=NULL){ - printf("%3d",positionIterator->position + 1); - positionIterator = positionIterator->next; - } - } - - letterIterator = letterIterator->next; - } - printf("\n"); +void report(char *s) { + int pos, first; + pos = uniquechars(s); + if (pos == -1) + printf("\"%s\" (length = %d) has no duplicate characters\n", s, strlen(s)); + else { + printf("\"%s\" (length = %d) has duplicate characters:\n", s, strlen(s)); + /* find first instance of duplicated ch in s */ + first = (int) (strchr(s, s[pos]) - s); + printf(" '%c' (= %2Xh) appears at positions %d and %d\n", + s[pos], s[pos], first+1, pos+1); + } } -int main(int argc,char** argv) -{ - int i,len; - - if(argc>2){ - printf("Usage : %s \n",argv[0]); - return 0; - } - - if(argc==1||strlen(argv[1])==1){ - printf("\"%s\" - Length %d - Contains only unique characters.\n",argc==1?"":argv[1],argc==1?0:1); - return 0; - } - - len = strlen(argv[1]); - - for(i=0;i 0 + dr = dr + n mod(10) + n = int(n / 10) + wend + + ap = ap + 1 + n = dr + until dr < 10 + +end fn = dr + + +long a(2) +a(0) = 627615 : a(1) = 39390 : a(2) = 588225 +short i +for i = 0 to 2 + dr = fn digitalRoot(a(i)) + print a(i), "Additive persistence = ", ap, "Digital root = ", dr +next i + +handleevents diff --git a/Task/Dijkstras-algorithm/FreeBASIC/dijkstras-algorithm.basic b/Task/Dijkstras-algorithm/FreeBASIC/dijkstras-algorithm.basic new file mode 100644 index 0000000000..41e56c1e89 --- /dev/null +++ b/Task/Dijkstras-algorithm/FreeBASIC/dijkstras-algorithm.basic @@ -0,0 +1,140 @@ +Const INFINITY As Integer = &h7FFFFFFF + +Type Edge + src As String * 1 + dst As String * 1 + cost As Integer +End Type + +Type Vertex + nom As String * 1 + dist As Integer + prev As String * 1 +End Type + +Type Graph + edges(100) As Edge + edgeCount As Integer + verts(100) As Vertex + vertCount As Integer +End Type + +Function createGraph(edges() As Edge, cnt As Integer) As Graph + Dim As Graph g + Dim As String names(100) + Dim As Integer i, j, nCount = 0 + + g.edgeCount = cnt + + ' Copy edges and collect unique vertices + For i = 0 To cnt - 1 + g.edges(i) = edges(i) + + ' Check source vertex + Dim As Boolean found = False + For j = 0 To nCount - 1 + If names(j) = edges(i).src Then + found = True + Exit For + End If + Next + If Not found Then + names(nCount) = edges(i).src + nCount += 1 + End If + + ' Check destination vertex + found = False + For j = 0 To nCount - 1 + If names(j) = edges(i).dst Then + found = True + Exit For + End If + Next + If Not found Then + names(nCount) = edges(i).dst + nCount += 1 + End If + Next + + ' Initialize vertices + g.vertCount = nCount + For i = 0 To nCount - 1 + With g.verts(i) + .nom = names(i) + .dist = INFINITY + .prev = names(i) + End With + Next + + Return g +End Function + +Function findVertex(g As Graph, nombre As String) As Integer + For i As Integer = 0 To g.vertCount - 1 + If g.verts(i).nom = nombre Then Return i + Next + Return -1 +End Function + +Function dijkstraPath(g As Graph, source As String, dest As String) As Integer + Dim As Integer changed, i, srcIdx, dstIdx, newDist, destIdx + srcIdx = findVertex(g, source) + If srcIdx >= 0 Then g.verts(srcIdx).dist = 0 + + Do + changed = 0 + For i = 0 To g.edgeCount - 1 + With g.edges(i) + srcIdx = findVertex(g, .src) + dstIdx = findVertex(g, .dst) + + If srcIdx >= 0 Andalso g.verts(srcIdx).dist <> INFINITY Then + newDist = g.verts(srcIdx).dist + .cost + If newDist < g.verts(dstIdx).dist Then + g.verts(dstIdx).dist = newDist + g.verts(dstIdx).prev = .src + changed = 1 + End If + End If + End With + Next + Loop While changed + + destIdx = findVertex(g, dest) + Return Iif(destIdx >= 0, g.verts(destIdx).dist, INFINITY) +End Function + +Function getPath(g As Graph, source As String, dest As String) As String + Dim As String path = "", current = dest + Dim As Integer idx, destIdx, cost + + ' Build path backwards + While current <> source + idx = findVertex(g, current) + If idx >= 0 Then + path = " -> " & current & path + current = g.verts(idx).prev + End If + Wend + + ' Get final cost + destIdx = findVertex(g, dest) + cost = Iif(destIdx >= 0, g.verts(destIdx).dist, INFINITY) + + Return source & " " & dest & " : " & source & path & " cost : " & cost +End Function + +' Test program +Dim As Edge testGraph(8) => {_ +("a", "b", 7), ("a", "c", 9), ("a", "f", 14), _ +("b", "c", 10), ("b", "d", 15), ("c", "d", 11), _ +("c", "f", 2), ("d", "e", 6), ("e", "f", 9)} + +Dim As Graph g = createGraph(testGraph(), 9) +Dim As String source = "a", dest = "e" + +dijkstraPath(g, source, dest) +Print getPath(g, source, dest) + +Sleep diff --git a/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm.m2000 b/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm-1.m2000 similarity index 92% rename from Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm.m2000 rename to Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm-1.m2000 index f04844c45f..b76ecc771a 100644 --- a/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm.m2000 +++ b/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm-1.m2000 @@ -4,18 +4,25 @@ Module Dijkstra`s_algorithm { dim d(n)=val =d() } + FillList=lambda (n) -> { + m=list + for i=1 to n: append m, i: next + =m + } + // tree term=("",0) Edges=(("a", ("b",7),("c",9),("f",14)),("b",("c",10),("d",15)),("c",("d",11),("f",2)),("d",("e",6)),("e",("f", 9)),("f",term)) + // Document Doc$="Graph:"+{ } ShowGraph() Doc$="Paths"+{ } Print "Paths" - For from_here=0 to 5 + For from_here=0 to Len(Edges)-1 pa=GetArr(len(Edges), -1) d=GetArr(len(Edges), max_number) - Inventory S=1,2,3,4,5,6 + S=FillList(len(Edges)) return d, from_here:=0 RemoveMin=Lambda S, d, max_number-> { ss=each(S) diff --git a/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm-2.m2000 b/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm-2.m2000 new file mode 100644 index 0000000000..918a104194 --- /dev/null +++ b/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm-2.m2000 @@ -0,0 +1,132 @@ +Module Dijkstra`s_algorithm { + const max_number=1.E+306 + GetArr=lambda (n, val)->{ + dim d(n)=val + =d() + } + FillList=lambda (n) -> { + m=list + for i=1 to n : append m, i :next + =m + } + // tree + class node { + name$, val as long + remove { + created-- + print "Node removed, left: "+created + } + class: + module node (.name$, .val) { + created++ + print "New node, total: "+created + } + } + global long created + pNode = lambda ->{ + ->node(![]) + } + Class EdgeList { + object Node[0] + name$ + class: + module EdgeList (.name$) { + n=0 + while not empty + read .Node[n] + n++ + end while + } + } + Node_A=EdgeList("a", pNode("b",7), pNode("c", 9), pNode("f",14) ) + Node_B=EdgeList("b",pNode("c",10),pNode("d",15)) + Node_C=EdgeList("c",pNode("d",11),pNode("f",2)) + Node_D=EdgeList("d",pNode("e",6)) + Node_E=EdgeList("e",pNode("f", 9)) + Node_F=EdgeList("f",pNode()) + Dim Edges(6) + Edges(0)=Node_A, Node_B, Node_C, Node_D, Node_E, Node_F + Document Doc$="Graph:"+{ + } + ShowGraph() + Doc$="Paths"+{ + } + Print "Paths" + For from_here=0 to Len(Edges())-1 + pa=GetArr(len(Edges()), -1) + d=GetArr(len(Edges()), max_number) + S=FillList(len(Edges())) + return d, from_here:=0 + RemoveMin=Lambda S, d, max_number-> { + ss=each(S) + min=max_number + p=0 + while ss + val=d#val(eval(S,ss^)-1) + if min>val then let min=val : p=ss^ + end while + =s(p!) ' use p as index not key + Delete S, eval(s,p) + } + Show_Distance_and_Path$=lambda$ d, pa, from_here, max_number (n) -> { + ret1$=chr$(from_here+asc("a"))+" to "+chr$(n+asc("a")) + if d#val(n) =max_number then =ret1$+ " No Path" :exit + let ret$="", mm=n, m=n + repeat + n=m + ret$+=chr$(asc("a")+n) + m=pa#val(n) + until from_here=n + =ret1$+format$("{0::-4} {1}",d#val(mm),strrev$(ret$)) + } + while len(s)>0 + u=RemoveMin() + rem Print u, chr$(u-1+asc("a")) + Relaxed() + end while + For i=0 to len(d)-1 + line$=Show_Distance_and_Path$(i) + Print line$ + doc$=line$+{ + } + next + next + Clipboard Doc$ + End + Sub Relaxed() + local vertex=Edges(u-1).node, i + local e=Len(vertex)-1, val + for i=0 to e + for vertex[i] { + if .name$<>"" then + val=Asc(.name$)-Asc("a") + if d#val(val)>.val+d#val(u-1) then return d, val:=.val+d#val(u-1) : Return Pa, val:=u-1 + end if + } + next + end sub + Sub ShowGraph() + Print "Graph" + local i + for i=1 to len(Edges()) + show_edges(i) + next + end sub + Sub show_edges(n) + n-- + local line$, j + for Edges(n) { + for j=0 to len(.node)-1 + Print .name$; + for .node[j] { + if ..name$>"" then + print "->"+..name$+" "+format$(" {0::-2}",..val) + else + print + end if + } + next + } + end sub +} +Dijkstra`s_algorithm diff --git a/Task/Dijkstras-algorithm/PascalABC.NET/dijkstras-algorithm.pas b/Task/Dijkstras-algorithm/PascalABC.NET/dijkstras-algorithm.pas new file mode 100644 index 0000000000..c77947a2fe --- /dev/null +++ b/Task/Dijkstras-algorithm/PascalABC.NET/dijkstras-algorithm.pas @@ -0,0 +1,78 @@ +type + Edge = auto class + start, &end: char; + cost: real; + end; + + Graph = auto class + edges: array of Edge; + vertices: HashSet; + + constructor(params edges: array of (char, char, real)); + begin + Self.edges := edges.Select(e -> new Edge(e[0], e[1], e[2])).ToArray; + Self.vertices := new HashSet( + Self.edges.Select(e -> e.start) + Self.edges.Select(e -> e.end) + ); + end; + + function Dijkstra(source, dest: char): sequence of char; + begin + assert(vertices.Contains(source)); + + var inf := real.MaxValue; + var dist := Dict(vertices.Select(v -> (v, inf))); + var previous := Dict(vertices.Select(v -> (v, ' '))); + dist[source] := 0; + + var q := vertices.ToHashSet; + var neighbours := Dict(vertices.Select(v -> (v, new HashSet<(char, real)>))); + + foreach var edge in edges do + begin + neighbours[edge.start].Add((edge.end, edge.cost)); + neighbours[edge.end].Add((edge.start, edge.cost)); + end; + + while q.Count > 0 do + begin + var u := q.MinBy(v -> dist[v]); + q.Remove(u); + + if (dist[u] = inf) or (u = dest) then + break; + + foreach var (v, cost) in neighbours[u] do + begin + var alt := dist[u] + cost; + if alt < dist[v] then + begin + dist[v] := alt; + previous[v] := u; + end; + end; + end; + + var s := new List; + var u := dest; + + while previous[u] <> ' ' do + begin + s.Insert(0, u); + u := previous[u]; + end; + + s.Insert(0, u); + Result := s; + end; + end; + +begin + var gr := new Graph( + ('a', 'b', 7.0), ('a', 'c', 9.0), ('a', 'f', 14.0), + ('b', 'c', 10.0), ('b', 'd', 15.0), ('c', 'd', 11.0), + ('c', 'f', 2.0), ('d', 'e', 6.0), ('e', 'f', 9.0) + ); + + gr.Dijkstra('a', 'e').Println; +end. diff --git a/Task/Dinesmans-multiple-dwelling-problem/FutureBasic/dinesmans-multiple-dwelling-problem.basic b/Task/Dinesmans-multiple-dwelling-problem/FutureBasic/dinesmans-multiple-dwelling-problem.basic new file mode 100644 index 0000000000..55f4064fdc --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/FutureBasic/dinesmans-multiple-dwelling-problem.basic @@ -0,0 +1,37 @@ +// Dinesmans multiple-dwelling problem +//https://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem + + +short Baker,Cooper,Fletcher,Miller,Smith +short LoopCount + +FOR Baker = 0 TO 4 + FOR Cooper = 0 TO 4 + FOR Fletcher = 0 TO 4 + FOR Miller = 0 TO 4 + FOR Smith = 0 TO 4 + IF Baker <> 4 && Cooper <> 0 && Miller <> Cooper + IF Fletcher <> 0 && Fletcher <> 4 && ABS(Smith-Fletcher)<>1 && ABS(Fletcher-Cooper)<>1 + IF Baker<>Cooper and Baker<>Fletcher && Baker<>Miller and ¬ + Baker<>Smith and Cooper<>Fletcher and Cooper<>Miller and ¬ + Cooper<>Smith and Fletcher<>Miller and Fletcher<>Smith and ¬ + Miller<>Smith + + LoopCount ++ + if LoopCount = 4 + PRINT "Baker lives on floor " ; Baker + 1 + PRINT "Cooper lives on floor " ; Cooper + 1 + PRINT "Fletcher lives on floor " ; Fletcher + 1 + PRINT "Miller lives on floor " ; Miller + 1 + PRINT "Smith lives on floor " ; Smith + 1 + end if + END IF + END IF + END IF + NEXT Smith + NEXT Miller + NEXT Fletcher + NEXT Cooper +NEXT Baker + +handleevents diff --git a/Task/Dining-philosophers/FreeBASIC/dining-philosophers.basic b/Task/Dining-philosophers/FreeBASIC/dining-philosophers.basic new file mode 100644 index 0000000000..4909077304 --- /dev/null +++ b/Task/Dining-philosophers/FreeBASIC/dining-philosophers.basic @@ -0,0 +1,108 @@ +Const NUM_PHILOSOPHERS = 5 +Const HUNGER = 3 +Const THINK_TIME = 1000 +Const EAT_TIME = 1000 + +Type Fork + mutex As Any Ptr + available As Boolean +End Type + +Type Philosopher + nombre As String + leftFork As Fork Ptr + rightFork As Fork Ptr + hunger As Integer +End Type + +Dim Shared As Philosopher philosophers(NUM_PHILOSOPHERS-1) +Dim Shared As Fork forks(NUM_PHILOSOPHERS-1) +Dim Shared As Any Ptr printMutex + +Function threadSafePrint(text As String) As Integer + Mutexlock(printMutex) + Print text + Mutexunlock(printMutex) + Return 0 +End Function + +Sub delay(ms As Integer) + Dim As Double t = Timer + While (Timer - t) * 1000 < ms + Sleep 1, 1 + Wend +End Sub + +Function philosopherThread(param As Any Ptr) As Any Ptr + Dim As Philosopher Ptr phil = param + + threadSafePrint(phil->nombre + " seated") + + While phil->hunger > 0 + threadSafePrint(phil->nombre + " hungry") + + Mutexlock(phil->leftFork->mutex) + Mutexlock(phil->rightFork->mutex) + + threadSafePrint(phil->nombre + " eating") + delay(EAT_TIME) + + Mutexunlock(phil->leftFork->mutex) + Mutexunlock(phil->rightFork->mutex) + + threadSafePrint(phil->nombre + " thinking") + delay(THINK_TIME) + + phil->hunger -= 1 + Wend + + threadSafePrint(phil->nombre + " satisfied") + threadSafePrint(phil->nombre + " left the table") + + Return 0 +End Function + +' Main program +Dim As Integer i +Dim As String names(NUM_PHILOSOPHERS-1) = {"Aristotle", "Kant", "Spinoza", "Marx", "Russell"} +Print "Table empty" + +printMutex = Mutexcreate() + +' Initialize forks +For i = 0 To NUM_PHILOSOPHERS-1 + forks(i).mutex = Mutexcreate() + forks(i).available = True +Next + +' Initialize philosophers +For i = 0 To NUM_PHILOSOPHERS-1 + philosophers(i).nombre = names(i) + philosophers(i).hunger = HUNGER + philosophers(i).leftFork = @forks(i) + philosophers(i).rightFork = @forks((i + 1) Mod NUM_PHILOSOPHERS) +Next + +' Make last philosopher left-handed +Swap philosophers(NUM_PHILOSOPHERS-1).leftFork, philosophers(NUM_PHILOSOPHERS-1).rightFork + +' Create threads +Dim As Any Ptr threads(NUM_PHILOSOPHERS-1) +For i = 0 To NUM_PHILOSOPHERS-1 + threads(i) = Threadcreate(Cast(Sub(As Any Ptr), @philosopherThread), @philosophers(i)) +Next + +' Wait for all threads +For i = 0 To NUM_PHILOSOPHERS-1 + Threadwait(threads(i)) +Next + +' Cleanup +For i = 0 To NUM_PHILOSOPHERS-1 + Mutexdestroy(forks(i).mutex) +Next + +Mutexdestroy(printMutex) +Print "Table empty" + +Sleep diff --git a/Task/Display-a-linear-combination/XPL0/display-a-linear-combination.xpl0 b/Task/Display-a-linear-combination/XPL0/display-a-linear-combination.xpl0 new file mode 100644 index 0000000000..2186fb9b51 --- /dev/null +++ b/Task/Display-a-linear-combination/XPL0/display-a-linear-combination.xpl0 @@ -0,0 +1,37 @@ +func LinearCombo(Combo, Len); \Display linear combination of Combo +int Combo, Len; +int Zero, N, I; +[Zero:= true; +for I:= 0 to Len-1 do + [N:= Combo(I); + if N # 0 then + [ if N < 0 and Zero then Text(0, "-") + else if N < 0 then Text(0, " - ") + else if not Zero then Text(0, " + "); + if abs(N) # 1 then + [IntOut(0, abs(N)); Text(0, "*")]; + Text(0, "e("); IntOut(0, I+1); Text(0, ")"); + Zero:= false; + ]; + ]; +if Zero then Text(0, "0"); +CrLf(0); +]; + +int Combos, C; +[Combos:= [ + [1, 2, 3], + [0, 1, 2, 3], + [1, 0, 3, 4], + [1, 2, 0], + [0, 0, 0], + [0], + [1, 1, 1], + [-1, -1, -1], + [-1, -2, 0, -3], + [-1], + [0] \sentinel provides length of last item (=1) + ]; +for C:= 0 to 10-1 do + LinearCombo( Combos(C), (Combos(C+1)-Combos(C))/4 ); \4 = SizeOfInt +] diff --git a/Task/Display-an-outline-as-a-nested-table/ALGOL-68/display-an-outline-as-a-nested-table-1.alg b/Task/Display-an-outline-as-a-nested-table/ALGOL-68/display-an-outline-as-a-nested-table-1.alg new file mode 100644 index 0000000000..4ac32f3482 --- /dev/null +++ b/Task/Display-an-outline-as-a-nested-table/ALGOL-68/display-an-outline-as-a-nested-table-1.alg @@ -0,0 +1,141 @@ +BEGIN # Show an outline as a wiki or HTML table # + MODE ONODE = STRUCT( STRING text, INT indent, REF ONODE next, child ); + REF ONODE nil node = NIL; + OP LTRIM = ( STRING s )STRING: # returns s without leading spaces # + BEGIN + INT s pos := LWB s; + WHILE IF s pos > UPB s THEN FALSE ELSE s[ s pos ] = " " FI DO s pos +:= 1 OD; + IF s pos > UPB s THEN "" ELSE s[ s pos : ] FI + END # LTRIM # ; + OP INDENTOF = ( STRING s )INT: # returns count of leading spaces of s # + BEGIN + INT s pos := LWB s; + WHILE IF s pos > UPB s THEN FALSE ELSE s[ s pos ] = " " FI DO s pos +:= 1 OD; + s pos - LWB s + END # INDENTOF # ; + + # count the total number of columns in tree # + OP COUNTCOLUMNS = ( REF ONODE tree )INT: + IF child OF tree IS nil node + THEN 1 + ELSE INT count := 0; + REF ONODE next := child OF tree; + WHILE next ISNT nil node DO + count +:= COUNTCOLUMNS next; + next := next OF next + OD; + count + FI # COUNTCOLUMNS # ; + + OP TOONODE = ( []STRING s )REF ONODE: + IF HEAP ONODE result; + LWB s > UPB s + THEN result := ( "", 0, nil node, nil node ) + ELSE result := ( s[ LWB s ], INDENTOF s[ LWB s ], nil node, nil node ); + [ 1 : ( UPB s - LWB s ) + 1 ]REF ONODE tstack; + FOR i TO UPB tstack DO tstack[ i ] := nil node OD; + INT s pos := LWB tstack; + tstack[ s pos ] := result; + FOR pos FROM LWB s + 1 TO UPB s DO + INT indent = INDENTOF s[ pos ]; + WHILE indent < indent OF tstack[ s pos ] DO s pos -:= 1 OD; + HEAP ONODE next := ( s[ pos ], indent, nil node, nil node ); + IF indent > indent OF tstack[ s pos ] + THEN child OF tstack[ s pos ] := next; + tstack[ s pos +:= 1 ] := next + ELSE IF next OF tstack[ s pos ] IS nil node + THEN next OF tstack[ s pos ] := next + FI; + tstack[ s pos ] := next + FI + OD; + result + FI # TOONODE # ; + + PROC print tree table body = ( REF ONODE tree, STRING tr, rt, open td, close td, dt, empty td )VOID: + BEGIN + INT td max := 0; # find the maximum elements the rows # + REF ONODE next := tree; + WHILE next ISNT nil node DO + td max +:= COUNTCOLUMNS next; + next := next OF next + OD; + [ 1 : td max ]REF ONODE td; # get the elements of the first row # + td max := 0; + next := tree; + WHILE next ISNT nil node DO + td[ td max +:= 1 ] := next; + next := next OF next + OD; + BOOL more rows := TRUE; # generate the rows # + WHILE more rows DO + print( ( tr, newline ) ); # output the current row # + FOR td pos TO td max DO + REF ONODE element = td[ td pos ]; + IF element IS nil node + THEN print( ( empty td ) ) + ELSE INT span = COUNTCOLUMNS element; + print( ( open td ) ); + IF span > 1 THEN print( ( " colspan=""", whole( span, 0 ), """" ) ) FI; + print( ( close td, LTRIM text OF element ) ); + IF dt /= "" THEN print( ( "" ) ) FI; + print( ( newline ) ) + FI + OD; + IF rt /= "" THEN print( ( rt, newline ) ) FI; + []REF ONODE prev = td[ 1 : td max ]; # replace td with the # + INT new max := 0; # ... child elements of the current row # + more rows := FALSE; + FOR td pos TO td max DO + next := IF prev[ td pos ] IS nil node + THEN nil node + ELSE child OF prev[ td pos ] + FI; + td[ new max +:= 1 ] := next; + IF next ISNT nil node THEN + more rows := TRUE; + WHILE ( next := next OF next ) ISNT nil node DO + td[ new max +:= 1 ] := next + OD + FI + OD; + td max := new max + OD + END # print tree table body # ; + + # prints tree as an HTML table # + PROC print tree as html table = ( REF ONODE tree )VOID: + BEGIN + print( ( "

", newline ) ); + print tree table body( tree, "", "", "", "", "
" ); + print( ( "
", newline ) ) + END # print tree as html table # ; + + # prints tree as a wiki table b # + PROC print tree as wiki table = ( REF ONODE tree )VOID: + BEGIN + print( ( "{| class=""wikitable"" style=""text-align: center;""", newline ) ); + print tree table body( tree, "|-", "", "| ", " | ", "", "| |" + REPR 10 ); + print( ( "|}", newline ) ) + END # print tree as wiki table # ; + + BEGIN + REF ONODE ex tree + = TOONODE []STRING( "Display an outline as a nested table." + , " Parse the outline to a tree," + , " measuring the indent of each line," + , " translating the indentation to a nested structure," + , " and padding the tree to even depth." + , " (happens during the output in this version)" + , " count the leaves descending from each node," + , " defining the width of a leaf as 1," + , " and the width of a parent node as a sum." + , " (The sum of the widths of its children)" + , " and write out a table with 'colspan' values" + , " either as a wiki table," + , " or as HTML." + ); + print tree as html table( ex tree ); + print tree as wiki table( ex tree ) + END +END diff --git a/Task/Display-an-outline-as-a-nested-table/ALGOL-68/display-an-outline-as-a-nested-table-2.alg b/Task/Display-an-outline-as-a-nested-table/ALGOL-68/display-an-outline-as-a-nested-table-2.alg new file mode 100644 index 0000000000..6ff0caa928 --- /dev/null +++ b/Task/Display-an-outline-as-a-nested-table/ALGOL-68/display-an-outline-as-a-nested-table-2.alg @@ -0,0 +1,47 @@ + # make all columns of tree have the same number of rows # + # tree is modified and also returned as the result # + OP STANDARDISE = ( REF ONODE tree )REF ONODE: + BEGIN + INT td max := 0; # find the maximum elements the rows # + REF ONODE next := tree; + WHILE next ISNT nil node DO + td max +:= COUNTCOLUMNS next; + next := next OF next + OD; + [ 1 : td max ]REF ONODE td; # get the elements of the first row # + td max := 0; + next := tree; + WHILE next ISNT nil node DO + td[ td max +:= 1 ] := next; + next := next OF next + OD; + WHILE BOOL more rows := FALSE; # balance the tree # + FOR td pos TO td max DO + REF ONODE element = td[ td pos ]; + IF child OF element ISNT nil node + THEN more rows := TRUE + FI + OD; + more rows + DO FOR td pos TO td max DO # add "missing" child elements # + REF ONODE element = td[ td pos ]; + IF child OF element IS nil node + THEN HEAP ONODE new child := ( "", 0, nil node, nil node ); + child OF element := new child + FI + OD; + []REF ONODE prev = td[ 1 : td max ]; # replace td with the # + INT new max := 0; # ... child elements of the current row # + FOR td pos TO td max DO + next := child OF prev[ td pos ]; + td[ new max +:= 1 ] := next; + IF next ISNT nil node THEN + WHILE ( next := next OF next ) ISNT nil node DO + td[ new max +:= 1 ] := next + OD + FI + OD; + td max := new max + OD; + tree + END # STANDARDISE # ; diff --git a/Task/Distance-and-Bearing/FreeBASIC/distance-and-bearing.basic b/Task/Distance-and-Bearing/FreeBASIC/distance-and-bearing.basic new file mode 100644 index 0000000000..701127456b --- /dev/null +++ b/Task/Distance-and-Bearing/FreeBASIC/distance-and-bearing.basic @@ -0,0 +1,148 @@ +Type Airport + nombre As String + location As String + ICAO As String + dist As Double + bearing As Integer +End Type + +#define MAX_AIRPORTS 21 +#define PI 3.1415926535897932 + +Dim Shared db(MAX_AIRPORTS) As Airport +Dim Shared DME As Double, TOHDG As Double + +Function DegToRad(degrees As Double) As Double + Return degrees * PI / 180 +End Function + +Function RoundIt(theNum As Double, theDec As Integer) As Double + Return Fix(theNum * (10 ^ theDec) + 0.5) / (10 ^ theDec) +End Function + +Function DistanceGC(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Double + Dim As Double Dm, ER, dLat, dLon, a, c + + ER = 6371.0 'Earth's mean radius in km + dLat = DegToRad(lat2) - DegToRad(lat1) + dLon = DegToRad(lon2) - DegToRad(lon1) + a = Sin(dLat / 2) * Sin(dLat / 2) + Cos(DegToRad(lat1)) * Cos(DegToRad(lat2)) * Sin(dLon / 2) * Sin(dLon / 2) + c = 2 * Atan2(Sqr(a), Sqr(1 - a)) + Dm = ER * c / 1.852 + + Return Dm +End Function + +Function Bearing(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Double + Dim As Double lat1Rad = DegToRad(lat1) + Dim As Double lat2Rad = DegToRad(lat2) + Dim As Double dLon = DegToRad(lon2 - lon1) + Dim As Double y = Sin(dLon) * Cos(lat2Rad) + Dim As Double x = Cos(lat1Rad) * Sin(lat2Rad) - Sin(lat1Rad) * Cos(lat2Rad) * Cos(dLon) + + Return (Atan2(y, x) * 180/PI + 360) Mod 360 +End Function + +Sub Insert(ap As Airport) + Dim n As Integer = MAX_AIRPORTS - 1 + If ap.dist >= db(n).dist Then Exit Sub + While ap.dist < db(n).dist Andalso n > 0 + db(n + 1) = db(n) + n -= 1 + Wend + db(n + 1) = ap +End Sub + +Sub Test(lat2 As Double, lon2 As Double) + Static As Double lat1 = 51.514669, lon1 = 2.198581 'Rosetta coordinates + DME = DistanceGC(lat1, lon1, lat2, lon2) + DME = RoundIt(DME, 1) + TOHDG = Bearing(lat1, lon1, lat2, lon2) + TOHDG = RoundIt(TOHDG, 0) +End Sub + +Function IsValidNumber(s As String) As Integer + Return (Val(s) <> 0 Or s = "0") +End Function + +Function ReadAirportFile() As Integer + Dim As String linea, campo, c + Dim As Airport ap + Dim As Integer i, j, inQuotes + + Open "Airport-data.csv" For Input As #1 + If Err Then Print "Error opening file": Return 0 + + While Not Eof(1) + Line Input #1, linea + If Len(linea) = 0 Then Continue While + + Dim fields(15) As String + i = 0 + campo = "" + inQuotes = 0 + + For j = 1 To Len(linea) + c = Mid(linea, j, 1) + Select Case c + Case """" + inQuotes = Not inQuotes + Case "," + If Not inQuotes Then + If i < Ubound(fields) Then + fields(i) = campo + i += 1 + campo = "" + End If + Else + campo &= c + End If + Case Else + If c <> """" Then campo &= c + End Select + Next + + If i <= Ubound(fields) Then fields(i) = campo + + If i >= 7 Then + If IsValidNumber(fields(6)) And IsValidNumber(fields(7)) Then + 'Process the fields + Test(Val(fields(6)), Val(fields(7))) + ap.nombre = Trim(fields(1)) + ap.location = Trim(fields(2)) & ", " & Trim(fields(3)) + ap.ICAO = Trim(fields(5)) + ap.dist = DME + ap.bearing = TOHDG + Insert(ap) + End If + End If + Wend + + Close #1 + Return 1 +End Function + +'Main program +Dim i As Integer + +'Initialize distances +For i = 0 To MAX_AIRPORTS + db(i).dist = 99999 +Next + +If ReadAirportFile() Then + Print "AIRPORT/COUNTRY"; Tab(39); "ICAO"; Tab(46); "DISTANCE BEARING" + Print String(62, "-") + + For i = 1 To MAX_AIRPORTS - 1 + With db(i) + Print Left(.nombre & Space(38), 38) + Print Left(.location & Space(38), 38); + Print Left(.ICAO & Space(5), 5); Spc(6); + Print Using "##.# ###"; .dist; .bearing; + Print Chr(248); Chr(10) + End With + Next +End If + +Sleep diff --git a/Task/Diversity-prediction-theorem/PascalABC.NET/diversity-prediction-theorem.pas b/Task/Diversity-prediction-theorem/PascalABC.NET/diversity-prediction-theorem.pas index cc2c4a9fd3..972e2e8c39 100644 --- a/Task/Diversity-prediction-theorem/PascalABC.NET/diversity-prediction-theorem.pas +++ b/Task/Diversity-prediction-theorem/PascalABC.NET/diversity-prediction-theorem.pas @@ -10,5 +10,5 @@ begin WriteLn('diversity: ', AverageSquareDiff(average, predictions)); end; -DiversityTheorem(49.0, |48.0, 47.0, 51.0|); -DiversityTheorem(49.0, |48.0, 47.0, 51.0, 42.0|) +DiversityTheorem(49.0, [48.0, 47.0, 51.0]); +DiversityTheorem(49.0, [48.0, 47.0, 51.0, 42.0]) diff --git a/Task/Dominoes/Raku/dominoes.raku b/Task/Dominoes/Raku/dominoes.raku new file mode 100644 index 0000000000..09e6b0f0e7 --- /dev/null +++ b/Task/Dominoes/Raku/dominoes.raku @@ -0,0 +1,85 @@ +sub domino (Str $s) { $s.comb.sort.join } + +sub solve ( UInt $rows, UInt $cols, @tab ) { + die unless @tab.elems == $rows*$cols; + die unless @tab.elems %% 2; + + my @orientations = 'A' xx @tab.elems; # [A]vailable,[R]ight,[D]own,[L]eft,[U]p + + my SetHash $hand .= new: map &domino, [X~] @tab.unique xx 2; + + return gather { + my sub place_domino_at_first_available_after ( UInt $pos_last = 0 ) { + my $p1 = $pos_last + @orientations.skip($pos_last).first(:k, 'A'); + + for (False, $p1+1 , ), + (True , $p1+$cols, ) -> ($is_down, $p2, @two_letters) { + + next if $p2 > @tab.end or (!$is_down && $p2 %% $cols); # Board boundaries. + + my @two_cells := @orientations[$p1, $p2]; # Bind to candidate location + + next if @two_cells !eqv ; # Both cells must be available for placement. + + my $dom = domino( @tab[$p1, $p2].join ); + + $hand{$dom}-- or next; # Take domino from hand, iff present + @two_cells = @two_letters; # Assign placement + + # Either the solution is complete, or we must recurse. + if !$hand { take @orientations.clone } + else { place_domino_at_first_available_after($p1) } + + @two_cells = ; # Unassign placement + $hand{$dom}++; # Restore domino into hand + } + } + place_domino_at_first_available_after(); + } +} +sub bonus ( UInt $rows, UInt $cols ) { + die "Both are odd, so no tiling possible" if $rows !%% 2 and $cols !%% 2; + + my $half = $rows * $cols div 2; + + my sub T ($N) { map { ( pi * $_/($N+1) ).cos² * 4 }, 1..($N/2).ceiling } + + my $arrangements = [*] T($rows) X+ T($cols); + my $flips = 2 ** $half; + my $permutations = [*] 1 .. $half; + my $product = [*] ($arrangements, $flips, $permutations); + return :$arrangements, :$flips, :$permutations, :$product; +} +my @tests = + (7, 8, '05132231055052464303662006235126113002452143346664515414'), + (7, 8, '64220650162341432102355113505610426040114420536366525334'), + (3, 4, '001102221201'), +; +sub solution_works ( UInt $rows, UInt $cols, @tab, @sol --> Bool ) { + die unless @sol.all eq .any; + my BagHash $b .= new; + for @sol.keys -> $p1 { + given @sol[$p1] { + when 'L' { my $p2 = $p1+1; die unless @sol[$p2] eq 'R'; $b{ domino( @tab[$p1,$p2].join ) }++; } + when 'D' { my $p2 = $p1+$cols; die unless @sol[$p2] eq 'U'; $b{ domino( @tab[$p1,$p2].join ) }++; } + } + } + die unless $b.values.max == 1 and $b.elems == $rows * $cols / 2; + return True; +} +for @tests -> ( $rows, $cols, $flat_table ) { + my @solutions = solve($rows, $cols, $flat_table.comb); + say 'Solutions found: ', +@solutions; + + # Confirm that every solution is valid. + solution_works($rows, $cols, $flat_table.comb, $_) or die for @solutions; + + # Print first solution + say .join.trans( [] => [<╼ ╾ ╽ ╿>]) for @solutions[0].batch($cols); + + if ++$ == 1 { + say 'Bonus:'; + say .value.fmt("%45d "), .key.tclc for bonus($rows, $cols); + say ''; + } +} diff --git a/Task/Doomsday-rule/Draco/doomsday-rule.draco b/Task/Doomsday-rule/Draco/doomsday-rule.draco new file mode 100644 index 0000000000..73e8211a33 --- /dev/null +++ b/Task/Doomsday-rule/Draco/doomsday-rule.draco @@ -0,0 +1,50 @@ +type Date = struct { + word year; + byte month; + byte day; +}; + +proc leap_year(word y) bool: + y%4 = 0 and (y%100 /= 0 or y % 400 = 0) +corp + +proc weekday(Date date) *char: + [12]byte leapdoom = (4,1,7,4,2,6,4,1,5,3,7,5); + [12]byte normdoom = (3,7,7,4,2,6,4,1,5,3,7,5); + word c, r, s, t, c_anchor, doom, anchor; + + c := date.year / 100; + r := date.year % 100; + s := r / 12; + t := r % 12; + + c_anchor := (5 * (c % 4) + 2) % 7; + doom := (s + t + (t/4) + c_anchor) % 7; + anchor := if leap_year(date.year) + then leapdoom[date.month-1] + else normdoom[date.month-1] + fi; + + case (doom+date.day-anchor+7)%7 + incase 0: "Sunday" + incase 1: "Monday" + incase 2: "Tuesday" + incase 3: "Wednesday" + incase 4: "Thursday" + incase 5: "Friday" + incase 6: "Saturday" + esac +corp + +proc main() void: + [7]Date dates = ( + (1800,1,6), (1875,3,29), (1915,12,7), (1970,12,23), (2043,5,14), + (2077,2,12), (2101,4,2) + ); + + word d; + for d from 0 upto 6 do + writeln(dates[d].month:2, '/', dates[d].day:2, '/', dates[d].year:4, + ": ", weekday(dates[d])) + od +corp diff --git a/Task/Doomsday-rule/M2000-Interpreter/doomsday-rule.m2000 b/Task/Doomsday-rule/M2000-Interpreter/doomsday-rule.m2000 new file mode 100644 index 0000000000..bc2bab76ac --- /dev/null +++ b/Task/Doomsday-rule/M2000-Interpreter/doomsday-rule.m2000 @@ -0,0 +1,60 @@ +' MAKE USING("FORMAT STRING", PAR1, PAR2, ...PARN) +' WE USE READ V TO READ MORE PARAMETERS. +FUNCTION USING(A$) { + VARIANT V : LONG D, S, E, I=1: S$="" + WHILE I<=LEN(A$) + IF S THEN + IF MID$(A$,I,1)<>"#" THEN + IF MID$(A$,I,1)="." THEN D=I ELSE E=I + END IF + ELSE + IF MID$(A$,I,1)="#" THEN S=I + END IF + IF S AND E THEN + IF S>1 THEN S$+=LEFT$(A$, S-1) + A$=MID$(A$, E) + G() + S=0:E=0:D=0 + I=1 + END IF + I++ + END WHILE + IF S THEN + IF S>1 THEN S$+=LEFT$(A$, S-1):E=I-S+1: S=1 ELSE E=I + G() + =S$ + ELSE + =S$+A$ + END IF + SUB G() + IF ISNUM THEN + READ V + IF D>0 THEN + S$+=STR$(V, STRING$("#",E-D-1)+"0."+STRING$("0",D-S+1)) + ELSE + S$+=STR$(V, STRING$("0",E-S-1)+"0") + END IF + ELSE + V="" + READ V + S$+=LEFT$(V+STRING$(" ", E-S), E-S) + END IF + END SUB +} +05 FLUSH : GOSUB 110 +10 DIM D$(1 TO 7): FOR I=1 TO 7: READ D$(I): NEXT I +20 DIM D(1 TO 12, 0 TO 1): FOR I=0 TO 1: FOR J=1 TO 12: READ D(J, I): NEXT J : NEXT I +30 READ Y: IF Y=0 THEN BREAK ELSE READ M,D +40 PRINT USING("##/##/#### ", M, D, Y); +50 C=Y DIV 100: R=Y MOD 100 +60 S=R DIV 12: T=R MOD 12 +70 A=(5*BINARY.AND(C, 3)+2) MOD 7 +80 B=(S+T+(T DIV 4)+A) MOD 7 +90 PRINT D$((B+D-D(M,-(Y MOD 4=0 AND (Y MOD 100<>0 OR Y MOD 400=0)))+7) MOD 7+1) +100 GOTO 30 +110 DATA "Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday" +120 DATA 3,7,7,4,2,6,4,1,5,3,7,5 +130 DATA 4,1,7,4,2,6,4,1,5,3,7,5 +140 DATA 1800,1,6,1875,3,29,1915,12,7,1970,12,23 +150 DATA 2043,5,14,2077,2,12,2101,4,2,0 +160 RETURN diff --git a/Task/Doomsday-rule/Miranda/doomsday-rule.miranda b/Task/Doomsday-rule/Miranda/doomsday-rule.miranda new file mode 100644 index 0000000000..de3b570449 --- /dev/null +++ b/Task/Doomsday-rule/Miranda/doomsday-rule.miranda @@ -0,0 +1,29 @@ +main :: [sys_message] +main = [Stdout (lay [showdate d ++ ": " ++ weekday d | d<-tests])] + +date ::= Date (num,num,num) + +showdate :: date->[char] +showdate (Date (y,m,d)) = show m ++ "/" ++ show d ++ "/" ++ show y + +tests :: [date] +tests = map Date [ + (1800,1,6), (1875,3,29), (1915,12,7), (1970,12,23), (2043,5,14), + (2077,2,12), (2101,4,2)] + +weekday :: date->[char] +weekday (Date (year,month,day)) + = weekdays ! daynum + where weekdays = ["Sunday","Monday","Tuesday","Wednesday","Thursday", + "Friday","Saturday"] + doomtab = leapdoom, if leapyear + = normdoom, otherwise + leapdoom = [4,1,7,2,4,6,4,1,5,3,7,5] + normdoom = [3,7,7,4,2,6,4,1,5,3,7,5] + leapyear = year mod 4=0 & (year mod 100~=0 \/ year mod 400=0) + (c, r) = (year div 100, year mod 100) + (s, t) = (r div 12, r mod 12) + c_anchor = (5 * (c mod 4) + 2) mod 7 + doom = (s + t + t div 4 + c_anchor) mod 7 + anchor = doomtab ! (month - 1) + daynum = (doom + day - anchor + 7) mod 7 diff --git a/Task/Doomsday-rule/Quackery/doomsday-rule.quackery b/Task/Doomsday-rule/Quackery/doomsday-rule.quackery new file mode 100644 index 0000000000..5dfa5b0e1d --- /dev/null +++ b/Task/Doomsday-rule/Quackery/doomsday-rule.quackery @@ -0,0 +1,26 @@ + [ dup 400 mod 0 = iff [ drop true ] done + dup 100 mod 0 = iff [ drop false ] done + 4 mod 0 = ] is leap ( y --> b ) + + [ dup 4 mod 5 * + over 100 mod 4 * + + swap 400 mod 6 * + 2 + 7 mod ] is doomsday ( y --> n ) + + [ leap iff [ ' [ table 0 4 1 ] ] + else [ ' [ table 0 3 7 ] ] + ' [ 7 4 2 6 4 1 5 3 7 5 ] join do ] is close ( m y --> n ) + + [ dup doomsday unrot close - + 7 mod ] is weekday ( d m y --> n ) + + [ [ table $ "Sunday" $ "Monday" + $ "Tuesday" $ "Wednesday" $ "Thursday" + $ "Friday" $ "Saturday" ] do echo$ ] is echoday ( d --> ) + + ' [ [ 6 1 1800 ] + [ 29 3 1875 ] + [ 7 12 1915 ] + [ 23 12 1970 ] + [ 14 5 2043 ] + [ 12 2 2077 ] + [ 2 4 2101 ] ] + witheach [ unpack weekday echoday cr ] diff --git a/Task/Doomsday-rule/Refal/doomsday-rule.refal b/Task/Doomsday-rule/Refal/doomsday-rule.refal new file mode 100644 index 0000000000..611e530466 --- /dev/null +++ b/Task/Doomsday-rule/Refal/doomsday-rule.refal @@ -0,0 +1,43 @@ +$ENTRY Go { + , (1800 1 6) (1875 3 29) (1915 12 7) (1970 12 23) + (2043 5 14) (2077 2 12) (2101 4 2): e.Tests + = ; +}; + +Test { + e.Test = >; +}; + +LeapYear { + s.Year = > + > + >>>; +}; + +Weekday { + s.Year s.Month s.Day, + 4 1 7 4 2 6 4 1 5 3 7 5: e.LeapDoom, + 3 7 7 4 2 6 4 1 5 3 7 5: e.NormDoom, + Sunday Monday Tuesday Wednesday Thursday Friday Saturday: e.Days, + : (s.C) s.R, + : (s.S) s.T, + >> 7>: s.CAn, + >>> 7>: s.Doom, + (e.LeapDoom) (e.NormDoom)>: (e.DoomTab), + e.DoomTab>: e.Anchor, + e.Anchor>> 7>: s.Weekday + = ; +}; + +Item { + 0 s.X e.XS = s.X; + s.N s.X e.XS = e.XS>; +}; + +If { True t.T t.F = t.T; False t.T t.F = t.F; }; +Eq { t.X t.X = True; t.X t.Y = False; }; +Or { True s.Y = True; False s.Y = s.Y; }; +And { False s.Y = False; True s.Y = s.Y; }; +Not { True = False; False = True; }; +Neq { t.X t.Y = >; }; +Each { (e.F) = ; (e.F) (e.X) e.XS = ; }; diff --git a/Task/Doomsday-rule/SETL/doomsday-rule.setl b/Task/Doomsday-rule/SETL/doomsday-rule.setl new file mode 100644 index 0000000000..cf225f497f --- /dev/null +++ b/Task/Doomsday-rule/SETL/doomsday-rule.setl @@ -0,0 +1,29 @@ +program doomsday; + tests := [[1800,1,6], [1875,3,29], [1915,12,7], [1970,12,23], + [2043,5,14], [2077,2,12], [2101,4,2]]; + + loop for [year, month, day] in tests do + print(str day + "/" + str month + "/" + str year + ": " + + weekday(year, month, day)); + end loop; + + proc leap(y); + return y mod 4 = 0 and (y mod 100 /= 0 or y mod 400 = 0); + end proc; + + proc weekday(year, month, day); + leapdoom := [4,1,7,4,2,6,4,1,5,3,7,5]; + normdoom := [3,7,7,4,2,6,4,1,5,3,7,5]; + weekdays := ["Sunday","Monday","Tuesday","Wednesday","Thursday", + "Friday","Saturday"]; + + c := year div 100; + r := year mod 100; + s := r div 12; + t := r mod 12; + c_anchor := (5 * (c mod 4) + 2) mod 7; + doom := (s + t + (t div 4) + c_anchor) mod 7; + anchor := if leap(year) then leapdoom else normdoom end(month); + return weekdays((doom+day-anchor+7) mod 7+1); + end proc; +end program; diff --git a/Task/Doomsday-rule/UNIX-Shell/doomsday-rule.sh b/Task/Doomsday-rule/UNIX-Shell/doomsday-rule.sh index 10334c8be4..891530b914 100644 --- a/Task/Doomsday-rule/UNIX-Shell/doomsday-rule.sh +++ b/Task/Doomsday-rule/UNIX-Shell/doomsday-rule.sh @@ -5,14 +5,14 @@ day-of-the-week() then local -ra names=({Sun,Mon,Tues,Wednes,Thurs,Fri,Satur}day) doomsday=({37,41}7426415375) local -i i c s t a b - local -i {year,month,day}=${BASH_REMATCH[++i]} + local -i {y,m,d}=${BASH_REMATCH[++i]} echo ${names[ - c=year/100, - s=(year%100)/12, - t=(year % 100) % 12, + c=y/100, + s=(y%100)/12, + t=(y % 100) % 12, a=(5*(c%4)+2) % 7, b=(s + t + (t / 4) + a ) % 7, - (b + day - ${doomsday[(year%4 == 0) && ((year%100) || (year%400 == 0))]:month-1:1} + 7) % 7 + (b + d - ${doomsday[(y%4 == 0) && ((y%100) || (y%400 == 0))]:m-1:1} + 7) % 7 ]} else return 1 fi diff --git a/Task/Doomsday-rule/V-(Vlang)/doomsday-rule.v b/Task/Doomsday-rule/V-(Vlang)/doomsday-rule.v index bc6194f84e..002a8b84fc 100644 --- a/Task/Doomsday-rule/V-(Vlang)/doomsday-rule.v +++ b/Task/Doomsday-rule/V-(Vlang)/doomsday-rule.v @@ -1,5 +1,4 @@ -const -( +const ( days = ["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"] first_days_common = [3, 7, 7, 4, 2, 6, 4, 1, 5, 3, 7, 5] first_days_leap = [4, 1, 7, 4, 2, 6, 4, 1, 5, 3, 7, 5] @@ -24,15 +23,11 @@ fn main() { d = date[8..10].int() a = anchor_day(y) f = first_days_common[m] - if is_leap_year(y) { - f = first_days_leap[m] - } + if is_leap_year(y) {f = first_days_leap[m]} w = d - f - if w < 0 { - w = 7 + w - } + if w < 0 {w = 7 + w} dow = (a + w) % 7 - println('$date -> ${days[dow]}') + println("$date -> ${days[dow]}") } } diff --git a/Task/Dot-product/Zig/dot-product.zig b/Task/Dot-product/Zig/dot-product.zig index 82ecb11802..1118520c95 100644 --- a/Task/Dot-product/Zig/dot-product.zig +++ b/Task/Dot-product/Zig/dot-product.zig @@ -1,10 +1,9 @@ const std = @import("std"); -const Vector = std.meta.Vector; pub fn main() !void { - const a: Vector(3, i32) = [_]i32{1, 3, -5}; - const b: Vector(3, i32) = [_]i32{4, -2, -1}; - var dot: i32 = @reduce(.Add, a*b); + const a = @Vector(3, i32){ 1, 3, -5 }; + const b = @Vector(3, i32){ 4, -2, -1 }; + const dot: i32 = @reduce(.Add, a * b); try std.io.getStdOut().writer().print("{d}\n", .{dot}); } diff --git a/Task/Doubly-linked-list-Definition/FutureBasic/doubly-linked-list-definition.basic b/Task/Doubly-linked-list-Definition/FutureBasic/doubly-linked-list-definition.basic new file mode 100644 index 0000000000..32155d51d0 --- /dev/null +++ b/Task/Doubly-linked-list-Definition/FutureBasic/doubly-linked-list-definition.basic @@ -0,0 +1,67 @@ +begin globals + str255 List(8) //create a new list of strings (List(0) not used +end globals + + +local fn ShowList(title As str255) + //display all elements from list of string + short j + Print title; + For j = 1 to 7 + Print List(j); " "; + Next j + Print "" +End fn + + +/////////// MAIN PROGRAM //////////// + +Dim As str255 item //items to add to the list +Dim As short i,j, c = 0 + +//the list of data that will be added to the list +data: +Data "One", "Two", "Three", "Four", "Five", "Six", "EndOfData" + +Restore +c = 0 +Do + Read item + If item <> "EndOfData" Then List(c) = item + c ++ +Until item = "EndOfData" + +str255 ListTMP(7) + +For j = 1 To 7 + ListTMP(7-j) = List(j) +Next j +For j = 1 To 7 + Swap List(j), ListTMP(j) +Next j +fn ShowList("Insertion at Head: ") + +for i = 1 to 7 : List(i) = "" : next i // clear list +Restore +c = 0 +Do + Read item //: c += 1 + If item <> "EndOfData" Then List(c) = item + c ++ +Until item = "EndOfData" +fn ShowList("Insertion at Tail: ") + +for i = 1 to 7 : List(i) = "" : next i // clear list +Restore +c = 0 +Do + Read item //: c += 1 + If item <> "EndOfData" Then List(c) = item + c ++ +Until item = "EndOfData" + +Swap List(3), List(6) +fn ShowList("Insertion in Middle: ") + + +handleevents diff --git a/Task/Dragon-curve/ALGOL-68/dragon-curve-4.alg b/Task/Dragon-curve/ALGOL-68/dragon-curve-4.alg index 55d2235f9e..4d180563f7 100644 --- a/Task/Dragon-curve/ALGOL-68/dragon-curve-4.alg +++ b/Task/Dragon-curve/ALGOL-68/dragon-curve-4.alg @@ -53,7 +53,7 @@ BEGIN # Dragon Curve in SVG # put( svg file, ( "'/>", newline, "", newline ) ); close( svg file ) - FI # sierpinski square # ; + FI # dragon curve # ; dragon curve( "dragon.svg", 1200, 5, 12, 400, 200 ) diff --git a/Task/Dragon-curve/ASIC/dragon-curve.asic b/Task/Dragon-curve/ASIC/dragon-curve.asic new file mode 100644 index 0000000000..5697f69b99 --- /dev/null +++ b/Task/Dragon-curve/ASIC/dragon-curve.asic @@ -0,0 +1,130 @@ +REM Dragon curve +DIM S@(7) +DIM C@(7) +DIM R(27) +REM SIN, COS in arrays for PI/4 multipl. +DATA 0@, 0.70711@, 1@, 0.70711@, 0@, -0.70711@, -1@, -0.70711@ +DATA 1@, 0.70711@, 0@, -0.70711@, -1@, -0.70711@, 0@, 0.70711@ +Sqrt2@ = 1.41421@ +FOR I = 0 TO 7 + READ S@(I) +NEXT I +FOR I = 0 TO 7 + READ C@(I) +NEXT I +Level = 17 +Insize@ = 256 +REM Insize@ = 2^WHOLE_NUM looks fine +X@ = 224 +Y@ = 124 +RotQPi = 0 +RQ = 1 +SCREEN 9 +GOSUB Dragon: +LOCATE 20, 1 +PRINT "Press any key to exit." +Loop: + X$=INKEY$ + IF X$="" THEN Loop: +SCREEN 0 +END + +Dragon: +RotQPi = RotQPi MOD 8 +WHILE RotQPi < 0 + RotQPi = RotQPi + 8 +WEND +IF Level <= 1 THEN + YN@ = S@(RotQPi) * Insize@ + YN@ = YN@ + Y@ + XN@ = C@(RotQPi) * Insize@ + XN@ = XN@ + X@ + GOSUB DrawLine: + X@ = XN@ + Y@ = YN@ +ELSE + Insize@ = Insize@ * Sqrt2@ + Insize@ = Insize@ / 2@ + RotQPi = RotQPi + RQ + RotQPi = RotQPi MOD 8 + WHILE RotQPi < 0 + RotQPi = RotQPi + 8 + WEND + Level = Level - 1 + R(Level) = RQ + RQ = 1 + GOSUB Dragon: + RLevelM2 = R(Level) * 2 + RotQPi = RotQPi - RLevelM2 + RotQPi = RotQPi MOD 8 + WHILE RotQPi < 0 + RotQPi = RotQPi + 8 + WEND + RQ = -1 + GOSUB Dragon: + RQ = R(Level) + RotQPi = RotQPi + RQ + RotQPi = RotQPi MOD 8 + WHILE RotQPi < 0 + RotQPi = RotQPi + 8 + WEND + Level = Level + 1 + Insize@ = Insize@ * Sqrt2@ +ENDIF +RETURN + +DrawLine: +REM Draw a line from (X@, Y@) to (XN@, YN@) +REM Coordinates decimal, but converted in PSET. +DX@ = XN@ - X@ +DY@ = YN@ - Y@ +AbsDX@ = ABS(DX@) +AbsDY@ = ABS(DY@) +IF AbsDX@ <= AbsDY@ THEN + REM More vertical line + IF AbsDY@ <= 1@ THEN + REM The same pixel or neighboring ones, because AbsDX@ <= AbsDY@ <= 1. + PSET (Y@, X@), 10 + PSET (YN@, XN@), 10 + ELSE + REM There are pixels in between. + A@ = DX@ / DY@ + IF YN@ >= Y@ THEN + D@ = 1@ + ELSE + D@ = -1@ + ENDIF + CoordY@ = Y@ + WHILE CoordY@ <= YN@ + CoordX@ = CoordY@ - Y@ + CoordX@ = A@ * CoordX@ + CoordX@ = X@ + CoordX@ + PSET (CoordY@, CoordX@), 10 + CoordY@ = CoordY@ + D@ + WEND + ENDIF +ELSE + REM More horizontal line + IF AbsDX@ <= 1@ THEN + REM The same pixel or neighboring ones, because AbsDY@ < AbsDX@ <= 1. + PSET (Y@, X@), 10 + PSET (YN@, XN@), 10 + ELSE + REM There are pixels in between. + A@ = DY@ / DX@ + IF XN@ >= X@ THEN + D@ = 1@ + ELSE + D@ = -1@ + ENDIF + CoordX@ = X@ + WHILE CoordX@ <= XN@ + CoordY@ = CoordX@ - X@ + CoordY@ = A@ * CoordY@ + CoordY@ = Y@ + CoordY@ + PSET (CoordY@, CoordX@), 10 + CoordX@ = CoordX@ + D@ + WEND + ENDIF +ENDIF +RETURN diff --git a/Task/Dragon-curve/Applesoft-BASIC/dragon-curve.basic b/Task/Dragon-curve/Applesoft-BASIC/dragon-curve.basic new file mode 100644 index 0000000000..b9f8bff709 --- /dev/null +++ b/Task/Dragon-curve/Applesoft-BASIC/dragon-curve.basic @@ -0,0 +1,37 @@ +10 REM Dragon curve +20 DEF FN MOD(M) = M - INT(M / 8) * 8 +30 REM SIN, COS in arrays for PI/4 multipl. +40 DIM S(7), C(7) +50 QPI = ATN(1): SQ = SQR(2) +60 FOR I = 0 TO 7 +70 S(I) = SIN(I * QPI): C(I) = COS(I * QPI) +80 NEXT I +90 LEVEL = 15 +100 INSIZE = 128: REM 2^WHOLE_NUM (looks better) +110 X = 98: Y = 68 +120 ROTQPI = 0: RQ = 1 +130 DIM R(LEVEL) +140 HGR2: HCOLOR = 1 +150 GOSUB 170 +160 END +170 REM ** Dragon +180 ROTQPI = FN MOD8(ROTQPI) +190 IF LEVEL > 1 THEN GOTO 250 +200 YN = S(ROTQPI) * INSIZE + Y +210 XN = C(ROTQPI) * INSIZE + X +220 HPLOT X, Y TO XN, YN +230 X = XN: Y = YN +240 RETURN +250 INSIZE = INSIZE * SQ / 2 +260 ROTQPI = FN MOD8(ROTQPI + RQ) +270 LEVEL = LEVEL - 1 +280 R(LEVEL) = RQ: RQ = 1 +290 GOSUB 170 +300 ROTQPI = FN MOD8(ROTQPI - R(LEVEL) * 2) +310 RQ = -1 +320 GOSUB 170 +330 RQ = R(LEVEL) +340 ROTQPI = FN MOD8(ROTQPI + RQ) +350 LEVEL = LEVEL + 1 +360 INSIZE = INSIZE * SQ +370 RETURN diff --git a/Task/Dragon-curve/Nascom-BASIC/dragon-curve.basic b/Task/Dragon-curve/Nascom-BASIC/dragon-curve.basic new file mode 100644 index 0000000000..2f42679f86 --- /dev/null +++ b/Task/Dragon-curve/Nascom-BASIC/dragon-curve.basic @@ -0,0 +1,54 @@ +10 REM Dragon curve +20 REM SIN, COS in arrays for PI/4 multipl. +30 DIM S(7), C(7) +40 QPI=ATN(1):SQ=SQR(2) +50 FOR I=0 TO 7 +60 S(I)=SIN(I*QPI):C(I)=COS(I*QPI) +70 NEXT I +80 LEVEL=15 +90 INSIZE=32:REM 2^WHOLE_NUM (looks better) +100 X=34:Y=16 +110 ROTQPI=0:RQ=1 +120 DIM R(LEVEL) +130 CLS +140 GOSUB 160 +150 END +160 REM ** Dragon +170 ROTQPI=ROTQPI AND 7 +180 IF LEVEL>1 THEN GOTO 240 +190 YN=S(ROTQPI)*INSIZE+Y +200 XN=C(ROTQPI)*INSIZE+X +210 GOSUB 370 +220 X=XN:Y=YN +230 RETURN +240 INSIZE=INSIZE*SQ/2 +250 ROTQPI=(ROTQPI+RQ)AND 7 +260 LEVEL=LEVEL-1 +270 R(LEVEL)=RQ:RQ=1 +280 GOSUB 160 +290 ROTQPI=(ROTQPI-R(LEVEL)*2)AND 7 +300 RQ=-1 +310 GOSUB 160 +320 RQ=R(LEVEL) +330 ROTQPI=(ROTQPI+RQ)AND 7 +340 LEVEL=LEVEL+1 +350 INSIZE=INSIZE*SQ +360 RETURN +370 REM ** Draw a line from (X, Y) to (XN, YN) +380 IF ABS(XN-X)>1 OR ABS(YN-Y)>1 THEN 400 +390 SET(X,Y):SET(XN,YN):RETURN +400 IF ABS(XN-X)>ABS(YN-Y) THEN 480 +410 REM More vertical line +420 A=(XN-X)/(YN-Y) +430 IF YN>Y THEN D=1 ELSE D=-1 +440 FOR YC=Y TO YN STEP D +450 SET(X+A*(YC-Y),YC) +460 NEXT YC +470 RETURN +480 REM More horizontal line +490 A=(YN-Y)/(XN-X) +500 IF XN>X THEN D=1 ELSE D=-1 +510 FOR XC=X TO XN STEP D +520 SET(XC,Y+A*(XC-X)) +530 NEXT XC +540 RETURN diff --git a/Task/Draw-a-clock/Atari-BASIC/draw-a-clock.basic b/Task/Draw-a-clock/Atari-BASIC/draw-a-clock.basic new file mode 100644 index 0000000000..ef54e7f437 --- /dev/null +++ b/Task/Draw-a-clock/Atari-BASIC/draw-a-clock.basic @@ -0,0 +1,45 @@ +10 GRAPHICS 7:DEG +20 PRINT "Please enter current time (HH,MM):" +30 INPUT HH,MM:GRAPHICS 7+16 +40 FPS=60:REM SYSTEM CAN BE EITHER NTSC OR PAL +50 IF PEEK(53268)=1 THEN FPS=50 +60 MINUTE=60*FPS +70 XC=80:YC=40:R=35:RF=38 +80 GOSUB 800 +90 SETCOLOR 0,3,10:SETCOLOR 4,8,2:SETCOLOR 2,13,14 +100 POKE 19,0:POKE 20,0:SS=0:REM RESET FOR NEXT MINUTE +200 COLOR 0:IF SS>0 THEN 230 +210 PLOT XC,YC:DRAWTO HX,HY +220 PLOT XC,YC:DRAWTO MX,MY +230 PLOT XC,YC:DRAWTO SX,SY +240 GOSUB 500 +250 COLOR 2 +260 PLOT XC,YC:DRAWTO HX,HY +270 PLOT XC,YC:DRAWTO MX,MY +280 COLOR 1 +290 PLOT XC,YC:DRAWTO SX,SY +300 JIFFIES=256*PEEK(19)+PEEK(20) +310 NSEC=INT(JIFFIES/FPS):IF NSEC=60 THEN GOSUB 400:GOTO 100 +320 IF NSEC>SS THEN SS=NSEC:GOTO 2OO +330 GOTO 300 +400 REM INCREASE MINUTE AND HOUR +410 MM=MM+1 +420 IF MM=60 THEN MM=0:HH=HH+1 +430 IF HH=24 THEN HH=0 +440 REM DISABLE SCREEN SAVER/ATTRACT MODE +450 POKE 77,0 +460 RETURN +500 IF SS>0 THEN 550:REM CALCULATE X AND Y POSITIONS OF HANDS +510 HX=XC+R*SIN(30*HH+MM/2)*0.5 +520 HY=YC-R*COS(30*HH+MM/2)*0.5 +530 MX=XC+R*SIN(6*MM) +540 MY=YC-R*COS(6*MM) +550 SX=XC+R*SIN(6*SS) +560 SY=YC-R*COS(6*SS) +570 RETURN +800 REM DRAW CLOCK FACE +810 COLOR 3 +820 FOR I=30 TO 360 STEP 30 +830 PLOT XC+RF*SIN(I),YC-RF*COS(I) +840 NEXT I +850 RETURN diff --git a/Task/Draw-a-clock/EasyLang/draw-a-clock.easy b/Task/Draw-a-clock/EasyLang/draw-a-clock.easy index 7d2dc2ddee..6befc2a8d8 100644 --- a/Task/Draw-a-clock/EasyLang/draw-a-clock.easy +++ b/Task/Draw-a-clock/EasyLang/draw-a-clock.easy @@ -1,5 +1,4 @@ proc draw hour min sec . . - # dial color 333 move 50 50 circle 45 @@ -16,18 +15,15 @@ proc draw hour min sec . . move 50 + sin a * 40 50 + cos a * 40 circle 1 . - # hour linewidth 2 color 000 a = (hour * 60 + min) / 2 move 50 50 line 50 + sin a * 32 50 + cos a * 32 - # min linewidth 1.5 a = (sec + min * 60) / 10 move 50 50 line 50 + sin a * 40 50 + cos a * 40 - # sec linewidth 1 color 700 a = sec * 6 @@ -41,11 +37,9 @@ on timer sec = number substr h$ 18 2 min = number substr h$ 15 2 hour = number substr h$ 12 2 - if hour > 12 - hour -= 12 - . + if hour > 12 : hour -= 12 draw hour min sec . - timer 0.1 + timer 0.05 . timer 0 diff --git a/Task/Duffinian-numbers/Forth/duffinian-numbers.fth b/Task/Duffinian-numbers/Forth/duffinian-numbers.fth new file mode 100644 index 0000000000..264737eeb8 --- /dev/null +++ b/Task/Duffinian-numbers/Forth/duffinian-numbers.fth @@ -0,0 +1,61 @@ +: gcd ( u1 u2 -- u3 ) + dup 0= if drop exit then + tuck mod recurse ; + +: duffinian? ( u -- ? ) + dup 2 = if drop false exit then + 1 >r dup 2 + begin + over 2 mod 0= + while + dup r> + >r 2* swap 2/ swap + repeat + drop 3 + begin + 2dup dup * >= + while + dup 1 >r + begin + 2 pick 2 pick mod 0= + while + dup r> + >r over * >r tuck / swap r> + repeat + 2r> * >r drop 2 + + repeat + drop + 2dup = if 2drop rdrop false exit then + dup 1 > if 1+ r> * else drop r> then + gcd 1 = ; + +: main + ." First 50 Duffinian numbers:" cr + 0 1 + begin + over 50 < + while + dup duffinian? if + dup 3 .r + swap 1+ swap + over 10 mod 0= if cr else space then + then + 1+ + repeat + 2drop + cr ." First 30 Duffinian triplets:" cr + 0 >r 0 1 + begin + r@ 30 < + while + dup duffinian? if swap 1+ swap else nip 0 swap then + over 3 = if + r> 1+ >r + dup 2 - 5 .r space + dup 1- 5 .r space + dup 5 .r cr + then + 1+ + repeat + rdrop 2drop ; + +main +bye diff --git a/Task/Duffinian-numbers/Lua/duffinian-numbers.lua b/Task/Duffinian-numbers/Lua/duffinian-numbers.lua new file mode 100644 index 0000000000..a8422b4049 --- /dev/null +++ b/Task/Duffinian-numbers/Lua/duffinian-numbers.lua @@ -0,0 +1,58 @@ +function gcd(a, b) + while b ~= 0 do + a, b = b, a % b + end + return a +end + +function duffinian(n) + if n == 2 then return false end + local total = 1 + local power = 2 + local m = n + while (n & 1) == 0 do + total = total + power + power = power << 1 + n = n >> 1 + end + local p = 3 + while p * p <= n do + local sum = 1 + local power = p + while n % p == 0 do + sum = sum + power + power = power * p + n = n / p + end + total = total * sum + p = p + 2 + end + if m == n then return false end + if n > 1 then total = total * (n + 1) end + return gcd(total, m) == 1 +end + +print("First 50 Duffinian numbers:") +count = 0 +n = 1 +while count < 50 do + if duffinian(n) then + count = count + 1 + if count % 10 == 0 then space = 10 else space = 32 end + io.write(string.format('%3d%c', n, space)) + end + n = n + 1 +end + +print("\nFirst 30 Duffinian triplets:") +n = 1 +m = 0 +count = 0 +while count < 30 do + if duffinian(n) then m = m + 1 else m = 0 end + if m == 3 then + count = count + 1 + print(string.format('%d, %d, %d', n - 2, n - 1, n)) + end + n = n + 1 +end diff --git a/Task/Duffinian-numbers/Refal/duffinian-numbers.refal b/Task/Duffinian-numbers/Refal/duffinian-numbers.refal new file mode 100644 index 0000000000..576fa3f49d --- /dev/null +++ b/Task/Duffinian-numbers/Refal/duffinian-numbers.refal @@ -0,0 +1,76 @@ +$ENTRY Go { + = + >> + + + >; +}; + +ShowTriple { + s.N = >; +}; + +Each { + s.F = ; + s.F t.I e.X = ; +}; + +Group { + s.N = ; + s.N e.X, : (e.1) e.2 = (e.1) ; +}; + +Gen { + s.N s.F = ; + 0 s.F s.I = ; + s.N s.F s.I, : { + True = s.I s.F >; + False = >; + }; +}; + +DuffinianTriple { + s.N, + > + >: True True True = True; + s.N = False; +}; + +Duffinian { + s.N, : s.S, + : s.P, + s.S : { + s.P s.1 = False; + s.Q 1 = True; + s.1 s.2 = False; + }; +}; + +Gcd { + s.A 0 = s.A; + s.A s.B = >; +}; + +SigmaSum { + s.N = 2 >; + s.N s.Sum s.D s.Max, : '+' = s.Sum; + s.N s.Sum s.D s.Max, : s.N = ; + s.N s.Sum s.D s.Max, : 0 = + >> + s.Max>; + s.N s.Sum s.D s.Max = s.Max>; +}; + +Sqrt { + 0 = 1; + 1 = 1; + s.N = >; + s.N s.X0, +
> 2>: s.X1, + : { + '+' = ; + s.C = s.X0; + }; +}; diff --git a/Task/Duffinian-numbers/SETL/duffinian-numbers.setl b/Task/Duffinian-numbers/SETL/duffinian-numbers.setl new file mode 100644 index 0000000000..792e5adddc --- /dev/null +++ b/Task/Duffinian-numbers/SETL/duffinian-numbers.setl @@ -0,0 +1,48 @@ +program duffinian_numbers; + init sigma := divisor_sum_table(20000); + + print("First 50 Duffinian numbers:"); + loop for n in first(50, routine is_duffinian) do + nprint(lpad(str n, 6)); + if (col +:= 1) mod 10 = 0 then print; end if; + end loop; + + print; + print("First 15 Duffinian triplets:"); + loop for n in first(15, routine is_duffinian_triplet) do + print(+/[lpad(str i, 6) : i in [n,n+1,n+2]]); + end loop; + + proc first(num, pred); + ls := []; + loop while #ls < num do + loop until call(pred, n) do + n +:= 1; + end loop; + ls with:= n; + end loop; + return ls; + end proc; + + proc is_duffinian_triplet(n); + return and/[is_duffinian(i) : i in [n,n+1,n+2]]; + end proc; + + proc is_duffinian(n); + return sigma(n) > n+1 and gcd(n, sigma(n)) = 1; + end proc; + + proc gcd(a,b); + return if b=0 then a else gcd(b, a mod b) end; + end proc; + + proc divisor_sum_table(sz); + ds := [0] * sz; + loop for i in [1..sz] do + loop for j in [i,i+i..sz] do + ds(j) +:= i; + end loop; + end loop; + return ds; + end proc; +end program; diff --git a/Task/Dutch-national-flag-problem/FutureBasic/dutch-national-flag-problem.basic b/Task/Dutch-national-flag-problem/FutureBasic/dutch-national-flag-problem.basic index 59c514fbfe..f7c621a282 100644 --- a/Task/Dutch-national-flag-problem/FutureBasic/dutch-national-flag-problem.basic +++ b/Task/Dutch-national-flag-problem/FutureBasic/dutch-national-flag-problem.basic @@ -1,39 +1,39 @@ void local fn DrawBalls( y as long, balls as CFArrayRef, sort as BOOL ) -long col, prevCol = 0, x = 10 -CFArrayRef cols = @[fn ColorWithSRGB(.78,.06,.18,1.0),fn ColorWhite,fn ColorWithSRGB(0,.24,.65,1.0)] -if ( sort ) then balls = fn ArraySortedArrayUsingSelector( balls, @"compare:" ) + long col, prevCol = 0, x = 10 + CFArrayRef cols = @[fn ColorWithSRGB(.78,.06,.18,1.0),fn ColorWhite,fn ColorWithSRGB(0,.24,.65,1.0)] + if ( sort ) then balls = fn ArraySortedArrayUsingSelector( balls, @"compare:" ) -pen -1 -for long i = 0 to len(balls) - 1 -col = intval(balls[i]) -if ( sort == YES ) -if ( col != prevCol ) then y += 30 : x = 10 -else -if ( i > 0 && i % 15 == 0 ) then y += 30 : x = 10 -end if -oval fill (x,y,30,30), cols[col] -x += 30 -prevCol = col -next + pen -1 + for long i = 0 to len(balls) - 1 + col = intval(balls[i]) + if ( sort == YES ) + if ( col != prevCol ) then y += 30 : x = 10 + else + if ( i > 0 && i % 15 == 0 ) then y += 30 : x = 10 + end if + oval fill (x,y,30,30), cols[col] + x += 30 + prevCol = col + next end fn void local fn DutchNationalFlagProblem -window 1, @"Dutch national flag problem", (0,0,470,230) -WindowSetBackgroundColor( 1, fn ColorWithSRGB(1.0,.61,0,1.0) ) + window 1, @"Dutch national flag problem", (0,0,470,230) + WindowSetBackgroundColor( 1, fn ColorWithSRGB(1.0,.61,0,1.0) ) -CFMutableArrayRef balls = fn MutableArrayNew + CFMutableArrayRef balls = fn MutableArrayNew -text @"Menlo-Bold",, fn ColorWhite + text @"Menlo-Bold",, fn ColorWhite -for long i = 0 to 29 -balls[i] = @(rnd(3)-1) -next + for long i = 0 to 29 + balls[i] = @(rnd(3)-1) + next -print @"Unsorted:" -fn DrawBalls( 20, balls, NO ) + print @"Unsorted:" + fn DrawBalls( 20, balls, NO ) -print %(3,100)@"Sorted:" -fn DrawBalls( 120, balls, YES ) + print %(3,100)@"Sorted:" + fn DrawBalls( 120, balls, YES ) end fn random diff --git a/Task/Dutch-national-flag-problem/M2000-Interpreter/dutch-national-flag-problem-1.m2000 b/Task/Dutch-national-flag-problem/M2000-Interpreter/dutch-national-flag-problem-1.m2000 new file mode 100644 index 0000000000..12e0137b20 --- /dev/null +++ b/Task/Dutch-national-flag-problem/M2000-Interpreter/dutch-national-flag-problem-1.m2000 @@ -0,0 +1,23 @@ + SortElse=lambda white (a(), &swaps, &compares)->{ + long mid=white + long i, j, k=len(a())-1 + while j<=k + + if a(j)mid then + compares+=2 + swap a(j), a(k) + swaps++ + k-- + else + compares+=2 + j++ + end if + end while + =a() + } diff --git a/Task/Dutch-national-flag-problem/M2000-Interpreter/dutch-national-flag-problem-2.m2000 b/Task/Dutch-national-flag-problem/M2000-Interpreter/dutch-national-flag-problem-2.m2000 new file mode 100644 index 0000000000..acaf408117 --- /dev/null +++ b/Task/Dutch-national-flag-problem/M2000-Interpreter/dutch-national-flag-problem-2.m2000 @@ -0,0 +1,88 @@ +function Dutch_national_flag_problem { + enum bands {red=1, white, blue} + s=red + check_in_order=lambda s, (a as array) ->{ + boolean true=@true, false + k=each(a) + m=s + Z=S + =true + while k + z=array(k) + if m=z else + if m=blue then + =false + break + else + m++ + if m=z else =false : break + end if + end if + end while + } + SortElse=lambda (m(), &swaps, &compares)->{ + long t=len(m()) + dim c(1 to 3)=t + c=1 + for i=0 to len(m())-1 + rem ? "pos:";i;" "; + w=m(i) + if w0 + if c(k)=t then k-- : continue + if m(j)c(k) then c(m(j))=c(k) + rem ? "swap:";m(j);" at pos "+j;" with ";m(c(k)); " at pos ";c(k) + swap m(j), m(c(k)) + rem ? "just swapped array :", m()#str$() + rem ? "c()", c()#str$() + swaps++ + j=c(k) + c(k)++ + end if + k-- + rem ? "k=";k, c(k) + end while + else.if w>c then + c=w + if i-c(c)>1 else c(c)=i + end if + next + =m() + } + random_band=lambda->random(1, 3) + n=random(10, 20) + if n<3 then exit ' need at least 3 colors for the flag - although n now didn't get value 3 we place it to remember it later + do + do + dim balls(n)< { - if size<1 then size=1 - randomitem=lambda a->a#val(random(0,2)) - dim a(size)<{ - Document r$=eval$(array(s)) - if len(s)>1 then - For i=1 to len(s)-1 { - r$=", "+eval$(array(s,i)) - } - end if - =r$ -} -TestSort$=lambda$ (s as array)-> { - ="unsorted: " - x=array(s) - for i=1 to len(s)-1 { - k=array(s,i) - if x>k then break - swap x, k - } - ="sorted: " -} -Positions=lambda mid=White (a as array) ->{ - m=len(a) - dim Base 0, b(m)=-1 - low=-1 - high=m - m-- - i=0 - medpos=stack - link a to a() - for i=m to 0 { - if a(i)<=mid then exit - high-- - b(high)=high - } - for i=0 to m { - if a(i)>=mid then exit - low++ - b(low)=low - } - if high-low>1 then - for i=low+1 to high-1 { - select case a(i)<=>Mid - case -1 - low++ : b(low)=i - case 1 - { - high-- :b(high)=i - if High0 then - dim c() - c()=array(medpos) - stock c(0) keep len(c()), b(low+1) - for i=low+1 to high-1 - if b(i)>low and b(i)i then swap b(b(i)), b(i) - next i - end if - if low>0 then - for i=0 to low - if b(i)<=low and b(i)<>i then swap b(b(i)), b(i) - next - end if - if High=High and b(i)<>i then swap b(b(i)), b(i) - next - end if - =b() -} -InPlace=Lambda (&p(), &Final()) ->{ - def i=0, j=-1, k=-1, many=0 - for i=0 to len(p())-1 - if p(i)<>i then - j=i - z=final(j) - do - final(j)=final(p(j)) - k=j - j=p(j) - p(k)=k - many++ - until j=i - final(k)=z - end if - next - =many -} - - -Dim final(), p(), second(), p1() -Rem final()=(White,Red,Blue,White,Red, Red, Blue) -Rem final()=(white, blue, red, blue, white) - -final()=fillarray(30) -Print "Items: ";len(final()) -Report TestSort$(final())+Display$(final()) -\\ backup for final() for second example -second()=final() -p()=positions(final()) -\\ backup p() to p1() for second example -p1()=p() - - -Report Center, "InPlace" -rem Print p() ' show array items -many=InPlace(&p(), &final()) -rem print p() ' show array items -Report TestSort$(final())+Display$(final()) -print "changes: "; many - - -Report Center, "Using another array to make the changes" -final()=second() -\\ using a second array to place only the changes -item=each(p1()) -many=0 -While item { - if item^=array(item) else final(item^)=second(array(item)) : many++ -} -Report TestSort$(final())+Display$(final()) -print "changes: "; many -Module three_way_partition (A as array, mid as balls, &swaps) { - Def i, j, k - k=Len(A) - Link A to A() - While j < k - if A(j) < mid Then - Swap A(i), A(j) - swaps++ - i++ - j++ - Else.if A(j) > mid Then - k-- - Swap A(j), A(k) - swaps++ - Else - j++ - End if - End While -} -Many=0 -Z=second() -Print -Report center, {Three Way Partition -} -Report TestSort$(Z)+Display$(Z) -three_way_partition Z, White, &many -Print -Report TestSort$(Z)+Display$(Z) -Print "changes: "; many diff --git a/Task/Eban-numbers/FutureBasic/eban-numbers.basic b/Task/Eban-numbers/FutureBasic/eban-numbers.basic new file mode 100644 index 0000000000..e1246b9d9b --- /dev/null +++ b/Task/Eban-numbers/FutureBasic/eban-numbers.basic @@ -0,0 +1,50 @@ +void local fn Eban( start as NSUInteger, finish as NSUInteger, printable as BOOL ) + NSUInteger i, b, r, m, t, count + + if ( start = 2 ) + printf @"eban numbers up to and including %lu", finish + else + printf @"eban numbers between %lu and %lu:", start, finish + end if + + count = 0 + for i = start to finish step 2 + b = int(i / 100000000) + r = i % 100000000 + m = int(r / 1000000) + r = i % 1000000 + t = int(r / 1000) + r = r % 1000 + if m >= 30 && m <= 66 then m = (m % 10) + if t >= 30 && t <= 66 then t = (t % 10) + if r >= 30 && r <= 66 then r = (r % 10) + if b = 0 || b = 2 || b = 4 || b = 6 + if m = 0 || m = 2 || m = 4 || m = 6 + if t = 0 || t = 2 || t = 4 || t = 6 + if r = 0 || r = 2 || r = 4 || r = 6 + if printable == YES then printf @"%lu \b", i + count++ + end if + end if + end if + end if + next + if printable == YES then print + printf @"%lu eban numbers found\n", count +end fn + +void local fn EbanNumbers + CFTimeInterval t = fn CACurrentMediaTime + fn Eban( 2, 1000, YES ) + fn Eban( 1000, 4000, YES ) + fn Eban( 2, 10000, NO ) + fn Eban( 2, 100000, NO ) + fn Eban( 2, 1000000, NO ) + fn Eban( 2, 10000000, NO ) + fn Eban( 2, 100000000, NO ) + printf @"Compute time: %.3f sec\n", fn CACurrentMediaTime - t +end fn + +fn EbanNumbers + +HandleEvents diff --git a/Task/Eban-numbers/OxygenBasic/eban-numbers.basic b/Task/Eban-numbers/OxygenBasic/eban-numbers.basic new file mode 100644 index 0000000000..ba5f4082c8 --- /dev/null +++ b/Task/Eban-numbers/OxygenBasic/eban-numbers.basic @@ -0,0 +1,54 @@ +uses console + +! GetTickCount lib "kernel32.dll" +double t1, t2 + +sub eban (start as int, ended as int, printable as int) + int contar + long i, b, r, m, t + + contar = 0 + if start = 2 then + printl "eban numbers up to and including " ended ":" + else + printl "eban numbers between " start " and " ended " (inclusive):" + end if + + for i = start to ended step 2 + b = (i \ 1000000000) + r = mod(i, 1000000000) + m = (r \ 1000000) + r = mod(i, 1000000) + t = (r \ 1000) + r = mod(r, 1000) + if m >= 30 and m <= 66 then m = mod(m, 10) + if t >= 30 and t <= 66 then t = mod(t, 10) + if r >= 30 and r <= 66 then r = mod(r, 10) + if b = 0 or b = 2 or b = 4 or b = 6 then + if m = 0 or m = 2 or m = 4 or m = 6 then + if t = 0 or t = 2 or t = 4 or t = 6 then + if r = 0 or r = 2 or r = 4 or r = 6 then + if printable then print i " "; + contar += 1 + end if + end if + end if + end if + next i + if printable then print cr + printl "count = " contar cr +end sub + +t1 = GetTickCount +call eban (2, 1000, 1) +call eban (1000, 4000, 1) +call eban (2, 10000, 0) +call eban (2, 100000, 0) +call eban (2, 1000000, 0) +call eban (2, 10000000, 0) +call eban (2, 100000000, 0) +t2 = GetTickCount +printl "Run time: " (t2-t1)/1000 " seconds." + +printl cr "Enter ..." +waitkey diff --git a/Task/Echo-server/FutureBasic/echo-server.basic b/Task/Echo-server/FutureBasic/echo-server.basic new file mode 100644 index 0000000000..f0a415f3d2 --- /dev/null +++ b/Task/Echo-server/FutureBasic/echo-server.basic @@ -0,0 +1,16 @@ +// Echo Server +// https://rosettacode.org/wiki/Echo_server# + +#plist NSAppleEventsUsageDescription @"Access to Apple Events is needed for this task." + +str255 theMessage +theMessage = "tell application " + CHR$(34) + "Terminal" + CHR$(34) + CHR$(10) + "activate" + CHR$(10)¬ ++ "do script " + CHR$(34) + "ssh ::1" + CHR$(34) + CHR$(10) + "end tell" + CHR$(10) + +AppleScriptRef script +script = fn AppleScriptWithSource( fn stringwithpascalstring (theMessage) ) +fn AppleScriptExecute( script, null ) + +// Sends ssh ::1 as a terminal command to open a connection to the local host +// You need to enable Sharing - Remote Login in System Settings for a succesful login. +// Otherwise you will get a Connection Refused message from the terminal. diff --git a/Task/Egyptian-division/FutureBasic/egyptian-division.basic b/Task/Egyptian-division/FutureBasic/egyptian-division.basic new file mode 100644 index 0000000000..44246587ac --- /dev/null +++ b/Task/Egyptian-division/FutureBasic/egyptian-division.basic @@ -0,0 +1,32 @@ +void local fn EgyptianDivision + int table(32, 2) + int i = 1, dividend = 580, divisor = 34 + int answer, accumulator + + table(i, 1) = 1 + table(i, 2) = divisor + + while ( table( i, 2 ) < dividend ) + i++ + table(i, 1) = table(i - 1, 1) * 2 + table(i, 2) = table(i - 1, 2) * 2 + wend + i-- + answer = table(i, 1) + accumulator = table(i, 2) + + while ( i > 1 ) + i-- + if table(i, 2) + accumulator <= dividend + answer += table(i, 1) + accumulator += table(i, 2) + end if + wend + + printf @"Using Egyptian Division %d / %d = %d remainder %d", dividend, divisor, answer, dividend - accumulator +end fn + + +fn EgyptianDivision + +HandleEvents diff --git a/Task/Egyptian-division/M2000-Interpreter/egyptian-division.m2000 b/Task/Egyptian-division/M2000-Interpreter/egyptian-division.m2000 new file mode 100644 index 0000000000..608f59ab55 --- /dev/null +++ b/Task/Egyptian-division/M2000-Interpreter/egyptian-division.m2000 @@ -0,0 +1,32 @@ +MODULE LIKEBASIC { + 100 REM Egyptian division + 110 DIM Table(0 TO 31, 0 TO 1) + 120 LET Dividend = 580 + 130 LET Divisor = 34 + 140 REM ** Division + 150 LET I = 0 + 160 LET Table(I, 0) = 1 + 170 LET Table(I, 1) = Divisor + 180 WHILE Table(I, 1) < Dividend + 190 LET I = I + 1 + 200 LET Table(I, 0) = Table(I - 1, 0) * 2 + 210 LET Table(I, 1) = Table(I - 1, 1) * 2 + 220 END WHILE + 230 LET I = I - 1 + 240 LET Answer = Table(I, 0) + 250 LET Accumulator = Table(I, 1) + 260 WHILE I > 0 + 270 LET I = I - 1 + 280 IF Table(I, 1) + Accumulator <= Dividend THEN + 290 LET Answer = Answer + Table(I, 0) + 300 LET Accumulator = Accumulator + Table(I, 1) + 310 END IF + 320 END WHILE + 330 REM ** Results + 340 PRINT Dividend; " divided by "; Divisor; " using Egytian division"; + 350 PRINT " returns "; Answer; " remainder "; Dividend - Accumulator + 360 END +} +' Change DO WHILE ...LOOP -> WHILE ...END WHILE +' Adding some space for string literals +LIKEBASIC diff --git a/Task/Elementary-cellular-automaton-Random-number-generator/ALGOL-68/elementary-cellular-automaton-random-number-generator.alg b/Task/Elementary-cellular-automaton-Random-number-generator/ALGOL-68/elementary-cellular-automaton-random-number-generator.alg new file mode 100644 index 0000000000..a495116d55 --- /dev/null +++ b/Task/Elementary-cellular-automaton-Random-number-generator/ALGOL-68/elementary-cellular-automaton-random-number-generator.alg @@ -0,0 +1,48 @@ +BEGIN # elementary cellular automaton - random number generation # + COMMENT returns the next state from state using rule s must be at least 2 characters long + and consist of # and - only + COMMENT + PROC next state = ( STRING state, INT rule )STRING: + BEGIN + COMMENT returns 1 or 0 depending on whether c = # or not COMMENT + OP TOINT = ( CHAR c )INT: IF c = "#" THEN 1 ELSE 0 FI; + # construct the state with additional extra elements to allow wrap-around # + STRING s = state[ UPB state ] + state + state[ LWB state : LWB state + 1 ]; + COMMENT convert rule to a string of # or - depending on whether the bits of r are on or off + COMMENT + STRING r := ""; + INT v := rule; + TO 8 DO + r +:= IF ODD v THEN "#" ELSE "-" FI; + v OVERAB 2 + OD; + STRING new state := ""; + FOR i FROM LWB s TO UPB s - 3 DO + CHAR c1 = s[ i ]; + CHAR c2 = s[ i + 1 ]; + CHAR c3 = s[ i + 2 ]; + INT pos := ( ( ( TOINT c1 * 2 ) + TOINT c2 ) * 2 ) + TOINT c3; + new state +:= r[ pos + 1 ] + OD; + new state + END # next state # ; + # get a pseudo-random byte from by evolving the state # + PROC get byte = ( REF STRING state, INT rule, element )INT: + BEGIN + BITS b := 16r0; + TO 8 DO + state := next state( state, rule ); + b := b SHL 1; + IF state[ element ] = "#" THEN b := b OR 16r1 FI + OD; + ABS b + END # get byte # ; + + BEGIN # test # + STRING rg state := "###############################################################-"; + TO 10 DO + print( ( " ", whole( get byte( rg state, 30, 1 ), 0 ) ) ) + OD; + print( ( newline ) ) + END +END diff --git a/Task/Empty-string/EMal/empty-string.emal b/Task/Empty-string/EMal/empty-string.emal index 4dd34da9b1..d6165ca73b 100644 --- a/Task/Empty-string/EMal/empty-string.emal +++ b/Task/Empty-string/EMal/empty-string.emal @@ -1,9 +1,9 @@ # Demonstrate how to assign an empty string to a variable. -text sampleA = Text.EMPTY -text sampleB = "hello world" -text sampleC = "" -List samples = text[sampleA, sampleB, sampleC] +text sampleA ← Text.EMPTY +text sampleB ← "hello world" +text sampleC ← "" +List samples ← text[sampleA, sampleB, sampleC] for each text sample in samples # Demonstrate how to check that a string is empty. - writeLine("Is '" + sample + "' empty? " + when(sample.isEmpty(), "Yes", "No") + ".") + writeLine("Is '", sample, "' empty? ", when(sample.isEmpty(), "Yes", "No"), ".") end diff --git a/Task/Entropy/FutureBasic/entropy.basic b/Task/Entropy/FutureBasic/entropy.basic new file mode 100644 index 0000000000..9ef9433d59 --- /dev/null +++ b/Task/Entropy/FutureBasic/entropy.basic @@ -0,0 +1,34 @@ +include "NSLog.incl" + +double local fn Entropy( array as CFArrayRef ) + CFMutableDictionaryRef count = fn MutableDictionaryNew + + for CFStringRef element in array + if ( count[element] ) + count[element] = @(fn NumberIntegerValue( count[element] ) + 1) + else + count[element] = @(1) + end if + next + + double entropy = 0.0 + NSUInteger total = fn ArrayCount( array ) + CFArrayRef valuesArr = fn DictionaryAllValues( count ) + + for CFNumberRef value in valuesArr + double p = fn NumberDoubleValue( value ) / total + entropy -= p * log(p) + next + return entropy / log(2) +end fn = 0.0 + +void local fn DoIt + CFStringRef string = @"1,2,2,3,3,3,4,4,4,4" + CFArrayRef characters = fn StringComponentsSeparatedByString( string, @"," ) + double result = fn Entropy( characters ) + NSLog( @"Entrophy of \"%@\": %.15f", fn StringByReplacingOccurrencesOfString( string, @",", @"" ), result ) +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Enumerations/Crystal/enumerations.cr b/Task/Enumerations/Crystal/enumerations.cr new file mode 100644 index 0000000000..7774d59b5e --- /dev/null +++ b/Task/Enumerations/Crystal/enumerations.cr @@ -0,0 +1,78 @@ +# An enum is a set of integer values, where each value has an associated name. +# For example: + +enum Color + Red # 0 + Green # 1 + Blue # 2 +end + +# Values start with the value 0 and are incremented by one, +# but can be overwritten. + +# To get the underlying value you invoke value on it: + +Color::Green.value # => 1 + +# Each constant (member) in the enum has the type of the enum: + +typeof(Color::Red) # => Color + +# An enum can be marked with the @[Flags] annotation. +# This changes the default values: + +@[Flags] +enum IOMode + Read # 1 + Write # 2 + Async # 4 +end + +# Additionally, some methods change their behaviour. + +# An enum can be created from an integer: + +Color.new(1).to_s # => "Green" + +# Values that don't correspond to enum's constants are allowed: +# the value will still be of type Color, but when printed you will get +# the underlying value: + +Color.new(10).to_s # => "10" + +# This method is mainly intended to convert integers from C to enums in Crystal. + +# An enum automatically defines question methods for each member, +# using String#underscore for the method name. +# * In the case of regular enums, this compares by equality (#==). +# * In the case of flags enums, this invokes #includes?. +# For example: + +color = Color::Blue +color.red? # => false +color.blue? # => true + +mode = IOMode::Read | IOMode::Async +mode.read? # => true +mode.write? # => false +mode.async? # => true + +# This is very convenient in case expressions: + +case color +when .red? + puts "Got red" +when .blue? + puts "Got blue" +end + +# The type of the underlying enum value is Int32 by default, +# but it can be changed to any type in Int::Primitive. + +enum Color : UInt8 + Red + Green + Blue +end + +Color::Red.value # : UInt8 diff --git a/Task/Enumerations/EMal/enumerations.emal b/Task/Enumerations/EMal/enumerations.emal index 60c6220bd6..5ceb8bdebe 100644 --- a/Task/Enumerations/EMal/enumerations.emal +++ b/Task/Enumerations/EMal/enumerations.emal @@ -5,13 +5,13 @@ enum end type ExplicitFruits enum - int APPLE = 10 - int BANANA = 20 - int CHERRY = 1 + int APPLE ← 10 + int BANANA ← 20 + int CHERRY ← 1 end type Main for each generic enumeration in generic[Fruits, ExplicitFruits] - writeLine("[" + Generic.name(enumeration) + "]") + writeLine("[", Generic.name(enumeration), "]") writeLine("getting an object with value = 1:") writeLine(:enumeration.byValue(1)) writeLine("iterating over the items:") diff --git a/Task/Enumerations/M2000-Interpreter/enumerations.m2000 b/Task/Enumerations/M2000-Interpreter/enumerations.m2000 index 7d9cc5e6e1..3d20ecd98d 100644 --- a/Task/Enumerations/M2000-Interpreter/enumerations.m2000 +++ b/Task/Enumerations/M2000-Interpreter/enumerations.m2000 @@ -1,7 +1,29 @@ Module Checkit { - \\ need revision 15, version 9.4 - Enum Fruit {apple, banana, cherry} - Enum Fruit2 {apple2=10, banana2=20, cherry2=30} + Enum Fruit { + apple, banana, cherry + } + Enum Fruit2 { + apple2=10, + banana2=20.5, + cherry2=30 + } + Enum StrType { + alfa="Άλφα", + beta="Βήτα", + gamma="Γάμμα", + delta="Δέλτα" + } + Print alfa, beta + z=alfa + z++ + Print z=beta, eval$(z)="beta", z="Βήτα" + z="Γάμμα" ' change to 3rd by searching value from the list + CheckByReference2(&z) + z1=Each(StrType, -1, 1) ' from last to first + while z1 + CheckByValue2(z1) + end while + Print apple, banana, cherry Print apple2, banana2, cherry2 Print Len(apple)=0 @@ -47,10 +69,16 @@ Module Checkit { Sub CheckByValue(z as Fruit2) Print Eval$(z), z End Sub - + Sub CheckByValue2(z as StrType) + Print Eval$(z), z + End Sub Sub CheckByReference(&z as Fruit2) z++ Print Eval$(z), z End Sub + Sub CheckByReference2(&z as StrType) + z++ + Print Eval$(z), z + End Sub } Checkit diff --git a/Task/Environment-variables/EMal/environment-variables.emal b/Task/Environment-variables/EMal/environment-variables.emal index 1052e86a8f..c7cd2af565 100644 --- a/Task/Environment-variables/EMal/environment-variables.emal +++ b/Task/Environment-variables/EMal/environment-variables.emal @@ -1,6 +1,6 @@ -fun showVariable = n: + break + while n % p == 0: + factors.append(p) + n = n // p + if n > 1 and n in primes_set: + factors.append(n) + return factors + + +def compute_categories(primes): + primes_set = set(primes) + category = {p: 0 for p in primes} + for p in primes: + m = p + 1 + factors = factor(m, primes, primes_set) + if all(f in {2, 3} for f in factors): + category[p] = 1 + else: + max_cat = 0 + for q in factors: + q_cat = category.get(q, 0) + if q_cat > max_cat: + max_cat = q_cat + category[p] = max_cat + 1 + return category + + +def print_first_200(primes, category): + print("First 200 primes sorted by category:") + print("-" * 34) + + # Create list of (category, prime, original_position) + sorted_primes = sorted( + [(category[p], p, i + 1) for i, p in enumerate(primes[:200])], + key=lambda x: (x[0], x[1]) + ) + # Group by category for better visualization + current_category = None + for cat, p, orig_pos in sorted_primes: + if cat != current_category: + print(f"\nCategory {cat}:") + current_category = cat + print(f"{p}", end=" ") + + +def process_million_primes(): + n = 10 ** 6 + primes = generate_primes_sieve(n) + primes = primes[:n] + category = compute_categories(primes) + + stats = defaultdict(lambda: {'count': 0, 'min': None, 'max': None}) + for p in primes: + cat = category[p] + stats[cat]['count'] += 1 + if stats[cat]['min'] is None or p < stats[cat]['min']: + stats[cat]['min'] = p + if stats[cat]['max'] is None or p > stats[cat]['max']: + stats[cat]['max'] = p + + print("\n\nCategory statistics for first 1,000,000 primes:") + print(f"{'Category':<8} {'Count':>12} {'Smallest':>12} {'Largest':>12}") + print("-" * 48) + for cat in sorted(stats.keys()): + s = stats[cat] + print(f"{cat:<8} {s['count']:>12,} {s['min']:>12,} {s['max']:>12,}") + + +# First part: Display first 200 primes sorted by category +primes_200 = generate_primes_sieve(200) +primes_200 = primes_200[:200] +category_200 = compute_categories(primes_200) +print_first_200(primes_200, category_200) + +# Second part: Process first million primes and display statistics +process_million_primes() diff --git a/Task/Ethiopian-multiplication/EMal/ethiopian-multiplication.emal b/Task/Ethiopian-multiplication/EMal/ethiopian-multiplication.emal index 4f8456efb4..1247805063 100644 --- a/Task/Ethiopian-multiplication/EMal/ethiopian-multiplication.emal +++ b/Task/Ethiopian-multiplication/EMal/ethiopian-multiplication.emal @@ -1,13 +1,14 @@ -fun halve = int by int value do return value / 2 end -fun double = int by int value do return value * 2 end -fun isEven = logic by int value do return value % 2 == 0 end -fun ethiopian = int by int multiplicand, int multiplier +fun halve ← = 1 - if not isEven(multiplicand) do product += multiplier end - multiplicand = halve(multiplicand) - multiplier = double(multiplier) + while multiplicand ≥ 1 + if not isEven(multiplicand) do product +← multiplier end + multiplicand ← halve(multiplicand) + multiplier ← double(multiplier) end return product end -writeLine(ethiopian(17, 34)) +writeLine(17, " x ", 34, " = ", ethiopian(17, 34)) +writeLine(99, " x ", 99, " = ", ethiopian(99, 99)) diff --git a/Task/Ethiopian-multiplication/M2000-Interpreter/ethiopian-multiplication.m2000 b/Task/Ethiopian-multiplication/M2000-Interpreter/ethiopian-multiplication.m2000 index 7b36107578..23beab8bf1 100644 --- a/Task/Ethiopian-multiplication/M2000-Interpreter/ethiopian-multiplication.m2000 +++ b/Task/Ethiopian-multiplication/M2000-Interpreter/ethiopian-multiplication.m2000 @@ -1,33 +1,23 @@ -Module EthiopianMultiplication{ - Form 60, 25 - Const Center=2, ColumnWith=12 - Report Center,"Ethiopian Method of Multiplication" - // using decimals as unsigned integers - Def Decimal leftval, rightval, sum - (leftval, rightval)=(random(1, 65535), random(1, 65536)) - Print $( , ColumnWith), "Target:", leftval*rightval, - Hex leftval*rightval - sum=0 - if @IsEven(leftval) Else sum+=rightval - Print leftval, rightval, - Hex leftval, rightval - while leftval>1 - leftval=@halveInt(leftval) - rightval=@DoubleInt(rightval) - Print leftval, rightval, - Hex leftval, rightval - if @IsEven(leftval) Else sum+=rightval - End while - Print "", sum - Hex "", sum - Function HalveInt(i) - =Binary.Shift(i,-1) - End Function - Function DoubleInt(i) - =Binary.Shift(i,1) - End Function - Function IsEven(i) - =Binary.And(i, 1)=0 - End Function +Function ethiopian(mr as long long, md as long long) { + def even()=number mod 2&& + def div2()=number div 2&& + def mul2()=number * 2&& + result=0&& + while mr>=1 + if even(mr) then result+=md + mr=div2(mr) + md=mul2(md) + end while + =result } -EthiopianMultiplication +Print ethiopian(17, 34)=578 +Function ethiopian(mr as long long, md as long long) { + result=0&& + while mr>=1 + if mr mod 2 then result+=md + mr|div 2& + md*=2& + end while + =result +} +Print ethiopian(17, 34)=578 diff --git a/Task/Eulers-identity/M2000-Interpreter/eulers-identity.m2000 b/Task/Eulers-identity/M2000-Interpreter/eulers-identity.m2000 new file mode 100644 index 0000000000..ba35d26c68 --- /dev/null +++ b/Task/Eulers-identity/M2000-Interpreter/eulers-identity.m2000 @@ -0,0 +1,105 @@ +Class Complex { +private: + double vr, vi + final pidivby180=pi/180 + final e=2.71828182845905 +public: + property real { + value {link parent vr to vr : value=vr} + } + property imaginary { + value {link parent vi to vi : value=vi} + } + property toString { + value { clear 'so a new clear as string created after + link parent vr, vi to vr, vi + if vi then + if vr then + if vi>0 then + value="("+vr+"+"+vi+"i)" + else + value="("+vr+""+vi+"i)" + end if + else + value="("+vi+"i)" + end if + else + value="("+vr+")" + end if + } + } + function exp { + double exp = .e^.vr + c=this + c.vr<=exp * cos(.vi/.pidivby180) + c.vi<=exp * sin(.vi/.pidivby180) + =c + } + function conj { + c=this : c.vi-! : =c + } + function absc { + c=this*.conj() : =sqrt(c.vr) + } + operator "+" { + read k as Complex : .vr+= k.vr : .vi+= k.vi + } + operator "-" { + read k as Complex : .vr-= k.vr : .vi-= k.vi + } + operator "*" { + read k as Complex + double ivr = .vr*k.vr-.vi*k.vi + .vi <= .vi*k.vr+.vr*k.vi + .vr <= ivr + } + operator "/" { + read k as Complex + k1=k*k.conj() + acb = this*k.conj() + .vr <= acb.vr/k1.vr + .vi <= acb.vi/k1.vr + } +class: + module Complex (.vr, .vi) {} +} +module Check (filename$="") { + const MAXITER=12& + long i, k = 2 + pii=Complex(0, pi) + pii2 = pii*pii + B0 = Complex(2) + A0 = Complex(2) + B1 = Complex(2) - pii + A1 = B0*B1 + Complex(2)*pii + open filename$ for output as #f + printc(A0/B0) + print #f, " Absolute error = ";@absc(A0/B0) + printc(A1/B1) + print #f, " Absolute error = ";@absc(A1/B1) + for i = 1 to MAXITER + k += 4 + A2 = Complex(k)*A1 + pii2*A0 + B2 = Complex(k)*B1 + pii2*B0 + try ok {curr = A2/B2} + if not ok then exit for + A0 = A1 + A1 = A2 + B0 = B1 + B1 = B2 + printc(curr) + print #f, " Absolute error = "; curr.absc() + next i + r=pii.exp()+Complex(1) + Print #f, "e^(πi)+1 = ";r.toString + close#f + if f<>-2 and exist(dir$+filename$) then win "notepad", dir$+filename$ + end + sub printc(c as Complex) + Print #f, c.toString + end sub + function absc(c as complex) + =c.absc() + end function +} +Check ' use Check "out.txt" diff --git a/Task/Evaluate-binomial-coefficients/PascalABC.NET/evaluate-binomial-coefficients.pas b/Task/Evaluate-binomial-coefficients/PascalABC.NET/evaluate-binomial-coefficients.pas index 2abbe607cb..e211b2dd47 100644 --- a/Task/Evaluate-binomial-coefficients/PascalABC.NET/evaluate-binomial-coefficients.pas +++ b/Task/Evaluate-binomial-coefficients/PascalABC.NET/evaluate-binomial-coefficients.pas @@ -3,7 +3,7 @@ function binomial(n, k: integer): biginteger; begin result := 1bi; for var i := 1 to k do - result *= (n - i + 1) div i; + result = result * (n - i + 1) div i; end; Println(binomial(5, 3)) diff --git a/Task/Evaluate-binomial-coefficients/Quackery/evaluate-binomial-coefficients.quackery b/Task/Evaluate-binomial-coefficients/Quackery/evaluate-binomial-coefficients.quackery index 84ddfed0ec..067fbe1414 100644 --- a/Task/Evaluate-binomial-coefficients/Quackery/evaluate-binomial-coefficients.quackery +++ b/Task/Evaluate-binomial-coefficients/Quackery/evaluate-binomial-coefficients.quackery @@ -2,6 +2,6 @@ 1 swap times [ over i + 1+ * ] nip swap times - [ i 1+ / ] ] is binomial ( n n --> ) + [ i 1+ / ] ] is binomial ( n n --> n ) 5 3 binomial echo diff --git a/Task/Even-or-odd/ALGOL-60/even-or-odd.alg b/Task/Even-or-odd/ALGOL-60/even-or-odd.alg new file mode 100644 index 0000000000..314105fd32 --- /dev/null +++ b/Task/Even-or-odd/ALGOL-60/even-or-odd.alg @@ -0,0 +1,21 @@ +begin + +integer i; + +boolean procedure even(n); + value n; integer n; +begin + even := (n = entier(n/2) * 2); +end; + +comment - exercise the function; +for i := 1 step 3 until 12 do + begin + outinteger(1,i); + if even(i) then + outstring(1,"is even\n") + else + outstring(1,"is odd\n"); + end; + +end diff --git a/Task/Even-or-odd/EMal/even-or-odd.emal b/Task/Even-or-odd/EMal/even-or-odd.emal index 0292abacd4..ee2b7e1cd8 100644 --- a/Task/Even-or-odd/EMal/even-or-odd.emal +++ b/Task/Even-or-odd/EMal/even-or-odd.emal @@ -1,20 +1,16 @@ -List evenCheckers = fun[ - logic by int i do return i % 2 == 0 end, - logic by int i do return i & 1 == 0 end] -List oddCheckers = fun[ - logic by int i do return i % 2 != 0 end, - logic by int i do return i & 1 == 1 end] -writeLine("integer".padStart(10, " ") + "|is_even" + "|is_odd |") +List evenCheckers ← fun[ + candidate_fitness + candidate, candidate_fitness = child, child_fitness + end + end + candidate +end + +parent = TARGET.map { ALPHABET.sample } + +(1..).each do |gen| + printf "%4d %s\n", gen, parent.join + break if parent == TARGET + parent = next_parent(parent, TARGET, C, RATE) +end diff --git a/Task/Evolutionary-algorithm/FutureBasic/evolutionary-algorithm.basic b/Task/Evolutionary-algorithm/FutureBasic/evolutionary-algorithm.basic new file mode 100644 index 0000000000..36c9824034 --- /dev/null +++ b/Task/Evolutionary-algorithm/FutureBasic/evolutionary-algorithm.basic @@ -0,0 +1,80 @@ +include "NSLog.incl" + +begin globals + CFStringRef target + CFStringRef alphabet + NSInteger c + CGFloat p +end globals + +target = @"METHINKS IT IS LIKE A WEASEL" +alphabet = @"ABCDEFGHIJKLMNOPQRSTUVWXYZ " +c = 100 +p = 0.06 + +toolbox fn arc4random_uniform( UInt32 upperbound ) = UInt32 + +local fn Fitness( s as CFStringRef ) as NSInteger + NSInteger score = len(target) + for NSInteger i = 0 to len(target) -1 + if ( ucc(s,i) == ucc(target,i) ) then score-- + next +end fn = score + +local fn Mutate( s as CFStringRef, rate as CGFloat ) as CFStringRef + CFMutableStringRef result = fn MutableStringWithString( @"" ) + for NSInteger i = 0 to len(s) -1 + if ( ( fn arc4random_uniform(100) / 100.0) < rate ) + NSInteger idx = fn arc4random_uniform( (UInt32)len(alphabet) ) + MutableStringAppendFormat( result, @"%C", ucc( alphabet, idx ) ) + else + MutableStringAppendFormat( result, @"%C", ucc( s, i ) ) + end if + next +end fn = result + +local fn RandomString( length as NSInteger ) as CFStringRef + CFMutableStringRef result = fn MutableStringWithString( @"" ) + for NSInteger i = 0 to length -1 + NSInteger idx = fn arc4random_uniform( (UInt32)len(alphabet) ) + MutableStringAppendFormat( result, @"%C", ucc( alphabet, idx ) ) + next +end fn = result + +void local fn PrintStep( stepNum as NSInteger, s as CFStringRef, fit as NSInteger, result as CFMutableStringRef ) + MutableStringAppendFormat( result, @"%3ld: %@ Distance: %ld\n", (long)stepNum, s, (long)fit ) +end fn + +local fn EvolveString as CFStringRef + CFMutableStringRef result = fn MutableStringNew + CFStringRef parent = fn RandomString( len(target) ) + fn PrintStep( 0, parent, fn Fitness(parent), result ) + + NSInteger stepNum = 0 + while ( fn StringIsEqual( parent, target ) == NO ) + NSInteger bestFitness = len(target) + 1 + CFStringRef bestChild = @"" + CFStringRef child + NSInteger fit + + for NSInteger i = 0 to c -1 + child = fn Mutate( parent, p ) + fit = fn Fitness( child ) + if ( fit < bestFitness ) + bestFitness = fit + bestChild = child + end if + next + parent = bestChild + stepNum++ + fn PrintStep( stepNum, parent, bestFitness, result ) + wend +end fn = result + +CFTimeInterval t : t = fn CACurrentMediaTime +CFStringRef result : result = fn EvolveString +NSLog( @"\nCompute time: %.3f ms\n",(fn CACurrentMediaTime-t)*1000 ) +NSLog( @"%@", result ) +NSLogScrollToTop + +HandleEvents diff --git a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Langur/exceptions-catch-an-exception-thrown-in-a-nested-call.langur b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Langur/exceptions-catch-an-exception-thrown-in-a-nested-call.langur index e376e53714..13d7a22492 100644 --- a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Langur/exceptions-catch-an-exception-thrown-in-a-nested-call.langur +++ b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Langur/exceptions-catch-an-exception-thrown-in-a-nested-call.langur @@ -4,7 +4,7 @@ val U1 = {"msg": "U1"} val baz = fn i: throw if(i==0: U0; U1) val bar = fn i: baz(i) -val foo = impure fn() { +val foo = fn*() { for i in [0, 1] { bar(i) catch { diff --git a/Task/Execute-Computer-Zero/M2000-Interpreter/execute-computer-zero.m2000 b/Task/Execute-Computer-Zero/M2000-Interpreter/execute-computer-zero.m2000 new file mode 100644 index 0000000000..90e8e54763 --- /dev/null +++ b/Task/Execute-Computer-Zero/M2000-Interpreter/execute-computer-zero.m2000 @@ -0,0 +1,155 @@ +module Execute_Computer_Zero{ + global byte MEM[31]=0XFF, PC=0 + module ZERO (program$, f=-2, showrun, skipreadcode){ + Enum Commands { + NOP=0X0, LDA=0X20, STA=0X40, ADD=0X60, SUB=0X80, BRZ=0XA0, JMP=0XC0, STP=0XE0 + } + if skipreadcode then goto cont1 + PC<=0 + dim code$() + var crlf=chr$(13)+chr$(10) ' CRLF + var prname$="Program #1" + program$=replace$(chr$(9)," ", program$) + program$=replace$(",",crlf, program$) + program$=ucase$(filter$(program$, "().")) + code$()=piece$(program$, crlf) + document source$ + for I=0 to len(code$())-1 + tok$=trim$(LeftPart$(trim$(code$(I))+" ", " ")) + part$=trim$(RightPart$(trim$(code$(I))+" 0", " ")) + val=val(part$) MOD 32 + ch$=left$(tok$,1) + c=0 + if ch$="#" then + prname$=mid$(trim$(code$(I)), 2) + continue + end if + tok$=filter$(tok$, "+-_x!@#$%^&*/|><") + if ch$>="0" and ch$<="9" then + val=int(val(tok$)) mod 256 + source$ =" "+hex$(PC, 1)+" "+hex$(val,1)+crlf + else.if tok$="" then + continue + else.if valid(eval(tok$)) then + c=eval(tok$) + source$ =" "+hex$(PC, 1)+" "+tok$+" "+hex$(val,1)+crlf + end if + MEM[PC]<=c+VAL + PC++ + next + Print #f, "Program Name:";prname$ + Print #f, source$; + Print #f, "Program Length ";PC;"bytes" + PC<=0 +cont1: + byte A=0, ADDR=0 + structure Accumulator { + { A as Byte, Overflow as Byte + } + R as Integer + } + Accumulator AC + CM=STP + if showrun then Print #f, "PC MEM COM ADDR AC" + do + if inkey$=" " then Print "Break": exit + A=MEM[PC] + ADDR=A MOD 32 + CM=A-ADDR + if showrun then Print #f, Hex$(PC,1);" ";hex$(A,1);" ";EVAL$(CM);" ";hex$(ADDR, 1);" ";Hex$(AC|A, 1) + select case CM + case NOP + PC++ : PC|MOD 32 + case LDA + AC|R=MEM[ADDR]:PC++ : PC|MOD 32 + case STA + MEM[ADDR]<=AC|A : PC++ : PC|MOD 32 + case ADD + AC|R=AC|R+MEM[ADDR]:PC++ : PC|MOD 32 + case SUB + AC|R=uint(AC|R-MEM[ADDR]): PC++ : PC|MOD 32 + case BRZ + { + if AC|A then + PC++ : PC|MOD 32 + if showrun then Print #f, "NON ZERO - CONTINUE" + else + PC<=A MOD 32 + if showrun then Print #f, "BRANCH TO ";PC + end if + } + case JMP + PC<=A MOD 32:if showrun then Print #f, "JUMP TO ";PC + case STP + exit + end select + always + if skipreadcode else + Print #f, "STOP AT ";hex$(PC,1) + Print #f, "RESULT:";AC|A;"|0x";hex$(AC|A, 1) + Print #f, "NEGATIVE:"; IF$(AC|A>126->"1","0") + Print #f, "OVERFLOW:"; IF$(AC|Overflow>0->"1","0") + Print #f + end if + } + Flush + Data { + #add 2 + LDA 3, ADD 4, STP 0, 2, 2 + } + Data {#fibonacci + LDA 14, STA 15, ADD 13, STA 14, + LDA 15, STA 13, LDA 16, SUB 17, + BRZ 11, STA 16, JMP 0, LDA 14, + STP 0, 1, 1, 0 , 8, 1 + } + Data {#8*7 + LDA 12, ADD 10, STA 12, LDA 11, SUB 13, + STA 11, BRZ 8, JMP 0, LDA 12, STP 0, + 8, 7, 0, 1 + } + Data {#linkedList + LDA 13, ADD 15, STA 5, ADD 16, STA 7, NOP 0, STA 14, NOP 0 + , BRZ 11, STA 15, JMP 0, LDA 14, STP 0, LDA 0, 0, 28 + , 1, 0, 0, 0, 6, 0, 2, 26 + , 5, 20, 3, 30, 1, 22, 4, 24 + } + Data { #0-255 + LDA 3, SUB 4, STP 0, 0, 255 + } + Data {#0-1 + LDA 3, SUB 4, STP 0, 0, 1 + } + Data {#1+255 + LDA 3, ADD 4, STP 0, 1, 255 + } + filename="run01.txt" + open filename for wide output as #d + while not empty + Zero letter$, d, false, false + end while + Zero { #prisoner + NOP 0, NOP 0, STP 0, 0, LDA 3, SUB 29, BRZ 18, LDA 3 + , STA 29, BRZ 14, LDA 1, ADD 31, STA 1, JMP 2, LDA 0, ADD 31 + , STA 0, JMP 2, LDA 3, STA 29, LDA 1, ADD 30, ADD 3, STA 1 + , LDA 0, ADD 30, ADD 3, STA 0, JMP 2, 0, 1, 3 + }, d, false, false + + Enum Action {cooperate=0UB, defect} + byte AcA + PM=defect + for i=1 to 5 + Print #d, "Round ";i;" ";field$(eval$(PM), 10); + PC++ + mem[PC]<=pm + IF PM=cooperate THEN PM++ ELSE PM-- + PC++ + Zero {}, d, false, true + Read AcA + Print #d, "Player:";mem[0], " Computer:";mem[1] + next + close #d + if filename<>"" then win dir$+filename + +} +Execute_Computer_Zero diff --git a/Task/Execute-Computer-Zero/Quackery/execute-computer-zero.quackery b/Task/Execute-Computer-Zero/Quackery/execute-computer-zero.quackery new file mode 100644 index 0000000000..27224d387f --- /dev/null +++ b/Task/Execute-Computer-Zero/Quackery/execute-computer-zero.quackery @@ -0,0 +1,175 @@ + [ 0 ] is NOP ( --> n ) + [ 1 ] is LDA ( --> n ) + [ 2 ] is STA ( --> n ) + [ 3 ] is ADD ( --> n ) + [ 4 ] is SUB ( --> n ) + [ 5 ] is BRZ ( --> n ) + [ 6 ] is JMP ( --> n ) + [ 7 ] is STP ( --> n ) + + [ 0 ] is DATA ( --> n ) + [ 0 ] is -- ( --> n ) + + [ stack 0 ] is acc ( --> s ) + [ stack 0 ] is ip ( --> s ) + [ stack false ] is flag ( --> n ) + + [ 0 ip replace 0 32 of ] is computer/zero ( --> [ ) + + [ 255 & swap 5 << | + swap ip share poke + 1 ip tally ] is , ( [ --> [ ) + + [ drop ] is nop ( [ n --> [ ) + + [ dip dup peek acc replace ] is lda ( [ n --> [ ) + + [ acc share unrot poke ] is sta ( [ n --> [ ) + + [ dip dup peek + acc take + 255 & acc put ] is add ( [ n --> [ ) + + [ dip dup peek negate + acc take + 255 & acc put ] is sub ( [ n --> [ ) + + [ acc share iff drop done + ip replace ] is brz ( [ n --> [ ) + + [ ip replace ] is jmp ( [ n --> [ ) + + [ drop true flag replace ] is stp ( [ n --> [ ) + + [ false flag replace + 0 acc replace + 0 ip replace + [ dup ip share peek + 1 ip tally + dup 31 & swap 5 >> + [ table + nop lda sta add + sub brz jmp stp ] do + flag share until ] + drop + acc share + say "acc = " dup echo + dup 128 & iff + [ say " or " + 127 ~ | echo ] + else drop cr ] is execute ( [ --> ) + + cr say " 2+2: " + computer/zero + ( 00 ) LDA 03 , + ( 01 ) ADD 04 , + ( 02 ) STP -- , + ( 03 ) DATA 2 , + ( 04 ) DATA 2 , + execute + cr say " 7*8: " + computer/zero + ( 00 ) LDA 12 , + ( 01 ) ADD 10 , + ( 02 ) STA 12 , + ( 03 ) LDA 11 , + ( 04 ) SUB 13 , + ( 05 ) STA 11 , + ( 06 ) BRZ 08 , + ( 07 ) JMP 00 , + ( 08 ) LDA 12 , + ( 09 ) STP -- , + ( 10 ) DATA 8 , + ( 11 ) DATA 7 , + ( 12 ) DATA 0 , + ( 13 ) DATA 1 , + execute + cr say " Fibonacci: " + computer/zero + ( 00 ) LDA 14 , + ( 01 ) STA 15 , + ( 02 ) ADD 13 , + ( 03 ) STA 14 , + ( 04 ) LDA 15 , + ( 05 ) STA 13 , + ( 06 ) LDA 16 , + ( 07 ) SUB 17 , + ( 08 ) BRZ 11 , + ( 09 ) STA 16 , + ( 10 ) JMP 00 , + ( 11 ) LDA 14 , + ( 12 ) STP -- , + ( 13 ) DATA 1 , + ( 14 ) DATA 1 , + ( 15 ) DATA 0 , + ( 16 ) DATA 8 , + ( 17 ) DATA 1 , + execute + cr say "linked list: " + computer/zero + ( 00 ) LDA 13 , + ( 01 ) ADD 15 , + ( 02 ) STA 05 , + ( 03 ) ADD 16 , + ( 04 ) STA 07 , + ( 05 ) NOP -- , + ( 06 ) STA 14 , + ( 07 ) NOP -- , + ( 08 ) BRZ 11 , + ( 09 ) STA 15 , + ( 10 ) JMP 00 , + ( 11 ) LDA 14 , + ( 12 ) STP -- , + ( 13 ) LDA 00 , + ( 14 ) DATA 0 , + ( 15 ) DATA 28 , + ( 16 ) DATA 1 , + ( 17 ) DATA 0 , + ( 18 ) DATA 0 , + ( 19 ) DATA 0 , + ( 20 ) DATA 6 , + ( 21 ) DATA 0 , + ( 22 ) DATA 2 , + ( 23 ) DATA 26 , + ( 24 ) DATA 5 , + ( 25 ) DATA 20 , + ( 26 ) DATA 3 , + ( 27 ) DATA 30 , + ( 28 ) DATA 1 , + ( 29 ) DATA 22 , + ( 30 ) DATA 4 , + ( 31 ) DATA 24 , + execute + cr say " prisoner: " + computer/zero + ( 00 ) NOP -- , + ( 01 ) NOP -- , + ( 02 ) STP -- , + ( 03 ) NOP -- , + ( 04 ) LDA 03 , + ( 05 ) SUB 29 , + ( 06 ) BRZ 18 , + ( 07 ) LDA 03 , + ( 08 ) STA 29 , + ( 09 ) BRZ 14 , + ( 10 ) LDA 01 , + ( 11 ) ADD 31 , + ( 12 ) STA 01 , + ( 13 ) JMP 02 , + ( 14 ) LDA 00 , + ( 15 ) ADD 31 , + ( 16 ) STA 00 , + ( 17 ) JMP 02 , + ( 18 ) LDA 03 , + ( 19 ) STA 29 , + ( 20 ) LDA 01 , + ( 21 ) ADD 30 , + ( 22 ) ADD 03 , + ( 23 ) STA 01 , + ( 24 ) LDA 00 , + ( 25 ) ADD 30 , + ( 26 ) ADD 03 , + ( 27 ) STA 01 , + ( 28 ) JMP 02 , + ( 29 ) DATA 0 , + ( 30 ) DATA 1 , + ( 31 ) DATA 3 , + execute diff --git a/Task/Execute-a-system-command/Wren/execute-a-system-command-1.wren b/Task/Execute-a-system-command/Wren/execute-a-system-command-1.wren deleted file mode 100644 index c638a0983e..0000000000 --- a/Task/Execute-a-system-command/Wren/execute-a-system-command-1.wren +++ /dev/null @@ -1,8 +0,0 @@ -/* Execute_a_system_command.wren */ -class Command { - foreign static exec(name, param) // the code for this is provided by Go -} - -Command.exec("ls", "-lt") -System.print() -Command.exec("dir", "") diff --git a/Task/Execute-a-system-command/Wren/execute-a-system-command-2.wren b/Task/Execute-a-system-command/Wren/execute-a-system-command-2.wren deleted file mode 100644 index 2e0ffb7e03..0000000000 --- a/Task/Execute-a-system-command/Wren/execute-a-system-command-2.wren +++ /dev/null @@ -1,39 +0,0 @@ -/* Execute_a_system_command.go*/ -package main - -import ( - wren "github.com/crazyinfin8/WrenGo" - "log" - "os" - "os/exec" -) - -type any = interface{} - -func execCommand(vm *wren.VM, parameters []any) (any, error) { - name := parameters[1].(string) - param := parameters[2].(string) - var cmd *exec.Cmd - if param != "" { - cmd = exec.Command(name, param) - } else { - cmd = exec.Command(name) - } - cmd.Stdout = os.Stdout - cmd.Stderr = os.Stderr - if err := cmd.Run(); err != nil { - log.Fatal(err) - } - return nil, nil -} - -func main() { - vm := wren.NewVM() - fileName := "Execute_a_system_command.wren" - methodMap := wren.MethodMap{"static exec(_,_)": execCommand} - classMap := wren.ClassMap{"Command": wren.NewClass(nil, nil, methodMap)} - module := wren.NewModule(classMap) - vm.SetModule(fileName, module) - vm.InterpretFile(fileName) - vm.Free() -} diff --git a/Task/Execute-a-system-command/Wren/execute-a-system-command.wren b/Task/Execute-a-system-command/Wren/execute-a-system-command.wren new file mode 100644 index 0000000000..1d97b0a9de --- /dev/null +++ b/Task/Execute-a-system-command/Wren/execute-a-system-command.wren @@ -0,0 +1,5 @@ +import "os" for Process + +Process.exec("ls", ["-lt"]) +System.print() +Process.exec("dir") diff --git a/Task/Extreme-floating-point-values/Uiua/extreme-floating-point-values.uiua b/Task/Extreme-floating-point-values/Uiua/extreme-floating-point-values.uiua new file mode 100644 index 0000000000..d9ae4f444f --- /dev/null +++ b/Task/Extreme-floating-point-values/Uiua/extreme-floating-point-values.uiua @@ -0,0 +1,4 @@ +&p∞ +&p¯∞ +&p¯0 # Distinct value from "0". +&pNaN # IEEE 754-2008's NaN diff --git a/Task/Factorial/Haskell/factorial-10.hs b/Task/Factorial/Haskell/factorial-10.hs new file mode 100644 index 0000000000..d7507d16b3 --- /dev/null +++ b/Task/Factorial/Haskell/factorial-10.hs @@ -0,0 +1,8 @@ +-- product of [a,a+1..b] +productFromTo a b = + if a>b then 1 + else if a == b then a + else productFromTo a c * productFromTo (c+1) b + where c = (a+b) `div` 2 + +factorial = productFromTo 1 diff --git a/Task/Factorial/Haskell/factorial-5.hs b/Task/Factorial/Haskell/factorial-5.hs index 6b76b69b6e..f036c73a77 100644 --- a/Task/Factorial/Haskell/factorial-5.hs +++ b/Task/Factorial/Haskell/factorial-5.hs @@ -1,3 +1 @@ -factorial :: Integral -> Integral -factorial 0 = 1 -factorial n = n * factorial (n-1) +factorials = 1 : zipWith (*) factorials [1..] diff --git a/Task/Factorial/Haskell/factorial-6.hs b/Task/Factorial/Haskell/factorial-6.hs index baef906bf8..655c366a44 100644 --- a/Task/Factorial/Haskell/factorial-6.hs +++ b/Task/Factorial/Haskell/factorial-6.hs @@ -1,5 +1,2 @@ -fac n - | n >= 0 = go 1 n - | otherwise = error "Negative factorial!" - where go acc 0 = acc - go acc n = go (acc * n) (n - 1) +factorials = go 1 1 where + go n fac = f : go (n+1) (n*fac) diff --git a/Task/Factorial/Haskell/factorial-7.hs b/Task/Factorial/Haskell/factorial-7.hs index 77d34e9b2e..6b76b69b6e 100644 --- a/Task/Factorial/Haskell/factorial-7.hs +++ b/Task/Factorial/Haskell/factorial-7.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE PostfixOperators #-} - -(!) :: Integer -> Integer -(!) 0 = 1 -(!) n = n * (pred n !) - -main :: IO () -main = do - print (5 !) - print ((4 !) !) +factorial :: Integral -> Integral +factorial 0 = 1 +factorial n = n * factorial (n-1) diff --git a/Task/Factorial/Haskell/factorial-8.hs b/Task/Factorial/Haskell/factorial-8.hs index d7507d16b3..baef906bf8 100644 --- a/Task/Factorial/Haskell/factorial-8.hs +++ b/Task/Factorial/Haskell/factorial-8.hs @@ -1,8 +1,5 @@ --- product of [a,a+1..b] -productFromTo a b = - if a>b then 1 - else if a == b then a - else productFromTo a c * productFromTo (c+1) b - where c = (a+b) `div` 2 - -factorial = productFromTo 1 +fac n + | n >= 0 = go 1 n + | otherwise = error "Negative factorial!" + where go acc 0 = acc + go acc n = go (acc * n) (n - 1) diff --git a/Task/Factorial/Haskell/factorial-9.hs b/Task/Factorial/Haskell/factorial-9.hs new file mode 100644 index 0000000000..77d34e9b2e --- /dev/null +++ b/Task/Factorial/Haskell/factorial-9.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PostfixOperators #-} + +(!) :: Integer -> Integer +(!) 0 = 1 +(!) n = n * (pred n !) + +main :: IO () +main = do + print (5 !) + print ((4 !) !) diff --git a/Task/Factorial/Langur/factorial-1.langur b/Task/Factorial/Langur/factorial-1.langur index 607783ad36..8f10a78690 100644 --- a/Task/Factorial/Langur/factorial-1.langur +++ b/Task/Factorial/Langur/factorial-1.langur @@ -1,2 +1,2 @@ -val factorial = fn n: fold(fn{*}, 2 .. n) +val factorial = fn n: fold(2 .. n, by=fn{*}) writeln factorial(7) diff --git a/Task/Factorial/M2000-Interpreter/factorial.m2000 b/Task/Factorial/M2000-Interpreter/factorial-1.m2000 similarity index 100% rename from Task/Factorial/M2000-Interpreter/factorial.m2000 rename to Task/Factorial/M2000-Interpreter/factorial-1.m2000 diff --git a/Task/Factorial/M2000-Interpreter/factorial-2.m2000 b/Task/Factorial/M2000-Interpreter/factorial-2.m2000 new file mode 100644 index 0000000000..dc7940cef8 --- /dev/null +++ b/Task/Factorial/M2000-Interpreter/factorial-2.m2000 @@ -0,0 +1,27 @@ +Cls , 0 ' 0 for non split display, eg 3 means we preserve the 3 top lines from scrolling/cla +Report { + Factorial Task + Definitions + • The factorial of 0 (zero) is defined as being 1 (unity). + • The Factorial Function of a positive integer, n, is defined as the product of the sequence: + n, n-1, n-2, ... 1 + +} +Cls, row ' now we preserve some lines (as row number return here) +Module CheckIt { + m=bigInteger("1") + with m, "tostring" as m.toString + k=width-tab + For i=1 to 1000 + if pos>tab then print + Print @(0), format$("{0::-4} :", i) ; + method m,"multiply", biginteger(i+"") as m + Report m.toString, k + ' Report stop at 2/3 of display lines, and wait mouse button or spacebar + ' we can flush the keyboard buffer and press space, so we get non stop display + ' Report didn't stop if we use the printer's layer. + while inkey$<>"": wait 1:end while + keyboard " " + Next i +} +Checkit diff --git a/Task/Factorial/Retro/factorial.retro b/Task/Factorial/Retro/factorial.retro index fb56673ef4..11cf76e297 100644 --- a/Task/Factorial/Retro/factorial.retro +++ b/Task/Factorial/Retro/factorial.retro @@ -1,2 +1,8 @@ -: dup 1 = if; dup 1- * ; -: factorial dup 0 = [ 1+ ] [ ] if ; +: + dup #1 -eq? 0; drop + dup n:dec * ; + +:factorial + dup n:zero? + [ n:inc ] + [ ] choose ; diff --git a/Task/Factorial/YAMLScript/factorial.ys b/Task/Factorial/YAMLScript/factorial.ys index b823037a90..06c6ba6aef 100644 --- a/Task/Factorial/YAMLScript/factorial.ys +++ b/Task/Factorial/YAMLScript/factorial.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(n=10): say: "$n! -> $factorial(n)" diff --git a/Task/Factors-of-an-integer/EDSAC-order-code/factors-of-an-integer.edsac b/Task/Factors-of-an-integer/EDSAC-order-code/factors-of-an-integer.edsac index cdf4742401..75f73ed6fb 100644 --- a/Task/Factors-of-an-integer/EDSAC-order-code/factors-of-an-integer.edsac +++ b/Task/Factors-of-an-integer/EDSAC-order-code/factors-of-an-integer.edsac @@ -1,153 +1,151 @@ - [Factors of an integer, from Rosetta Code website.] - [EDSAC program, Initial Orders 2.] +[Factors of an integer, from Rosetta Code website.] +[EDSAC program, Initial Orders 2.] +[2024-12-25 (1) Fixed bug in print subroutine + (2) Added factors of more integers. [The numbers to be factorized are read in by library subroutine R2 (Wilkes, Wheeler and Gill, 1951 edition, pp.96-97, 148).] [The address of the integers is placed in location 46, so they can be referred to by the N parameter (or we could have used 45 and H, etc.)] - T 46 K - P 600 F [address of integers] + T46K + P600F [address of integers] [Subroutine R2] GKT20FVDL8FA40DUDTFI40FA40FS39FG@S2FG23FA5@T5@E4@E13Z - T #N [pass address of integers to R2] + T#N [pass address of integers to R2] +[Integers, separated by 'F' and terminated by '#TZ', as R2 requires.] +420F42000F420000F99999F999999F0# + TZ [resume normal loading] -[List of integers to be factorized; edit ad lib. R2 requires 'F' after - each integer except the last, and '#' (pi) after the last. - This program uses 0 to mark the end of the list.] - 42000F999999F0# - T Z [resume normal loading] + [Modified library subroutine P7. + Prints signed integer; up to 10 digits, left-justified. + Input: 0D = integer + 52 locations. Load at even address. Workspace 4D.] + T56K +GKA3FT42@A47@T31@ADE10@T31@A46@T31@SDTDH44#@NDYFLDT4DS43@TF +H17@S17@A43@G23@UFS43@T1FV4DAFG48@SFLDUFXFOFFFSFL4FT4DA47@ +T31@A1FA43@G20@XFT44#ZPFT43ZP1024FP610D@524DO26@XFSFL8FT4DE39@ - [Modified library subroutine P7.] - [Prints signed integer; up to 10 digits, left-justified.] - [Input: 0D = integer,] - [54 locations. Load at even address. Workspace 4D.] - T 56 K -GKA3FT42@A49@T31@ADE10@T31@A48@T31@SDTDH44#@NDYFLDT4DS43@ -TFH17@S17@A43@G23@UFS43@T1FV4DAFG50@SFLDUFXFOFFFSFL4FT4DA49@ -T31@A1FA43@G20@XFP1024FP610D@524D!FO46@O26@XFSFL8FT4DE39@ - - [Division subroutine for positive long integers. - 35-bit dividend and divisor (max 2^34 - 1) - returning quotient and remainder. - Input: dividend at 4D, divisor at 6D - Output: remainder at 4D, quotient at 6D. - 37 locations; working locations 0D, 8D.] - T 110 K + [Division subroutine for positive long integers. + 35-bit dividend and divisor (max 2^34 - 1) + returning quotient and remainder. + Input: dividend at 4D, divisor at 6D + Output: remainder at 4D, quotient at 6D. + 37 locations; working locations 0D, 8D.] + T110K GKA3FT35@A6DU8DTDA4DRDSDG13@T36@ADLDE4@T36@T6DA4DSDG23@ T4DA6DYFYFT6DT36@A8DSDE35@T36@ADRDTDA6DLDT6DE15@EFPF [********************** ROSETTA CODE TASK **********************] - [Subroutine to find and print factors of a positive integer. - Input: 0D = integer, maximum 10 decimal digits. - Load at even address.] - T 148 K - G K - A 3 F [form and plant link for return] - T 55 @ - A D [load integer whose factors are to be found] - T 56#@ [store] - A 62#@ [load 1] - T 58#@ [possible factor := 1] - S 65 @ [negative count of items per line] - T 64 @ [initialize count] + [Subroutine to find and print factors of a positive integer. + Input: 0D = integer, maximum 10 decimal digits. + Load at even address.] + T148K + GK + A3F [form and plant link for return] + T55@ + AD [load integer whose factors are to be found] + T56#@ [store] + A62#@ [load 1] + T58#@ [possible factor := 1] + S65@ [negative count of items per line] + T64@ [initialize count] [Start of loop round possible factors] - [8] T F [clear acc] - A 56#@ [load integer] - T 4 D [to 4F for division] - A 58#@ [load possible factor] - T 6 D [to 6F for division] - A 13 @ [for return from next] - G 110 F [do division; clears acc] - A 6 D [save quotient (6F may be changed below)] - T 60#@ - S 4 D [load negative of remainder] - G 44 @ [skip if remainder > 0] + [8] TF [clear acc] + A56#@ [load integer] + T4D [to 4D for division] + A58#@ [load possible factor] + T6D [to 6D for division] + A13@ [for return from next] + G110F [do division; clears acc] + A6D [save quotient (6D may be changed below)] + T60#@ + S4D [load negative of remainder] + G44@ [skip if remainder > 0] [Here if m is a factor of n.] [Print m and the quotient together] - T F [clear acc] - A 64 @ [test count of items per line] - G 26 @ [skip if not start of line] - S 65 @ [start of line, reset count] - T 64 @ - O 70 @ [and print CR, LF] - O 71 @ - [26] T F [clear acc] - O 67 @ [print '('] - A 58#@ [load factor] - T D [to 0D for printing] - A 30 @ [for return from next] - G 56 F [print factor; clears acc] - O 69 @ [print comma] - A 60#@ [load quotient] - T D [to 0D for printing] - A 35 @ [for return from next] - G 56 F [print quotient; clears acc] - O 68 @ [print ')'] - A 64 @ [negative counter for items per line] - A 2 F [inc] - E 43 @ [skip if end of line] - O 66 @ [not end of line, print 2 spaces] - O 66 @ - [43] T 64 @ [update counter] + TF [clear acc] + A64@ [test count of items per line] + G26@ [skip if not start of line] + S65@ [start of line, reset count] + T64@ + O70@ [and print CR, LF] + O71@ + [26] TF [clear acc] + O67@ [print '('] + A58#@ [load factor] + TD [to 0D for printing] + A30@ [for return from next] + G56F [print factor; clears acc] + O69@ [print comma] + A60#@ [load quotient] + TD [to 0D for printing] + A35@ [for return from next] + G56F [print quotient; clears acc] + O68@ [print ')'] + A64@ [negative counter for items per line] + A2F [inc] + E43@ [skip if end of line] + O66@ [not end of line, print 2 spaces] + O66@ + [43] T64@ [update counter] [Common code after testing possible factor] - [44] T F [clear acc] - A 58#@ [load possible factor] - A 62#@ [inc by 1] - U 58#@ [store back] - S 60#@ [compare with quotient] - G 8 @ [loop if (new factor) < (old quotient)] + [44] TF [clear acc] + A58#@ [load possible factor] + A62#@ [inc by 1] + U58#@ [store back] + S60#@ [compare with quotient] + G8@ [loop if (new factor) < (old quotient)] [Here when found all factors] - O 70 @ [print CR, LF twice] - O 71 @ - O 70 @ - O 71 @ - T F [exit with acc = 0] - [55] E F [return] - [--------] - [56] PF PF [number whose factors are to be found] - [58] PF PF [possible factor] - [60] PF PF [integer part of (number/factor)] - T62#Z PF [clear sandwich digit in 35-bit constant 1] - T 62 Z [resume normal loading] - [62] PD PF [35-bit constant 1] - [64] P F [negative counter for items per line] - [65] P 4 F [items per line, in address field] - [66] ! F [space] - [67] K F [left parenthesis (in figures mode)] - [68] L F [right parenthesis (in figures mode)] - [69] N F [comma (in figures mode)] - [70] @ F [carriage return] - [71] & F [line feed] + O70@ [print CR, LF twice] + O71@ + O70@ + O71@ + TF [exit with acc = 0] + [55] EF [(planted) return to caller] + [--------------] + [56] PF PF [number whose factors are to be found] + [58] PF PF [possible factor] + [60] PF PF [integer part of (number/factor)] + T62#Z [clear whole of 35-bit constant, including sandwich bit] + PF + T62Z [resume normal loading] + [62] PD PF [35-bit constant 1] + [64] PF [negative counter for items per line] + [65] P4F [items per line, in address field] + [66] !F [space] + [67] KF + [68] LF + [69] NF [comma, in figure shift] + [70] @F [carriage return] + [71] &F [line feed] [Main routine for demonstrating subroutine.] - T 400 K - G K - [0] # F [set figures mode] - [1] K 4096 F [null char] - [2] S #N [order to load negative of first number] - [3] P 2 F [to inc address by 2 for next number] + T400K + GK + [0] #F [figure shift] + [1] K4096F [null char] + [2] S#N [order to load negative first number] + [3] P2F [to inc address by 2 for next number] [Enter with acc = 0] - [4] O @ [set teleprinter to figures] - A 2 @ [load order for first integer] - [6] T 7 @ [plant in next order] - [7] S D [load negative of 35-bit integer] - E 17 @ [exit if number is 0] - T D [negative to 0D] - S D [convert to positive] - T D [pass to subroutine] - A 12 @ [call subroutine to find and print factors] - G 148 F - A 7 @ [modify order above, for next integer] - A 3 @ - E 6 @ [always jump, since S = 12 > 0] - [--------] - [17] O 1 @ [done, print null to flush printer buffer] - Z F [stop] - - E 4 Z [define entry point] - P F [acc = 0 on entry] + [4] O@ [set teleprinter to figures] + A2@ [load order for first integer] + [6] T7@ [plant in next order] + [7] SD [load negative of 35-bit integer] + E17@ [exit if number is 0] + TD + SD [convert to positive] + TD [pass to subroutine] + A12@ [call subroutine to find and print factors] + G148F + A7@ [modify order above, for next integer] + A3@ + E6@ [always jump, since S = 12 > 0] + [17] O1@ [done, print null to flush printer buffer] + ZF [stop] + E4Z [define entry point] + PF [acc = 0 on entry diff --git a/Task/Factors-of-an-integer/FutureBasic/factors-of-an-integer.basic b/Task/Factors-of-an-integer/FutureBasic/factors-of-an-integer.basic index d8d5b31d8b..5ceb9204b8 100644 --- a/Task/Factors-of-an-integer/FutureBasic/factors-of-an-integer.basic +++ b/Task/Factors-of-an-integer/FutureBasic/factors-of-an-integer.basic @@ -1,50 +1,23 @@ -window 1, @"Factors of an Integer", (0,0,1000,270) +local fn Factors( n as int ) as CFArrayRef + CFMutableArrayRef mutArray = fn MutableArrayNew -clear local mode -local fn IntegerFactors( f as long ) as CFStringRef - long i, s, l(100), c = 0 - CFStringRef factorStr = @"" - - for i = 1 to sqr(f) - if ( f mod i == 0 ) - l(c) = i - c++ - if ( f != i ^ 2 ) - l(c) = ( f / i ) - c++ + for int factor = 1 to sqr(n) + if ( n mod factor == 0 ) + MutableArrayAddObject( mutArray, @(factor) ) + if ( n/factor != factor ) + MutableArrayAddObject( mutArray, @(n/factor) ) end if end if - next i - - s = 1 - while ( s = 1 ) - s = 0 - for i = 0 to c-1 - if l(i) > l(i+1) and l(i+1) != 0 - swap l(i), l(i+1) - s = 1 - end if - next i - wend - - for i = 0 to c - 1 - if ( i < c - 1 ) - factorStr = fn StringWithFormat( @"%@ %ld, ", factorStr, l(i) ) - else - factorStr = fn StringWithFormat( @"%@ %ld", factorStr, l(i) ) - end if next -end fn = factorStr + CFArrayRef result = fn ArraySortedArrayUsingSelector( mutArray, @"compare:" ) +end fn = result -print @"Factors of 25 are:"; fn IntegerFactors( 25 ) -print @"Factors of 45 are:"; fn IntegerFactors( 45 ) -print @"Factors of 103 are:"; fn IntegerFactors( 103 ) -print @"Factors of 760 are:"; fn IntegerFactors( 760 ) -print @"Factors of 12345 are:"; fn IntegerFactors( 12345 ) -print @"Factors of 32766 are:"; fn IntegerFactors( 32766 ) -print @"Factors of 32767 are:"; fn IntegerFactors( 32767 ) -print @"Factors of 57097 are:"; fn IntegerFactors( 57097 ) -print @"Factors of 12345678 are:"; fn IntegerFactors( 12345678 ) -print @"Factors of 32434243 are:"; fn IntegerFactors( 32434243 ) +mda (0) = {1,2,3,4,5,6,7,8,9,10,20,40,60,80,100,200,300,400,512,677,768,966,1000,1024,2048,4096} + +int i, n +for i = 0 to mda_count -1 + n = mda_integer(i) + print fn StringWithFormat( @"Factors of %4d: [%@]", n, fn ArrayComponentsJoinedByString( fn Factors( n ), @", " ) ) +next HandleEvents diff --git a/Task/Factors-of-an-integer/Raku/factors-of-an-integer.raku b/Task/Factors-of-an-integer/Raku/factors-of-an-integer-1.raku similarity index 100% rename from Task/Factors-of-an-integer/Raku/factors-of-an-integer.raku rename to Task/Factors-of-an-integer/Raku/factors-of-an-integer-1.raku diff --git a/Task/Factors-of-an-integer/Raku/factors-of-an-integer-2.raku b/Task/Factors-of-an-integer/Raku/factors-of-an-integer-2.raku new file mode 100644 index 0000000000..ae8b49d375 --- /dev/null +++ b/Task/Factors-of-an-integer/Raku/factors-of-an-integer-2.raku @@ -0,0 +1,5 @@ +use Prime::Factor; + +put divisors :s, 2⁹⁹ + 1; + +say (now - INIT now).round(.001) ~' seconds'; diff --git a/Task/Farey-sequence/Langur/farey-sequence.langur b/Task/Farey-sequence/Langur/farey-sequence.langur index 2743d7c155..2aa36b46f1 100644 --- a/Task/Farey-sequence/Langur/farey-sequence.langur +++ b/Task/Farey-sequence/Langur/farey-sequence.langur @@ -10,7 +10,7 @@ val farey = fn(n) { val testFarey = fn*() { writeln "Farey sequence for orders 1 through 11" for i of 11 { - writeln "{{i:2}}: ", join(" ", map(fn f: "{{f[1]}}/{{f[2]}}", farey(i))) + writeln "{{i:2}}: ", join(map(farey(i), by=fn f: "{{f[1]}}/{{f[2]}}"), by=" ") } } diff --git a/Task/Fast-Fourier-transform/M2000-Interpreter/fast-fourier-transform-1.m2000 b/Task/Fast-Fourier-transform/M2000-Interpreter/fast-fourier-transform-1.m2000 new file mode 100644 index 0000000000..45d054c7f9 --- /dev/null +++ b/Task/Fast-Fourier-transform/M2000-Interpreter/fast-fourier-transform-1.m2000 @@ -0,0 +1,51 @@ +module CreateLibComplexPack { + prototype { + class ComplexPack { + function final complexPolar(a, b) { + method .m, "cxPolar", a, b as ret + =ret + } + function final complex(a, b) { + method .m, "cxNew", a, b as ret + =ret + } + function final mul(a, b) { + method .m, "cxMul", a, b as ret + =ret + } + function final add(a, b) { + method .m, "cxAdd", a, b as ret + =ret + } + function final sub(a, b) { + method .m, "cxSub", a, b as ret + =ret + } + Module final FFT(buf, out, begin as Long, stp as Long, N as Long) { + If stp < N Then + call .FFT, out, buf, begin, 2 * stp, N + call .FFT, out, buf, begin + stp, 2 * stp, N + var i as long, t as variant + for i=0 to N-1 step 2*stp + t= .mul(.complexPolar(1, -pi* i / N), out[begin + i + stp]) + buf[begin + i div 2]= .add(out[begin + i], t) + buf[begin + (i + N) div 2]= .sub(out[begin + i], t) + next + End If + } + private: + declare m math2 + public: + property zero {value} + class: + module ComplexPack{ + method .m,"cxzero" as z + .[zero]<=z + } + } + } as ComplexPack + const UTF8=2& + document Export$=ComplexPack + Save.Doc Export$, "ComplexPack.gsb", UTF8 +} +CreateLibComplexPack diff --git a/Task/Fast-Fourier-transform/M2000-Interpreter/fast-fourier-transform-2.m2000 b/Task/Fast-Fourier-transform/M2000-Interpreter/fast-fourier-transform-2.m2000 new file mode 100644 index 0000000000..aeb97fb834 --- /dev/null +++ b/Task/Fast-Fourier-transform/M2000-Interpreter/fast-fourier-transform-2.m2000 @@ -0,0 +1,19 @@ +module FFT { + load "ComplexPack" + cp=ComplexPack() + variant buf[7]=cp.zero, out[7]=cp.zero + buf[0]|r = 1: buf[1]|r = 1: buf[2]|r = 1: buf[3]|r = 1 + showArr(buf, "Input") + cp.FFT out, buf, 0, 1, 8 + ShowArr(out, "Output") + + Sub ShowArr(m, mes as string) + local n, mx=len(m) + Print mes;": (real+imag)" + while n") + concat("<",vstr(2, Comp,", ",0,-1),"j> ") #end #macro CdebugArr(data) #for(i,0, dimension_size(data, 1)-1) - #debug concat(Cstr(data[i]), "\n") + #debug concat(Cstr(data[i]), " ", str(Abs(data[i]),-1,-1),"\n") #end #end #macro R2C(Real) #end -#macro CmultC(C1, C2) #end +#macro CmultC(C1, C2) #end #macro Conjugate(Comp) #end @@ -26,6 +26,8 @@ global_settings{ assumed_gamma 1.0 } bitwise_and((X > 0), (bitwise_and(X, (X - 1)) = 0)) #end +#macro Abs(C) sqrt(C.x * C.x + C.y * C.y) #end + #macro _FFT0(X, Y, N, Stride, EO) #local M = div(N, 2); #local Theta = 2 * pi / N; diff --git a/Task/Fast-Fourier-transform/PascalABC.NET/fast-fourier-transform.pas b/Task/Fast-Fourier-transform/PascalABC.NET/fast-fourier-transform.pas new file mode 100644 index 0000000000..f6b42e2fa0 --- /dev/null +++ b/Task/Fast-Fourier-transform/PascalABC.NET/fast-fourier-transform.pas @@ -0,0 +1,32 @@ +function fft(x: array of complex): array of complex; +begin + var n := x.length; + if n = 0 then exit; + + setlength(result, n); + + if n = 1 then + begin + result[0] := x[0]; + exit; + end; + + var evens := x.Where((x, i) -> i mod 2 = 0).ToArray; + var odds := x.Where((x, i) -> i mod 2 = 1).ToArray; + var (even, odd) := (fft(evens), fft(odds)); + + var halfn := n div 2; + + for var k := 0 to halfn - 1 do + begin + var a := exp(new Complex(0.0, -2 * Pi * k / n)) * odd[k]; + result[k] := even[k] + a; + result[k + halfn] := even[k] - a; + end; +end; + +begin + var test := |1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0|; + foreach var x in fft(test.select(x -> new Complex(x, 0)).ToArray) do + println(x) +end. diff --git a/Task/Fast-Fourier-transform/Swift/fast-fourier-transform.swift b/Task/Fast-Fourier-transform/Swift/fast-fourier-transform.swift index ff86082f2b..aba4575660 100644 --- a/Task/Fast-Fourier-transform/Swift/fast-fourier-transform.swift +++ b/Task/Fast-Fourier-transform/Swift/fast-fourier-transform.swift @@ -5,7 +5,7 @@ typealias Complex = Numerics.Complex extension Complex { var exp: Complex { - Complex(cos(imaginary), sin(imaginary)) * Complex(cosh(real), sinh(real)) + Complex(cos(imaginary), sin(imaginary)) * Complex(cosh(real) + sinh(real), 0) } var pretty: String { diff --git a/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-3.py b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-3.py index fb273a2545..bc445d27d1 100644 --- a/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-3.py +++ b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-3.py @@ -1,19 +1,19 @@ from itertools import islice, cycle -def fiblike(tail): - for x in tail: - yield x - for i in cycle(xrange(len(tail))): +def fiblike(init_values=(0, 1)): + tail = list(init_values) + yield from tail + for i in cycle(range(len(tail))): tail[i] = x = sum(tail) yield x -fibo = fiblike([1, 1]) -print list(islice(fibo, 10)) +print([*islice(fiblike(), 10)]) lucas = fiblike([2, 1]) -print list(islice(lucas, 10)) +print([*islice(lucas, 10)]) -suffixes = "fibo tribo tetra penta hexa hepta octo nona deca" -for n, name in zip(xrange(2, 11), suffixes.split()): - fib = fiblike([1] + [2 ** i for i in xrange(n - 1)]) +suffixes = dict(enumerate('fibo tribo tetra penta hexa hepta octo nona deca'.split(), start=2)) + +for name, n in suffixes.items(): + fib = fiblike([1] + [2 ** i for i in range(n-1)]) items = list(islice(fib, 15)) - print "n=%2i, %5snacci -> %s ..." % (n, name, items) + print(f'n={n:>2}, {name:>5}nacci -> {items} ...') diff --git a/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-5.py b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-5.py new file mode 100644 index 0000000000..d95bd55348 --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-5.py @@ -0,0 +1,34 @@ +from itertools import chain + +def A000032(): + '''Non finite sequence of Lucas numbers. + ''' + return unfoldr(recurrence, [0, 1]) + +def n_step_fibonacci(n): + '''Non-finite series of N-step Fibonacci numbers, + defined by a recurrence relation. + ''' + return unfoldr( + recurrence, + chain( + (0,), + (2 ** i for i in range(0, n-1)))) + +def recurrence(xs): + '''Recurrence relation in Fibonacci and related series. + ''' + h, *t = xs + return h, t + [sum(xs)] + +def unfoldr(f, residue): + '''Generic anamorphism. + A lazy (generator) list unfolded from a seed value by + repeated application of f until no residue remains. + Dual to fold/reduce. + f returns either None, or just (value, residue). + For a strict output value, wrap in list(). + ''' + while residue is not None: + value, residue = f(residue) + yield value diff --git a/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-6.py b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-6.py new file mode 100644 index 0000000000..0de67431c2 --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-6.py @@ -0,0 +1,46 @@ +from itertools import chain + +def f_rec_tailfail(values=[0, 1], combine=sum): + """ + This fails with `RecursionError: maximum recursion depth exceeded` + when the number of consumed elements surpasses maximum stack size + (by default 1000 call frames -- `sys.getrecursionlimit()`), + due to the fact that Python does not have tail call optimization. + """ + yield values[0] + yield from f_rec_tailfail(values[1:] + [combine(values)], combine) + + +def f_rec_gen_func(values=[0, 1], combine=sum): + """ + This function does not suffer from `RecursionError` per se, but stack overflow + nevertheless does happen in the underlying C code when too many elements are + consumed from the generator. + + One possible reason for this is because `chain` is implemented in C, + and the chain consists of another `chain` object, which in turn contains + another `chain` object, etc. The effect of this is that all the recursive + calls happen on the C call stack (where recursion depth is not checked + against the limit), not on the Python call stack. As a result, it is possible + to achieve much greater recursion depth -- over 40,000 recursive calls + instead of mere 1000. When a stack overflow eventually happens, the Python + interpreter crashes quietly without any error message (CPython 3.11.3 AMD64). + """ + def generate_values(): + yield [values[0]] + yield f_rec_gen_func(values[1:] + [combine(values)], combine) + return chain.from_iterable(generate_values()) + + +def f_rec_gen_lambdas(values=[0, 1], combine=sum): + """ + Similar to `f_rec_gen_func`; also does not suffer from `RecursionError` + but crashes when many values are consumed. + """ + return chain.from_iterable( + f() + for f in ( + lambda: [values[0]], + lambda: f_rec_gen_lambdas(values[1:] + [combine(values)], combine), + ) + ) diff --git a/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-7.py b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-7.py new file mode 100644 index 0000000000..7889a4ed7b --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/Python/fibonacci-n-step-number-sequences-7.py @@ -0,0 +1,35 @@ +from dataclasses import dataclass, field +from functools import wraps +from typing import Callable, Generator + +GeneratorFunc = Callable[..., Generator] + +@dataclass +class RecursiveCall: + args: tuple = () + kwargs: dict = field(default_factory=dict) + +def tail_recursive_generator(fun: GeneratorFunc) -> GeneratorFunc: + @wraps(fun) + def decorated(*args, **kwargs): + while True: + it = fun(*args, **kwargs) + try: + while True: + yield next(it) + except StopIteration as e: + if not isinstance(res := e.value, RecursiveCall): + return res + args, kwargs = res.args, res.kwargs + + return decorated + +@tail_recursive_generator +def f_rec_tail(values=(0, 1), combine=sum): + """ + Does not crash or throw RecursionError! Yay! + """ + yield values[0] + # determining why we cannot call `f_rec_tail` directly + # is left as an exercise for the reader... + return RecursiveCall(args=(values[1:] + (combine(values),), combine)) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-17.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-17.hs index 593d8551aa..a2360de226 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-17.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-17.hs @@ -1,35 +1,17 @@ -import Control.Arrow ((&&&)) +import Data.Ratio (numerator) -fibstep :: (Integer, Integer) -> (Integer, Integer) -fibstep (a, b) = (b, a + b) +infixl 7 *. +(*.) :: Num a => a -> [a] -> [a] +x *. (p:ps) = x*p : x*.ps -fibnums :: [Integer] -fibnums = map fst $ iterate fibstep (0, 1) +instance Num a => Num [a] where + negate = map negate + (+) = zipWith (+) + (*) (p:ps) (q:qs) = p*q : ((p*.qs) + ps*(q:qs)) + fromInteger n = fromInteger n:repeat 0 -fibN2 :: Integer -> (Integer, Integer) -fibN2 m - | m < 10 = iterate fibstep (0, 1) !! fromIntegral m -fibN2 m = fibN2_next (n, r) (fibN2 n) - where - (n, r) = quotRem m 3 +instance (Eq a, Fractional a) => Fractional [a] where + (/) (0:ps) (0:qs) = ps/qs + (/) (p:ps) (q:qs) = let r=p/q in r : (ps - r*.qs)/(q:qs) -fibN2_next (n, r) (f, g) - | r == 0 = (a, b) -- 3n ,3n+1 - | r == 1 = (b, c) -- 3n+1,3n+2 - | r == 2 = (c, d) -- 3n+2,3n+3 (*) - where - a = - 5 * f ^ 3 + - if even n - then 3 * f - else (-3 * f) -- 3n - b = g ^ 3 + 3 * g * f ^ 2 - f ^ 3 -- 3n+1 - c = g ^ 3 + 3 * g ^ 2 * f + f ^ 3 -- 3n+2 - d = - 5 * g ^ 3 + - if even n - then (-3 * g) - else 3 * g -- 3(n+1) (*) - -main :: IO () -main = print $ (length &&& take 20) . show . fst $ fibN2 (10 ^ 2) + fromRational q = fromRational q:repeat 0 diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-18.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-18.hs index c69d736bc9..4c4bac3a5c 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-18.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-18.hs @@ -1,2 +1,3 @@ - *Main> (length &&& take 20) . show . fst $ fibN2 (10^6) -(208988,"19532821287077577316") +fibs :: [Integer] +fibs = map numerator + (1/(1 : (-1) : (-1) : repeat 0)) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-19.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-19.hs index 7f0a39dbc2..b41a6a08fd 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-19.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-19.hs @@ -1 +1,2 @@ -f (n,(a,b)) = (2*n,(a*a+b*b,2*a*b+b*b)) -- iterate f (1,(0,1)) ; b is nth +ghci> take 15 fibs +[1,1,2,3,5,8,13,21,34,55,89,144,233,377,610] diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-20.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-20.hs index dd052ec7a3..ef2e13f1a0 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-20.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-20.hs @@ -1 +1,8 @@ -g (n,(a,b)) = (2*n,(2*a*b-a*a,a*a+b*b)) -- iterate g (1,(1,1)) ; a is nth +import Data.Functor.Identity (Identity (..)) + +fibs :: [Integer] +fibs = runIdentity (hsequence (repeat f)) + where f [] = Identity 1 + f [_] = Identity 1 + f xs = Identity ((xs !! (i-1)) + (xs !! i)) + where i = length xs-1 diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-21.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-21.hs new file mode 100644 index 0000000000..3152e83315 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-21.hs @@ -0,0 +1,6 @@ +hsequence :: Monad m => [[x] -> m x] -> m [x] +hsequence [] = pure [] +hsequence (r:rs) = do + x <- r [] + xs <- hsequence [ \ys -> g (x:ys) | g <- rs ] + pure (x:xs) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-22.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-22.hs new file mode 100644 index 0000000000..8340df8cb9 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-22.hs @@ -0,0 +1,2 @@ +ghci> take 17 fibs +[1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597] diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-23.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-23.hs new file mode 100644 index 0000000000..593d8551aa --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-23.hs @@ -0,0 +1,35 @@ +import Control.Arrow ((&&&)) + +fibstep :: (Integer, Integer) -> (Integer, Integer) +fibstep (a, b) = (b, a + b) + +fibnums :: [Integer] +fibnums = map fst $ iterate fibstep (0, 1) + +fibN2 :: Integer -> (Integer, Integer) +fibN2 m + | m < 10 = iterate fibstep (0, 1) !! fromIntegral m +fibN2 m = fibN2_next (n, r) (fibN2 n) + where + (n, r) = quotRem m 3 + +fibN2_next (n, r) (f, g) + | r == 0 = (a, b) -- 3n ,3n+1 + | r == 1 = (b, c) -- 3n+1,3n+2 + | r == 2 = (c, d) -- 3n+2,3n+3 (*) + where + a = + 5 * f ^ 3 + + if even n + then 3 * f + else (-3 * f) -- 3n + b = g ^ 3 + 3 * g * f ^ 2 - f ^ 3 -- 3n+1 + c = g ^ 3 + 3 * g ^ 2 * f + f ^ 3 -- 3n+2 + d = + 5 * g ^ 3 + + if even n + then (-3 * g) + else 3 * g -- 3(n+1) (*) + +main :: IO () +main = print $ (length &&& take 20) . show . fst $ fibN2 (10 ^ 2) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-24.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-24.hs new file mode 100644 index 0000000000..c69d736bc9 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-24.hs @@ -0,0 +1,2 @@ + *Main> (length &&& take 20) . show . fst $ fibN2 (10^6) +(208988,"19532821287077577316") diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-25.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-25.hs new file mode 100644 index 0000000000..7f0a39dbc2 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-25.hs @@ -0,0 +1 @@ +f (n,(a,b)) = (2*n,(a*a+b*b,2*a*b+b*b)) -- iterate f (1,(0,1)) ; b is nth diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-26.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-26.hs new file mode 100644 index 0000000000..dd052ec7a3 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-26.hs @@ -0,0 +1 @@ +g (n,(a,b)) = (2*n,(2*a*b-a*a,a*a+b*b)) -- iterate g (1,(1,1)) ; a is nth diff --git a/Task/Fibonacci-sequence/Langur/fibonacci-sequence.langur b/Task/Fibonacci-sequence/Langur/fibonacci-sequence.langur index 1eaa61b5f6..9db6f35cd7 100644 --- a/Task/Fibonacci-sequence/Langur/fibonacci-sequence.langur +++ b/Task/Fibonacci-sequence/Langur/fibonacci-sequence.langur @@ -1,3 +1,3 @@ val fibonacci = fn x:if(x < 2: x ; fn((x - 1)) + fn((x - 2))) -writeln map(fibonacci, series(2..20)) +writeln map(series(2..20), by=fibonacci) diff --git a/Task/Fibonacci-sequence/Python/fibonacci-sequence-14.py b/Task/Fibonacci-sequence/Python/fibonacci-sequence-14.py index 5e6109260b..9ef20e2594 100644 --- a/Task/Fibonacci-sequence/Python/fibonacci-sequence-14.py +++ b/Task/Fibonacci-sequence/Python/fibonacci-sequence-14.py @@ -1,8 +1,6 @@ '''Fibonacci accumulation''' -from itertools import accumulate, chain -from operator import add - +from itertools import accumulate # fibs :: Integer :: [Integer] def fibs(n): @@ -10,22 +8,16 @@ def fibs(n): the Fibonacci series. The accumulator is a pair of the two preceding numbers. ''' - def go(ab, _): - return ab[1], add(*ab) - - return [xy[1] for xy in accumulate( - chain( - [(0, 1)], - range(1, n) - ), - go - )] + return [ + a + for a, b in accumulate( + range(1, n), # we don't actually use these numbers + lambda acc, _: (acc[1], sum(acc)), + initial = (0, 1) + ) + ] # MAIN --- if __name__ == '__main__': - print( - 'First twenty: ' + repr( - fibs(20) - ) - ) + print(f'First twenty: {fibs(20)}') diff --git a/Task/Fibonacci-sequence/Python/fibonacci-sequence-15.py b/Task/Fibonacci-sequence/Python/fibonacci-sequence-15.py index 9da8f6a398..7cd4d0fa62 100644 --- a/Task/Fibonacci-sequence/Python/fibonacci-sequence-15.py +++ b/Task/Fibonacci-sequence/Python/fibonacci-sequence-15.py @@ -1,21 +1,18 @@ '''Nth Fibonacci term (by folding)''' from functools import reduce -from operator import add - # nthFib :: Integer -> Integer def nthFib(n): '''Nth integer in the Fibonacci series.''' - def go(ab, _): - return ab[1], add(*ab) - return reduce(go, range(1, n), (0, 1))[1] + return reduce( + lambda acc, _: (acc[1], sum(acc)), + range(1, n), + (0, 1) + )[0] # MAIN --- if __name__ == '__main__': - print( - '1000th term: ' + repr( - nthFib(1000) - ) - ) + n = 1000 + print(f'{n}th term: {nthFib(n)}') diff --git a/Task/Fibonacci-sequence/Python/fibonacci-sequence-18.py b/Task/Fibonacci-sequence/Python/fibonacci-sequence-18.py deleted file mode 100644 index 4f15e0818e..0000000000 --- a/Task/Fibonacci-sequence/Python/fibonacci-sequence-18.py +++ /dev/null @@ -1,7 +0,0 @@ -fi1=fi2=fi3=1 # FIB Russia rextester.com/FEEJ49204 -for da in range(1, 88): # Danilin - print("."*(20-len(str(fi3))), end=' ') - print(fi3) - fi3 = fi2+fi1 - fi1 = fi2 - fi2 = fi3 diff --git a/Task/Fibonacci-sequence/YAMLScript/fibonacci-sequence.ys b/Task/Fibonacci-sequence/YAMLScript/fibonacci-sequence.ys index d15ba93346..c3c49b69b6 100644 --- a/Task/Fibonacci-sequence/YAMLScript/fibonacci-sequence.ys +++ b/Task/Fibonacci-sequence/YAMLScript/fibonacci-sequence.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(n=10): loop a 0, b 1, i 1: diff --git a/Task/Fibonacci-word/Forth/fibonacci-word.fth b/Task/Fibonacci-word/Forth/fibonacci-word.fth new file mode 100644 index 0000000000..b5cf419abc --- /dev/null +++ b/Task/Fibonacci-word/Forth/fibonacci-word.fth @@ -0,0 +1,36 @@ +: .fibword ( n -- ) + dup case + 0 of drop ." 1" endof + 1 of drop ." 0" endof + dup 1- recurse + 2 - recurse + endcase ; + +fvariable ilog2 +1e 2e fln f/ ilog2 f! + +: flog2 ( r -- r ) + fdup f0<> if + fln ilog2 f@ f* + then ; + +: entropy ( n1 n2 -- r ) + 2dup + s>f s>f fover f/ fswap s>f fswap f/ + fdup flog2 f* fswap fdup flog2 f* f+ + fnegate ; + +: main + ." N Length Entropy Word" cr + 1 0 + 37 0 do + i 1+ 2 .r + 2dup + 10 .r space + 2dup entropy 17 15 1 f.rdp space + i 9 < if i .fibword else ." ..." then + cr + tuck + + loop + 2drop ; + +main +bye diff --git a/Task/Fibonacci-word/FutureBasic/fibonacci-word.basic b/Task/Fibonacci-word/FutureBasic/fibonacci-word.basic new file mode 100644 index 0000000000..c54549850e --- /dev/null +++ b/Task/Fibonacci-word/FutureBasic/fibonacci-word.basic @@ -0,0 +1,69 @@ +include "NSLog.incl" + +begin globals + CFStringRef cur, nex +end globals + + +CFStringRef local fn Increment + CFStringRef ret = cur + cur = nex + nex = fn StringWithFormat( @"%@%@", ret, nex ) +end fn = ret + +double local fn GetEntropy( s as CFArrayRef ) + double entropy = 0.0 + double hist(256) + NSUInteger i + + for i = 0 to 255 + hist(i)= 0 + next + + for CFNumberRef num in s + hist( fn NumberIntegerValue(num) ) += 1 + next + + for i = 0 to 255 + if ( hist(i) > 0 ) + double rat = hist(i) / fn ArrayCount( s ) + entropy -= rat * log2(rat) + end if + next + return entropy +end fn = 0.0 + +CFStringRef local fn ReverseString( string as CFStringRef ) + CFMutableStringRef reversedStr = fn MutableStringNew + for NSInteger i = len(string) - 1 to 0 step -1 + MutableStringAppendString( reversedStr, fn StringWithFormat( @"%c", fn StringCharacterAtIndex( string, i ) ) ) + next +end fn = reversedStr + +local fn DoIt + cur = @"1" + nex = @"0" + + NSLog( @"%5s %10s %11s %33s", "No.", "Length", "Entrophy", "Binary Fibonacci Word" ) + CFTimeInterval t = fn CACurrentMediaTime + for int i = 0 to 36 + CFStringRef string = fn Increment + CFMutableArrayRef asciiValues = fn MutableArrayNew + for NSUInteger j = 0 to len(string) - 1 + unichar character = fn StringCharacterAtIndex( string, j ) + MutableArrayAddObject( asciiValues, @(character) ) + next + double ent = fn GetEntropy( asciiValues ) + + if ( i <= 10 ) + NSLog( @"%3d. %9lu %19.15f %@", i+1, (unsigned long)len(string), ent, fn ReverseString( string ) ) + else + NSLog( @"%3d. %9lu %19.15f [length exceeds task limits]", i+1, (unsigned long)len(string), ent ) + end if + next + NSLog( @"\nCompute time: %.3f ms",(fn CACurrentMediaTime-t) * 1000 ) +end fn + +fn DoIt + +HandleEvents diff --git a/Task/File-input-output/Zig/file-input-output.zig b/Task/File-input-output/Zig/file-input-output.zig index 877fcc1dfb..8dac331546 100644 --- a/Task/File-input-output/Zig/file-input-output.zig +++ b/Task/File-input-output/Zig/file-input-output.zig @@ -1,20 +1,19 @@ const std = @import("std"); -pub fn main() (error{OutOfMemory} || std.fs.File.OpenError || std.fs.File.ReadError || std.fs.File.WriteError)!void { +pub fn main() !void { var gpa: std.heap.GeneralPurposeAllocator(.{}) = .{}; defer _ = gpa.deinit(); const allocator = gpa.allocator(); const cwd = std.fs.cwd(); - var input_file = try cwd.openFile("input.txt", .{ .mode = .read_only }); + var input_file = try cwd.openFile("input.txt", .{}); defer input_file.close(); var output_file = try cwd.createFile("output.txt", .{}); defer output_file.close(); - // Restrict input_file's size to "up to 10 MiB". - var input_file_content = try input_file.readToEndAlloc(allocator, 10 * 1024 * 1024); + const input_file_content = try input_file.readToEndAlloc(allocator, (try input_file.stat()).size); defer allocator.free(input_file_content); try output_file.writeAll(input_file_content); diff --git a/Task/Filter/Langur/filter.langur b/Task/Filter/Langur/filter.langur index 330dbc2ec2..de22c6a4a2 100644 --- a/Task/Filter/Langur/filter.langur +++ b/Task/Filter/Langur/filter.langur @@ -1,4 +1,4 @@ val zlist = series(7) writeln " list: ", zlist -writeln "filtered: ", filter(fn{div 2}, zlist) +writeln "filtered: ", filter(zlist, by=fn{div 2}) diff --git a/Task/Find-if-a-point-is-within-a-triangle/EasyLang/find-if-a-point-is-within-a-triangle.easy b/Task/Find-if-a-point-is-within-a-triangle/EasyLang/find-if-a-point-is-within-a-triangle.easy index da4b66fced..f57bc5c2a7 100644 --- a/Task/Find-if-a-point-is-within-a-triangle/EasyLang/find-if-a-point-is-within-a-triangle.easy +++ b/Task/Find-if-a-point-is-within-a-triangle/EasyLang/find-if-a-point-is-within-a-triangle.easy @@ -1,3 +1,10 @@ +ax = 10 +ay = 20 +bx = 90 +by = 30 +cx = 50 +cy = 80 +# func sgn px py ax ay bx by . return sign ((px - bx) * (ay - by) - (ax - bx) * (py - by)) . @@ -7,10 +14,6 @@ func isin px py ax ay bx by cx cy . z3 = sgn px py cx cy ax ay return if abs (z1 + z2 + z3) = 3 . -ax = 10 ; ay = 20 -bx = 90 ; by = 30 -cx = 50 ; cy = 80 -# move 5 90 textsize 4 text "Move mouse into the triangle" diff --git a/Task/Find-the-missing-permutation/FutureBasic/find-the-missing-permutation.basic b/Task/Find-the-missing-permutation/FutureBasic/find-the-missing-permutation.basic new file mode 100644 index 0000000000..a5bb1361ab --- /dev/null +++ b/Task/Find-the-missing-permutation/FutureBasic/find-the-missing-permutation.basic @@ -0,0 +1,31 @@ +void local fn Permute( string as CFStringRef, result as CFMutableArrayRef, current as CFStringRef ) + if ( len(string) == 0 ) then MutableArrayAddObject( result, current ) : return + for NSUInteger i = 0 to len(string) - 1 + unichar c = fn StringCharacterAtIndex( string, i ) + CFMutableStringRef remainingStr = fn MutableStringWithString( string ) + MutableStringDeleteCharacters( remainingStr, fn RangeMake( i, 1 ) ) + CFStringRef newCurrent = fn StringByAppendingFormat( current, @"%C", c ) + fn Permute( remainingStr, result, newCurrent ) + next +end fn + +local fn DoPermutations as CFStringRef + CFStringRef inputString = @"ABCD" + CFMutableArrayRef array1 = fn MutableArrayNew + fn Permute( inputString, array1, @"" ) + + CFArrayRef array2 = @[ + @"ABCD", @"CABD", @"ACDB", @"DACB", @"BCDA", @"ACBD", + @"ADCB", @"CDAB", @"DABC", @"BCAD", @"CADB", @"CDBA", + @"CBAD", @"ABDC", @"ADBC", @"BDCA", @"DCBA", @"BACD", + @"BADC", @"BDAC", @"CBDA", @"DBCA", @"DCAB"] + + CFMutableSetRef set1 = fn MutableSetWithArray( array1 ) + CFSetRef set2 = fn SetWithArray( array2 ) + MutableSetMinusSet( set1, set2 ) + return fn SetAnyObject( set1 ) +end fn = NULL + +printf @"%@", fn DoPermutations + +HandleEvents diff --git a/Task/First-class-functions-Use-numbers-analogously/Java/first-class-functions-use-numbers-analogously.java b/Task/First-class-functions-Use-numbers-analogously/Java/first-class-functions-use-numbers-analogously.java index 7b381dee6e..69c063ad4d 100644 --- a/Task/First-class-functions-Use-numbers-analogously/Java/first-class-functions-use-numbers-analogously.java +++ b/Task/First-class-functions-Use-numbers-analogously/Java/first-class-functions-use-numbers-analogously.java @@ -2,7 +2,7 @@ import java.util.List; import java.util.function.BiFunction; import java.util.function.Function; -public class FirstClassFunctionsUseNumbersAnalogously { +public final class FirstClassFunctionsUseNumbersAnalogously { public static void main(String[] args) { final double x = 2.0, xi = 0.5, diff --git a/Task/First-class-functions-Use-numbers-analogously/Quackery/first-class-functions-use-numbers-analogously.quackery b/Task/First-class-functions-Use-numbers-analogously/Quackery/first-class-functions-use-numbers-analogously.quackery new file mode 100644 index 0000000000..e477a97f20 --- /dev/null +++ b/Task/First-class-functions-Use-numbers-analogously/Quackery/first-class-functions-use-numbers-analogously.quackery @@ -0,0 +1,14 @@ + [ $ "bigrat.qky" loadfile ] now! + + [ 2 1 ] is x ( --> n/d ) + [ 1 2 ] is xi ( --> n/d ) + [ 4 1 ] is y ( --> n/d ) + [ 1 4 ] is yi ( --> n/d ) + [ x y v+ ] is z ( n/d n/d --> n/d ) + [ x y v+ 1/v ] is zi ( n/d n/d --> n/d ) + + [ ' [ v* v* ] join join ] is multiplier ( x n/d --> [ ) + +' xi ' [ 1 2 ] multiplier dup echo x rot do say " applied to x gives: " vulgar$ echo$ cr +' yi ' [ 1 2 ] multiplier dup echo y rot do say " applied to y gives: " vulgar$ echo$ cr +' zi ' [ 1 2 ] multiplier dup echo z rot do say " applied to z gives: " vulgar$ echo$ cr diff --git a/Task/Fivenum/EMal/fivenum.emal b/Task/Fivenum/EMal/fivenum.emal index bacb48ca7f..44415e8e61 100644 --- a/Task/Fivenum/EMal/fivenum.emal +++ b/Task/Fivenum/EMal/fivenum.emal @@ -2,7 +2,7 @@ type Fivenum int ILLEGAL_ARGUMENT = 0 fun median = real by List x, int start, int endInclusive int size = endInclusive - start + 1 - if size <= 0 do Event.error(ILLEGAL_ARGUMENT, "Array slice cannot be empty").raise() end + if size <= 0 do error(ILLEGAL_ARGUMENT, "Array slice cannot be empty") end int m = start + size / 2 return when(size % 2 == 1, x[m], (x[m - 1] + x[m]) / 2.0) end diff --git a/Task/Fixed-length-records/Jq/fixed-length-records.jq b/Task/Fixed-length-records/Jq/fixed-length-records.jq index 8f27c59448..aa773fce7d 100644 --- a/Task/Fixed-length-records/Jq/fixed-length-records.jq +++ b/Task/Fixed-length-records/Jq/fixed-length-records.jq @@ -1,4 +1,3 @@ -def cut($n): def nwise($n): def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end; n; diff --git a/Task/FizzBuzz/Nu/fizzbuzz-1.nu b/Task/FizzBuzz/Nu/fizzbuzz-1.nu new file mode 100644 index 0000000000..2ce6276c9d --- /dev/null +++ b/Task/FizzBuzz/Nu/fizzbuzz-1.nu @@ -0,0 +1,9 @@ +1..100 | each { + { x: $in, mod3: ($in mod 3), mod5: ($in mod 5), } + | match $in { + { mod3: 0, mod5: 0, } => 'FizzBuz', + { mod3: 0, mod5: _, } => 'Fizz', + { mod3: _, mod5: 0, } => 'Buzz', + _ => $in.x + } +} | str join "\n" diff --git a/Task/FizzBuzz/Nu/fizzbuzz-2.nu b/Task/FizzBuzz/Nu/fizzbuzz-2.nu new file mode 100644 index 0000000000..857bc7cdcb --- /dev/null +++ b/Task/FizzBuzz/Nu/fizzbuzz-2.nu @@ -0,0 +1,3 @@ +1..100 | each { + if $in mod 15 == 0 {'FizzBuzz'} else if $in mod 3 == 0 {'Fizz'} else if $in mod 5 == 0 {'Buzz'} else {$in} +} | str join "\n" diff --git a/Task/FizzBuzz/Nu/fizzbuzz-3.nu b/Task/FizzBuzz/Nu/fizzbuzz-3.nu new file mode 100644 index 0000000000..00f958a9c6 --- /dev/null +++ b/Task/FizzBuzz/Nu/fizzbuzz-3.nu @@ -0,0 +1,6 @@ +1..100 | each {( + if $in mod 15 == 0 {'FizzBuzz'} + else if $in mod 3 == 0 {'Fizz'} + else if $in mod 5 == 0 {'Buzz'} + else {$in} +)} | str join "\n" diff --git a/Task/FizzBuzz/Nu/fizzbuzz.nu b/Task/FizzBuzz/Nu/fizzbuzz-4.nu similarity index 100% rename from Task/FizzBuzz/Nu/fizzbuzz.nu rename to Task/FizzBuzz/Nu/fizzbuzz-4.nu diff --git a/Task/FizzBuzz/Retro/fizzbuzz-1.retro b/Task/FizzBuzz/Retro/fizzbuzz-1.retro deleted file mode 100644 index beb6d646a4..0000000000 --- a/Task/FizzBuzz/Retro/fizzbuzz-1.retro +++ /dev/null @@ -1,8 +0,0 @@ -: fizz? ( s-f ) 3 mod 0 = ; -: buzz? ( s-f ) 5 mod 0 = ; -: num? ( s-f ) dup fizz? swap buzz? or 0 = ; -: ?fizz ( s- ) fizz? [ "Fizz" puts ] ifTrue ; -: ?buzz ( s- ) buzz? [ "Buzz" puts ] ifTrue ; -: ?num ( s- ) num? &putn &drop if ; -: fizzbuzz ( s- ) dup ?fizz dup ?buzz dup ?num space ; -: all ( - ) 100 [ 1+ fizzbuzz ] iter ; diff --git a/Task/FizzBuzz/Retro/fizzbuzz-2.retro b/Task/FizzBuzz/Retro/fizzbuzz-2.retro deleted file mode 100644 index 5912fde82c..0000000000 --- a/Task/FizzBuzz/Retro/fizzbuzz-2.retro +++ /dev/null @@ -1,6 +0,0 @@ -needs math' -: - [ 15 ^math'divisor? ] [ drop "FizzBuzz" puts ] when - [ 3 ^math'divisor? ] [ drop "Fizz" puts ] when - [ 5 ^math'divisor? ] [ drop "Buzz" puts ] when putn ; -: fizzbuzz cr 100 [ 1+ space ] iter ; diff --git a/Task/FizzBuzz/Retro/fizzbuzz.retro b/Task/FizzBuzz/Retro/fizzbuzz.retro new file mode 100644 index 0000000000..0d0a9928be --- /dev/null +++ b/Task/FizzBuzz/Retro/fizzbuzz.retro @@ -0,0 +1,26 @@ +( empty string result to display result ) +~~~ + +'result var +' s:format !result + +'number var +#1 !number + +~~~ +( checks for empty string if result empty print number ) +( else append fizz for divisible by 3 and prepend buzz for divisible by 5) +( if; exists the word fizzbuzz immediately ) +~~~ + +:fizzbuzz (-) + @number #3 mod #0 eq? [ 'fizz @result s:append !result ] if + @number #5 mod #0 eq? [ 'buzz @result s:prepend !result ] if + ' @result s:eq? [ @number n:put nl ] if; + ' @result s:eq? not [ @result s:put nl ] if; + ; + +[ fizzbuzz 'result var + ' s:format !result @number #1 + !number @number #100 lteq? ] while + +~~~ diff --git a/Task/FizzBuzz/YAMLScript/fizzbuzz.ys b/Task/FizzBuzz/YAMLScript/fizzbuzz.ys index 7dbb165768..1021f2a5f0 100644 --- a/Task/FizzBuzz/YAMLScript/fizzbuzz.ys +++ b/Task/FizzBuzz/YAMLScript/fizzbuzz.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(n=100): each x (1 .. n): !:say diff --git a/Task/FizzBuzz/Zig/fizzbuzz.zig b/Task/FizzBuzz/Zig/fizzbuzz.zig index 6630d76864..d69633205d 100644 --- a/Task/FizzBuzz/Zig/fizzbuzz.zig +++ b/Task/FizzBuzz/Zig/fizzbuzz.zig @@ -1,7 +1,7 @@ const print = @import("std").debug.print; pub fn main() void { - var i: usize = 1; - while (i <= 100) : (i += 1) { + + for(1..101) |i| { if (i % 3 == 0 and i % 5 == 0) { print("FizzBuzz\n", .{}); } else if (i % 3 == 0) { diff --git a/Task/Flipping-bits-game/FutureBasic/flipping-bits-game.basic b/Task/Flipping-bits-game/FutureBasic/flipping-bits-game.basic new file mode 100644 index 0000000000..16581081a8 --- /dev/null +++ b/Task/Flipping-bits-game/FutureBasic/flipping-bits-game.basic @@ -0,0 +1,99 @@ +uint16 board( 9 ), goal( 9 ) +int size, count, mask +colorref hue( 1 ) +CFStringRef key +bool win + +local fn show + int x = 20, y = 20, row, col, v, t = size * 20 + 63 + text @"Courier", 17, fn ColorGray, fn colorClear + cls + printf@"\n GOAL" + print @( size * 2 + 8, 1 )"BOARD" + for row = 0 to size -1 + y = row * 20 + 40 + for col = 0 to size - 1 + v = ( goal( row ) & bit( col ) ) > 0 + x = col * 20 + 20 + rect fill ( x, y, 19, 19 ), hue( v ) + print %( x + 5, y - 2 ) v + x += t + v = ( board( row ) & bit( col ) ) > 0 + rect fill ( x, y, 19, 19 ), hue( v ) + print %( x + 5, y - 2 ) v + next + print %( x + 25, y - 2 ) mid( key, size + row, 1 ) + next + //print %( t + 15, y + 17 ) left( @" A B C D E F G H I J", size * 2 ) //Alternate + print %( t + 15, y + 17 ) left( @" Q W E R T Y U I O P", size * 2 ) + print %( size * 20 + 26, size * 10 + 20 )@"MOVES" + print %( t - 18, size * 10 + 40 )count +end fn + +local fn match as bool + for int r = 0 to size -1 + if board( r ) <> goal( r ) then return no + next +end fn = yes + +local fn move( k as int ) + select k + case >= size : board( k - size) ^^= mask //row + case >= 0 //column + for int r = 0 to size -1 + board( r ) ^^= bit( k ) + next + case else : exit fn + end select + DialogEventSetBool(YES) // we handled the event + count ++ + fn show +end fn + +local fn newGame + int r + for r = 0 to size -1 + board( r ) = rnd( mask ) -1 + next + fn memmove( @goal( 0 ), @board( 0 ), 20 ) + do + for r = 0 to size + fn move( rnd( size * 2 ) -1) + next + until !fn match + count = 0 + fn show +end fn + +local fn init( sz as int ) + if sz < 3 | sz > 10 then stop "Size param must be 3-10" : end + size = sz//:stop + mask = bit( size ) - 1 + hue( 0 ) = fn colorYellow + hue( 1 ) = fn colorcyan//Green + subclass window 1, @"Flipping bits puzzle", ( 0, 0, sz * 40 + 123, sz * 20 + 80 )¬ + , NSWindowStyleMaskTitled + NSWindowStyleMaskClosable + //key = fn StringWithFormat( @"Q%@%@", left( @"ABCDEFGHIJ", sz ), left( @"1234567890", sz ) ) //Alternate + key = fn StringWithFormat( @"%@%@", LEFT( @"QWERTYUIOP", sz ), left( @"1234567890", sz ) ) + fn newGame +end fn + +local fn doDialog( evt as long ) + select ( evt ) + case _windowKeyDown + if win then win = no : fn newGame : exit fn + fn move( instr( 0, key, fn EventCharacters, NSCaseInsensitiveSearch ) ) + if fn match + text ,,_zRed + print @(size*2 + 1, 0)"SOLVED!" + print %(20,size*20+50)"Any key for new game." + win = yes : beep + end if + case _windowWillClose : end + end select +end fn + +on dialog fn DoDialog +fn init( 3 ) +fn newGame +handleevents diff --git a/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys b/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys index d1619de731..b633b847da 100644 --- a/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys +++ b/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(n): nums =: range().map(inc).map(str) diff --git a/Task/Forest-fire/Locomotive-Basic/forest-fire-1.basic b/Task/Forest-fire/Locomotive-Basic/forest-fire-1.basic new file mode 100644 index 0000000000..0762b99f10 --- /dev/null +++ b/Task/Forest-fire/Locomotive-Basic/forest-fire-1.basic @@ -0,0 +1,33 @@ +10 randomize time:mode 1:ink 0,0:ink 1,9:ink 2,15:defint a-o,r-z +20 pfire=0.00002:ptree=0.002 +30 dimx=90:dimy=90 +40 dim forest(dimx,dimy), forest2(dimx,dimy) +50 for y=1 to dimy-1:for x=1 to dimx-1 +60 if rnd<.5 then forest(x,y)=1 +70 next:next +80 gosub 1000 +100 for y=1 to dimy-1 +110 for x=1 to dimx-1 +120 on forest(x,y)+1 gosub 500,600,700 +130 next:next +140 for y=1 to dimy-1 +150 for x=1 to dimx-1 +160 forest(x,y)=forest2(x,y) +170 next:next +180 gosub 1000 +190 goto 100 +500 if rnd 0 THEN + component +:= " " + power suffix[ power pos ] + FI; + IF result /= "" THEN component +:= " " FI; + component +=: result + FI; + power pos +:= 1; + v OVERAB 1000 + OD; + result + FI # NAME # ; + # returns the "x is y, y is z, ... four is magic" sequence derived from n # + OP MAGIC = ( NUMBER n )STRING: + BEGIN + NUMBER v := n; + STRING result := ""; + WHILE v /= 4 DO + IF result /= "" THEN result +:= ", " FI; + STRING v name = NAME v; + v := ( UPB v name - LWB v name ) + 1; + result +:= v name + " is " + NAME v + OD; + IF result /= "" THEN result +:= ", " FI; + result + "four is magic" + END # MAGIC # ; + # test cases # + []NUMBER t = ( 0, 1, 2, 3, 4, 5, 100, 101, 272, 1701, 1968, 4077, 90 210 + , - 100 001, 987 654, - NUMBER( 8 007 006 005 004 003 ) + ); + FOR n FROM LWB t TO UPB t DO + print( ( whole( t[ n ], -18 ), ": ", MAGIC t[ n ], newline ) ) + OD +END diff --git a/Task/Four-is-magic/Common-Lisp/four-is-magic.lisp b/Task/Four-is-magic/Common-Lisp/four-is-magic.lisp index d8fa958084..4f8ab2f47b 100644 --- a/Task/Four-is-magic/Common-Lisp/four-is-magic.lisp +++ b/Task/Four-is-magic/Common-Lisp/four-is-magic.lisp @@ -5,3 +5,6 @@ while (/= n 4) do (format out "~A is ~R, " c (length c)) finally (format out "four is magic."))))) +(loop for n + in '( -1 0 1 2 3 4 5 6 7 8 9 11 21 1995 1000000 1234567890 1100100100100 ) + do (print (integer-to-text n))) diff --git a/Task/Four-is-magic/M2000-Interpreter/four-is-magic.m2000 b/Task/Four-is-magic/M2000-Interpreter/four-is-magic.m2000 new file mode 100644 index 0000000000..08efda8634 --- /dev/null +++ b/Task/Four-is-magic/M2000-Interpreter/four-is-magic.m2000 @@ -0,0 +1,67 @@ +module Four_is_magic { + numname=lambda ->{ + flush + data "", "one", "two", "three", "four" + data "five", "six", "seven", "eight", "nine", "ten" + data "eleven", "twelve", "thirteen", "fourteen", "fifteen" + data "sixteen", "seventeen","eighteen", "nineteen" + dim lows(), tens(), lev() + lows()=array([]) + data "", "", "twenty", "thirty", "forty","fifty", "sixty" + data "seventy", "eighty", "ninety" + tens()=array([]) + lev()=("", "thousand", "million", "billion") + =lambda lows(), tens(), lev() (n as long) -> { + if n=0 then ="zero": exit + long i, tr : boolean t : string ret, prefix + if n < 0 then prefix= "negative ": n-! else prefix="" + while n>0 {push n mod 1000: n|div 1000} + t=stack.size>1 + while not empty { + tripn="" : read tr : if tr=0 then continue + lt= tr mod 100 : h= tr div 100 + if lt<20 then + tripn+=lows(lt) + else + tripn=tens(lt div 10)+if$(lt mod 10 >0 ->"-"+lows(lt mod 10),"") + end if + if h>0 then tripn = lows(h)+" hundred " + tripn + if empty then if t and h = 0 then tripn = " and " + tripn + ret+=tripn+" "+lev(stack.size)+" " + } + =prefix+trim$(ret) + } + }() + TitleStr=lambda (s as string) ->{ + =ucase$(left$(s,1))+mid$(s, 2) + } + magic=lambda numname, TitleStr (n as integer)-> { + first$=numname(n) + count$=numname(len(first$)) + while first$<>"four" + data first$+" is "+count$ + swap first$, count$ + count$=numname(len(first$)) + end while + data "four is magic." + =TitleStr(array([])#str$(", ")) + } + document doc$ + for i=0 to 9 + doc$ = magic(i)+{ + } + next + doc$ = magic(23)+{ + } + doc$ = magic(130)+{ + } + doc$ = magic(151)+{ + } + doc$ = magic(-7)+{ + } + doc$ = magic(20140)+{ + } + report doc$ + clipboard doc$ +} +Four_is_magic diff --git a/Task/Four-is-the-number-of-letters-in-the-.../FreeBASIC/four-is-the-number-of-letters-in-the-....basic b/Task/Four-is-the-number-of-letters-in-the-.../FreeBASIC/four-is-the-number-of-letters-in-the-....basic new file mode 100644 index 0000000000..4ed3cc24f9 --- /dev/null +++ b/Task/Four-is-the-number-of-letters-in-the-.../FreeBASIC/four-is-the-number-of-letters-in-the-....basic @@ -0,0 +1,173 @@ +#include "string.bi" + +Type NumberNames + cardinal As ZString Ptr + ordinal As ZString Ptr +End Type + +Type NamedNumber + cardinal As ZString Ptr + ordinal As ZString Ptr + number As Ulongint +End Type + +' Arrays of number names +Dim Shared small(0 To 19) As NumberNames = { _ +(@"zero", @"zeroth"), (@"one", @"first"), (@"two", @"second"), _ +(@"three", @"third"), (@"four", @"fourth"), (@"five", @"fifth"), _ +(@"six", @"sixth"), (@"seven", @"seventh"), (@"eight", @"eighth"), _ +(@"nine", @"ninth"), (@"ten", @"tenth"), (@"eleven", @"eleventh"), _ +(@"twelve", @"twelfth"), (@"thirteen", @"thirteenth"), _ +(@"fourteen", @"fourteenth"), (@"fifteen", @"fifteenth"), _ +(@"sixteen", @"sixteenth"), (@"seventeen", @"seventeenth"), _ +(@"eighteen", @"eighteenth"), (@"nineteen", @"nineteenth") } + +Dim Shared tens(0 To 7) As NumberNames = { _ +(@"twenty", @"twentieth"), (@"thirty", @"thirtieth"), _ +(@"forty", @"fortieth"), (@"fifty", @"fiftieth"), _ +(@"sixty", @"sixtieth"), (@"seventy", @"seventieth"), _ +(@"eighty", @"eightieth"), (@"ninety", @"ninetieth") } + +Dim Shared namedNumbers(0 To 6) As NamedNumber = { _ +(@"hundred", @"hundredth", 100ULL), _ +(@"thousand", @"thousandth", 1000ULL), _ +(@"million", @"millionth", 1000000ULL), _ +(@"billion", @"billionth", 1000000000ULL), _ +(@"trillion", @"trillionth", 1000000000000ULL), _ +(@"quadrillion", @"quadrillionth", 1000000000000000ULL), _ +(@"quintillion", @"quintillionth", 1000000000000000000ULL) } + +Function getName(n As NumberNames, ordinal As Boolean) As String + Return *Iif(ordinal, n.ordinal, n.cardinal) +End Function + +Function getNamedName(n As NamedNumber, ordinal As Boolean) As String + Return *Iif(ordinal, n.ordinal, n.cardinal) +End Function + +Function getNamedNumber(n As Ulongint) As NamedNumber + For i As Integer = 0 To 5 + If n < namedNumbers(i + 1).number Then Return namedNumbers(i) + Next + Return namedNumbers(6) +End Function + +Function isLetter(c As Integer) As Boolean + Return ((c >= 65 And c <= 90) Or (c >= 97 And c <= 122)) +End Function + +Function countLetters(s As String) As Integer + Dim cnt As Integer = 0 + For i As Integer = 1 To Len(s) + If isLetter(Asc(Mid(s, i, 1))) Then cnt += 1 + Next + Return cnt +End Function + +Sub appendNumberName(result As String Ptr, n As Ulongint, ordinal As Boolean, Byref resultCount As Integer) + Static As String tempStr + + If n < 20 Then + result[resultCount] = getName(small(n), ordinal) + resultCount += 1 + Elseif n < 100 Then + If (n Mod 10) = 0 Then + result[resultCount] = getName(tens(n\10 - 2), ordinal) + Else + tempStr = getName(tens(n\10 - 2), False) + tempStr &= "-" + tempStr &= getName(small(n Mod 10), ordinal) + result[resultCount] = tempStr + End If + resultCount += 1 + Else + Dim As NamedNumber num = getNamedNumber(n) + Dim As Ulongint p = num.number + appendNumberName(result, n\p, False, resultCount) + + If (n Mod p) = 0 Then + result[resultCount] = getNamedName(num, ordinal) + resultCount += 1 + Else + result[resultCount] = getNamedName(num, False) + resultCount += 1 + appendNumberName(result, n Mod p, ordinal, resultCount) + End If + End If +End Sub + +Function makeSentence(cnt As Integer, Byref resultSize As Integer) As String Ptr + Dim As Const String opening(0 To 12) = { _ + "Four", "is", "the", "number", "of", "letters", "in", "the", _ + "first", "word", "of", "this", "sentence," } + + Dim As String Ptr result = Callocate((cnt + 1) * Sizeof(String)) + resultSize = 0 + + ' Add opening words more efficiently + For i As Integer = 0 To 12 + If i = cnt Then Exit For + result[i] = opening(i) + Next + resultSize = Iif(cnt < 13, cnt, 13) + + ' Generate remaining words + Dim As Integer i = 1 + While resultSize < cnt + appendNumberName(result, countLetters(result[i]), False, resultSize) + If resultSize >= cnt Then Exit While + + result[resultSize] = "in" + result[resultSize + 1] = "the" + resultSize += 2 + If resultSize >= cnt Then Exit While + + appendNumberName(result, i + 1, True, resultSize) + result[resultSize - 1] += "," + i += 1 + Wend + + Return result +End Function + +' Main program +Dim As Integer n = 201 +Dim As Integer i, wordCount, totalLength +Dim As String Ptr words = makeSentence(n, wordCount) + +Print "The lengths of the first"; n; !" words are:\n" + +For i = 0 To n - 1 + If i Mod 25 = 0 Then Print Using "###: "; i + 1; + Print Using " ##"; countLetters(words[i]); + If (i + 1) Mod 25 = 0 Then Print +Next + +' Calculate sentence length more efficiently +totalLength = -1 ' Account for last space +For i = 0 To n - 1 + totalLength += Len(words[i]) + 1 ' Include space +Next + +Print !"\n\nLength of sentence = "; Format(totalLength, "#,###") +Deallocate(words) + +' Process larger numbers +n = 1000 +While n <= 10000000 + words = makeSentence(n, wordCount) + + ' Calculate sentence length + totalLength = -1 ' Start at -1 to account for last space + For i = 0 To n - 1 + totalLength += Len(words[i]) + 1 ' Add length plus space + Next + + Print !"\nThe length of word "; Format(n, "#,###"); " ["; words[n-1]; "] is "; countLetters(words[n-1]) + Print "Length of sentence = "; Format(totalLength, "#,###") + + Deallocate(words) + n *= 10 +Wend + +Sleep diff --git a/Task/Fractal-tree/Free-Pascal-Lazarus/fractal-tree.pas b/Task/Fractal-tree/Free-Pascal-Lazarus/fractal-tree.pas new file mode 100644 index 0000000000..ee20b18f8f --- /dev/null +++ b/Task/Fractal-tree/Free-Pascal-Lazarus/fractal-tree.pas @@ -0,0 +1,53 @@ +program FractalTree; + +uses + cthreads, // Required for multithreading on supported platforms + Math, PtcCrt, PtcGraph, SysUtils; + +const + TreeDepth = 17; // Maximum depth of the tree + +procedure DrawTree(X1, Y1: Integer; Angle: Double; Depth: Integer); +var + X2, Y2, Thickness: Integer; +begin + if Depth = 0 then + Exit; + + // Calculate the next point + X2 := Trunc(X1 + Cos(DegToRad(Angle)) * Depth * 6); + Y2 := Trunc(Y1 + Sin(DegToRad(Angle)) * Depth * 6); + + // Set the color based on depth + SetColor(986895 * Depth); + + // Dynamically calculate thickness (thicker at smaller depths) + Thickness := Max(1, Depth div 5); // Ensure thickness is at least 1 + SetLineStyle(0, 0, Thickness); + + // Draw the branch + Line(X1, Y1, X2, Y2); + + // Recursively draw the left and right branches + DrawTree(X2, Y2, Angle - 15, Depth - 1); + DrawTree(X2, Y2, Angle + 15, Depth - 1); +end; + +var + ModeInfo: PModeInfo; +begin + // Query and set the graphics mode for 1600x900 resolution with 24-bit color + ModeInfo := QueryAdapterInfo; + repeat + ModeInfo := ModeInfo^.Next; + until (ModeInfo^.MaxX = 1599) and (ModeInfo^.MaxY = 899) and (ModeInfo^.MaxColor = 16777216); + + InitGraph(ModeInfo^.DriverNumber, ModeInfo^.ModeNumber, ''); + + // Draw the fractal tree + DrawTree(ModeInfo^.MaxX div 2, ModeInfo^.MaxY, -90, TreeDepth); + + // Wait for user input before closing + ReadKey; + CloseGraph; +end. diff --git a/Task/Fractran/EasyLang/fractran.easy b/Task/Fractran/EasyLang/fractran.easy new file mode 100644 index 0000000000..5ee0b75bf6 --- /dev/null +++ b/Task/Fractran/EasyLang/fractran.easy @@ -0,0 +1,38 @@ +proc fractran prog$ val limit . r[] . + for s$ in strsplit prog$ " " : n[][] &= number strsplit s$ "/" + for n to limit + r[] &= val + for i to len n[][] + if val mod n[i][2] = 0 : break 1 + . + if i > len n[][] : break 1 + val = val / n[i][2] * n[i][1] + . +. +p$ = "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" +fractran p$ 2 15 r[] +print r[] +# +proc sort . d[] . + for i = 1 to len d[] - 1 + for j = i + 1 to len d[] + if d[j] < d[i] : swap d[j] d[i] + . + . +. +fractran p$ 2 1000 r[] +sort r[] +i = 1 +prim = 2 +po = 4 +repeat + repeat + if i > len r[] : break 2 + until i > len r[] or r[i] >= po + i += 1 + . + until i > len r[] + if r[i] = po : write prim & " " + prim += 1 + po *= 2 +. diff --git a/Task/Fractran/Julia/fractran.jl b/Task/Fractran/Julia/fractran.jl index a590a05890..7bd1303fe5 100644 --- a/Task/Fractran/Julia/fractran.jl +++ b/Task/Fractran/Julia/fractran.jl @@ -1,41 +1,29 @@ -# FRACTRAN interpreter implemented as an iterable struct +using Base.Iterators: filter, map, take +using Dates: now, seconds -using .Iterators: filter, map, take - -struct Fractran - rs::Vector{Rational{BigInt}} - i₀::BigInt - limit::Int +struct FRACTRAN + P::Vector{Rational{BigInt}} + i::BigInt end -Base.iterate(f::Fractran, i = f.i₀) = - for r in f.rs - if iszero(i % r.den) - i = i ÷ r.den * r.num - return i, i +# a new method for the builtin function 'iterate' to make the Fractran program run +Base.iterate(ft::FRACTRAN, n = ft.i) = + for f in ft.P + if iszero(n % f.den) + n = n ÷ f.den * f.num + return n, n end end -interpret(f::Fractran) = - take( - map(trailing_zeros, - filter(ispow2, f)) - f.limit) +"lazy generation of Fractran output sequence" +out(ft::FRACTRAN) = map(trailing_zeros, filter(ispow2, ft)) -Base.show(io::IO, f::Fractran) = - join(io, interpret(f), ' ') +"convenient Fractran scripting" +macro P_str(s) eval(Meta.parse(replace("[$s]", "/" => "//"))) end -macro code_str(s) - [eval(Meta.parse(replace(t, "/" => "//"))) for t ∈ split(s)] -end +primes = FRACTRAN(P"17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1", 2) -primes = Fractran(code"17/91 78/85 19/51 23/38 29/33 77/29 95/23 - 77/19 1/17 11/13 13/11 15/14 15/2 55/1", 2, 30) - -# Output -println("First 25 iterations of FRACTRAN program 'primes':\n2 ", - join(take(primes, 25), ' ')) - -println("\nWatch the first 30 primes dropping out within seconds:") - -primes +println("2, ", join(take(primes, 20), ", "), "...") +t = now() +join(stdout, take(out(primes), 25), ", ") +println("...\n25 primes in $(seconds(now() - t)) seconds") diff --git a/Task/Fractran/REXX/fractran-1.rexx b/Task/Fractran/REXX/fractran-1.rexx deleted file mode 100644 index 8572c8bd0b..0000000000 --- a/Task/Fractran/REXX/fractran-1.rexx +++ /dev/null @@ -1,28 +0,0 @@ -/*REXX program runs FRACTRAN for a given set of fractions and from a specified N. */ -numeric digits 2000 /*be able to handle larger numbers. */ -parse arg N terms fracs /*obtain optional arguments from the CL*/ -if N=='' | N=="," then N= 2 /*Not specified? Then use the default.*/ -if terms=='' | terms=="," then terms= 100 /* " " " " " " */ -if fracs='' then fracs= "17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23,", - '77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1' - /* [↑] The default for the fractions. */ -f= space(fracs, 0) /*remove all blanks from the FRACS list*/ - do #=1 while f\==''; parse var f n.# "/" d.# ',' f - end /*#*/ /* [↑] parse all the fractions in list*/ -#= # - 1 /*the number of fractions just found. */ -say # 'fractions:' fracs /*display number and actual fractions. */ -say 'N is starting at ' N /*display the starting number N. */ -say terms ' terms are being shown:' /*display a kind of header/title. */ - - do j=1 for terms /*perform the DO loop for each term. */ - do k=1 for # /* " " " " " " fraction*/ - if N // d.k \== 0 then iterate /*Not an integer? Then ignore it. */ - cN= commas(N); L= length(cN) /*maybe insert commas into N; get len.*/ - say right('term' commas(j), 44) "──► " right(cN, max(15, L)) /*show Nth term & N*/ - N= N % d.k * n.k /*calculate next term (use %≡integer ÷)*/ - leave /*go start calculating the next term. */ - end /*k*/ /* [↑] if an integer, we found a new N*/ - end /*j*/ -exit 0 /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -commas: parse arg ?; do jc=length(?)-3 to 1 by -3; ?=insert(',', ?, jc); end; return ? diff --git a/Task/Fractran/REXX/fractran-2.rexx b/Task/Fractran/REXX/fractran-2.rexx deleted file mode 100644 index a201c8471b..0000000000 --- a/Task/Fractran/REXX/fractran-2.rexx +++ /dev/null @@ -1,39 +0,0 @@ -/*REXX program runs FRACTRAN for a given set of fractions and from a specified N. */ -numeric digits 999; d= digits(); w= length(d) /*be able to handle gihugeic numbers. */ -parse arg N terms fracs /*obtain optional arguments from the CL*/ -if N=='' | N=="," then N= 2 /*Not specified? Then use the default.*/ -if terms=='' | terms=="," then terms= 100 /* " " " " " " */ -if fracs='' then fracs= "17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23,", - '77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1' - /* [↑] The default for the fractions. */ -f= space(fracs, 0) /*remove all blanks from the FRACS list*/ - do #=1 while f\==''; parse var f n.# "/" d.# ',' f - end /*#*/ /* [↑] parse all the fractions in list*/ -#= # - 1 /*adjust the number of fractions found.*/ -tell= terms>0 /*flag: show number or a power of 2.*/ -!.= 0; _= 1 /*the default value for powers of 2. */ -if \tell then do p=1 until length(_)>d; _= _ + _; !._= 1 - if p==1 then @._= left('', w + 9) "2**"left(p, w) ' ' - else @._= '(prime' right(p, w)") 2**"left(p, w) ' ' - end /*p*/ /* [↑] build powers of 2 tables. */ -L= length(N) /*length in decimal digits of integer N*/ -say # 'fractions:' fracs /*display number and actual fractions. */ -say 'N is starting at ' N /*display the starting number N. */ -if tell then say terms ' terms are being shown:' /*display header.*/ - else say 'only powers of two are being shown:' /* " " */ -@a= '(max digits used:' /*a literal used in the SAY below. */ - - do j=1 for abs(terms) /*perform DO loop once for each term. */ - do k=1 for # /* " " " " " " fraction*/ - if N // d.k \== 0 then iterate /*Not an integer? Then ignore it. */ - cN= commas(N); cj=commas(j) /*maybe insert commas into N. */ - if tell then say right('term' cj, 44) "──► " cN /*display Nth term and N.*/ - else if !.N then say right('term' cj,15) "──►" @.N @a right(L,w)") " cN - N= N % d.k * n.k /*calculate next term (use %≡integer ÷)*/ - L= max(L, length(N) ) /*the maximum number of decimal digits.*/ - leave /*go start calculating the next term. */ - end /*k*/ /* [↑] if an integer, we found a new N*/ - end /*j*/ -exit 0 /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -commas: parse arg ?; do jc=length(?)-3 to 1 by -3; ?=insert(',', ?, jc); end; return ? diff --git a/Task/Fractran/REXX/fractran-3.rexx b/Task/Fractran/REXX/fractran.rexx similarity index 95% rename from Task/Fractran/REXX/fractran-3.rexx rename to Task/Fractran/REXX/fractran.rexx index 1614a50f5c..43e2b0fd23 100644 --- a/Task/Fractran/REXX/fractran-3.rexx +++ b/Task/Fractran/REXX/fractran.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 \ Whole(n/d.j) then + if \ Integer(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 \ Whole(n/d.j) then + if \ Integer(n/d.j) then iterate j if p.n then do p = p+1 diff --git a/Task/Function-definition/YAMLScript/function-definition.ys b/Task/Function-definition/YAMLScript/function-definition.ys index 4024b595ec..7bab26ba31 100644 --- a/Task/Function-definition/YAMLScript/function-definition.ys +++ b/Task/Function-definition/YAMLScript/function-definition.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 # Main function definition with variable arguments: defn main(*args): diff --git a/Task/Function-definition/Zig/function-definition.zig b/Task/Function-definition/Zig/function-definition.zig index f67148e5cd..38dab3141a 100644 --- a/Task/Function-definition/Zig/function-definition.zig +++ b/Task/Function-definition/Zig/function-definition.zig @@ -1,4 +1,4 @@ -fun multiply(x: i64, y: i64) i64 { +fn multiply(x: i64, y: i64) i64 { return x * y; } diff --git a/Task/GUI-component-interaction/Forth/gui-component-interaction.fth b/Task/GUI-component-interaction/Forth/gui-component-interaction.fth new file mode 100644 index 0000000000..b25d56f2fa --- /dev/null +++ b/Task/GUI-component-interaction/Forth/gui-component-interaction.fth @@ -0,0 +1,91 @@ +\ The following is Forth code using iMops v2.23 +\ Tested on all MacOS from High Sierra to Sonoma +\ using Intel based systems. +\ This code can be used to create a stand-alone application + +: isdigit? ( char -- flag ) \ true if 0 thru 9, false otherwise + 48 58 within? ; + +: >uinteger { addr len \ dec accum -- n t | f } + len NIF exit THEN + 1 -> dec 0 -> accum + len 1+ 1 ?DO + addr len + i - c@ dup isdigit? + IF ( it's a digit 0 thru 9 ) + 48 - dec * accum + -> accum + dec 10 * -> dec + ELSE 2drop false unloop exit + THEN drop + LOOP accum true ; + +SYSCALL rand { -- int } + +:class TextView' super{ TextView } +:m put: ( addr len -- ) + 0 #ofChars: self SetSelect: self + insert: self ;m +;class + +Window+ w + View wview + Button incButton + 100 30 90 20 ( x0 y0 wid hi ) setFrame: incButton + Button randButton + 190 30 70 20 ( x0 y0 wid hi ) setFrame: randButton + TextView' val + 180 100 100 15 setFrame: val + FixedText valLabel + 110 98 80 18 setframe: valLabel + +Window+ okW + view okView + Button yesButton + 100 20 80 18 setframe: yesButton + Button cancelButton + 10 20 80 18 setframe: cancelButton + FixedText okText + 5 40 200 18 setframe: okText + +:noname + getText: val >uinteger + IF 1+ deciNumstr + ELSE " 0" + THEN put: val ; setAction: incButton + +:noname + show: okW ; setAction: randButton + +:noname + rand deciNumstr put: val + show: w ; setAction: yesButton + +:noname + getText: val >uinteger + NIF " 0" put: val + THEN show: w ; setAction: cancelButton + +: main + incButton addview: wview + randButton addview: wview + val addview: wview + valLabel addview: wview + " value:" SetText: valLabel + 300 30 430 230 put: frameRect + frameRect " GUI component interaction" docWindow + wview new: w show: w + " 0" put: val \ must be done after window is new: + " increment" setTitle: incButton + " random" setTitle: randButton + + yesButton addview: okView + cancelButton addview: okView + okText addview: okView + " Set value to random number?" SetText: okText + 310 40 200 60 put: frameRect + frameRect " " noCloseStyle + okView new: okW + " yes" setTitle: yesButton + " cancel" setTitle: cancelButton + ; + +main \ if creating installed app, startup word must be commented out diff --git a/Task/GUI-component-interaction/XPL0/gui-component-interaction.xpl0 b/Task/GUI-component-interaction/XPL0/gui-component-interaction.xpl0 new file mode 100644 index 0000000000..86292ba117 --- /dev/null +++ b/Task/GUI-component-interaction/XPL0/gui-component-interaction.xpl0 @@ -0,0 +1,147 @@ +\0123456789012345678901234567 template for display layout +\ Component interaction. X . main window +\ Value: 123456789_ . +\ [Increment] [Random] . +\ Confirm............... X . dialog pop-up +\ Set to a random value? +\ [ Yes ] [ No ] + +include xpllib; \for Ctrl key names, AtoI, ItoA and StrLen +def X0=22, Y0=10; \upper-left corner of main window's position +def X1=X0+21, Y1=Y0+5; \position of dialog pop-up (character cells) +int Mouse, Button, X, Y, Ch, I; \all variables are global for simplicity +def StrMax = 10; \max chars in String including underline +char String(StrMax); \Value string array +int StrInx; \index for character to be added to String + +proc ShowString; \Show Value String +[Attrib($F0); \set black on bright white +Cursor(13+X0, 2+Y0); \move to Value field position +for I:= 0 to StrInx-1 do ChOut(6, String(I)); +ChOut(6, ^_); \show cursor underline at end of String +for I:= StrInx+1 to StrMax-1 do ChOut(6, ^ ); \blank rest of line +]; + +func GetButton; \Return soft button number at mouse pointer +[Mouse:= GetMouse; +X:= Mouse(0)/8 - X0; \convert pixels to 8x16-pixel character cells +Y:= Mouse(1)/16 - Y0; +if X>=24 & X<=26 & Y=0 then return 0; \exit [X] +if X>= 3 & X<=13 & Y=4 then return 1; \Increment +if X>=17 & X<=24 & Y=4 then return 2; \Random +X:= Mouse(0)/8 - X1; \convert pixels to character cells for dialog +Y:= Mouse(1)/16 - Y1; +if X>=24 & X<=26 & Y=0 then return 3; \exit [X] +if X>= 3 & X<=11 & Y=4 then return 4; \Yes +if X>=16 & X<=24 & Y=4 then return 5; \No +return -1; \mouse is not on any soft button +]; + +proc DoDialog; \Do pop-up dialog for further information +[Attrib($70); \set black-on-gray color attribute +SetWind(0+X1, 0+Y1, 27+X1, 5+Y1, 0, \fill\true); \draw gray rectangle +Cursor(25+X1, 0+Y1); ChOut(6, ^X); \draw exit button +Cursor( 3+X1, 2+Y1); Text(6, "Set to a random value?"); +Attrib($80); \set black on dark gray for buttons +Cursor( 3+X1, 4+Y1); Text(6, " Yes "); +Cursor(16+X1, 4+Y1); Text(6, " No "); +Attrib($9F); \set bright white on light blue, for title bar +Cursor(0+X1, 0+Y1); Text(6, " Confirm "); +ShowMouse(true); \turn on mouse pointer +loop [MoveMouse; \make pointer track mouse movements + Mouse:= GetMouse; + if Mouse(2) then \a left or right mouse button is down + [Button:= GetButton; \get soft button at mouse pointer + while Mouse(2) do \wait for mouse button to be released + [MoveMouse; + Mouse:= GetMouse; + ]; + if Button = GetButton then \if down Button = release button + [if Button = 3 then InsertKey(Esc); \insert into keyboard buffer + if Button = 4 then InsertKey(^y); + if Button = 5 then InsertKey(^n); + ]; + ]; + if KeyHit then \key is hit or was inserted in KB buffer + [Ch:= ChIn(1); \get character from non-echoed keyboard + if Ch=^y or Ch=^Y then \set Value to random number + [I:= Ran(1_000_000_000); + ItoA(I, String); + StrInx:= StrLen(String); + quit; + ] + else if Ch=^n or Ch=^N or Ch=Esc then quit; + ]; + ]; \loop +]; + +proc DoMain; \Do main window interaction +[ShowMouse(true); \turn on mouse pointer +loop [MoveMouse; \make pointer track mouse movements + Mouse:= GetMouse; + if Mouse(2) then \a left or right mouse button is down + [Button:= GetButton; \get soft button at mouse pointer + while Mouse(2) do \wait for mouse button to be released + [MoveMouse; + Mouse:= GetMouse; + ]; + if Button = GetButton then \if down Button = release button + [if Button = 0 then InsertKey(Esc); \insert into keyboard buffer + if Button = 1 then InsertKey(^i); + if Button = 2 then InsertKey(^r); + ]; + ]; + if KeyHit then \key is hit or was inserted in KB buffer + [ShowMouse(false); \don't draw on top of mouse pointer + Ch:= ChIn(1); \get character from non-echoed keyboard + if Ch>=$30 & Ch<=$39 then \only allow numeric digits for Value + [if StrInx < StrMax-1 then \limit number of digits added + [String(StrInx):= Ch; + StrInx:= StrInx+1; + \handle leading zeros - convert number to its canonical form + String(StrInx):= 0; \append string terminator for AtoI + I:= AtoI(String); \convert numeric String to an integer + ItoA(I, String); \convert binary integer back to String + StrInx:= StrLen(String); \String could have gotten shorter + ]; + ] + else if Ch = BS then \(backspace) delete back a character + [if StrInx > 0 then StrInx:= StrInx-1] + else if Ch=^i or Ch=^I then \increment Value + [String(StrInx):= 0; \append terminator for AtoI + I:= AtoI(String); + ItoA(I+1, String); + StrInx:= StrLen(String); \String could have gotten longer + if StrInx > StrMax-1 then \roll all 9's to zero + [String(0):= ^0; StrInx:= 1]; + ] + else if Ch=^r or Ch=^R then \random Value - go do dialog pop-up + quit + else if Ch = Esc then + [SetVid(3); exit]; \restore normal text mode before exiting + ShowString; + ShowMouse(true); + ]; + ]; \loop +]; + +[SetVid($12); \set 640x480 graphics mode display +TrapC(true); \prevent Ctrl+C from aborting the program +String(0):= ^0; \initialize Value String to zero +StrInx:= 1; +loop [Attrib($70); \set black-on-gray color attribute + SetWind(0+X0, 0+Y0, 27+X0, 5+Y0, 0, \fill\true); \draw gray rectangle + Cursor(25+X0, 0+Y0); ChOut(6, ^X); \draw exit button + Cursor( 4+X0, 2+Y0); Text(6, "Value:"); + Attrib($80); \set black on dark gray for buttons + Cursor( 3+X0, 4+Y0); Text(6, " Increment "); + Cursor(17+X0, 4+Y0); Text(6, " Random "); + Attrib($9F); \set bright white on light blue for title bar + Cursor(0+X0, 0+Y0); Text(6, " Component interaction "); + ShowString; + DoMain; + DoDialog; + ShowMouse(false); \don't overwrite mouse pointer (with Clear) + Clear; \remove pop-up dialog + ]; \loop back to redraw main window +] diff --git a/Task/Gamma-function/EMal/gamma-function.emal b/Task/Gamma-function/EMal/gamma-function.emal new file mode 100644 index 0000000000..b97e5e94c7 --- /dev/null +++ b/Task/Gamma-function/EMal/gamma-function.emal @@ -0,0 +1,19 @@ +fun stirling ← 9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return g/1 diff --git a/Task/Gamma-function/REXX/gamma-function-3.rexx b/Task/Gamma-function/REXX/gamma-function-3.rexx deleted file mode 100644 index 37ad3facc1..0000000000 --- a/Task/Gamma-function/REXX/gamma-function-3.rexx +++ /dev/null @@ -1,175 +0,0 @@ -include Settings - -say version; say 'Gamma'; say -arg n; if n = '' then n = 100; numeric digits n -say '(Half)integers formulas' -w = '-99.5 -10.5 -5.5 -2.5 -1.5 -0.5 0.5 1 1.5 2 2.5 5 5.5 10 10.5 99 99.5' -numeric digits n -do i = 1 to Words(w) - x = Word(w,i); call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) - say 'Formulas' Format(x,4,1) r '('e 'seconds)' -end -say -say 'Lanczos (max 60 decimals) vs Spouge (no limit) vs Stirling (no limit) approximation' -w = '-12.8 -6.4 -3.2 -1.6 -0.8 -0.4 -0.2 -0.1 0.1 0.2 0.4 0.8 1.6 3.2 6.4 12.8' -do i = 1 to Words(w) - x = Word(w,i) - numeric digits Min(60,n) - call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) - say 'Lanczos ' Format(x,4,1) r '('e 'seconds)' - numeric digits n - call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) - say 'Spouge ' Format(x,4,1) r '('e 'seconds)' - if x > 0 then do - call Time('r'); r = Stirling(x); e = Format(Time('e'),,3) - say 'Stirling' Format(x,4,1) r '('e 'seconds)' - end -end -say -say 'Same for a bigger number' -w = '-99.9 99.9' -do i = 1 to Words(w) - x = Word(w,i) - numeric digits Min(60,n) - call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) - say 'Lanczos ' Format(x,4,1) r '('e 'seconds)' - numeric digits n - call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) - say 'Spouge ' Format(x,4,1) r '('e 'seconds)' - if x > 0 then do - call Time('r'); r = Stirling(x); e = Format(Time('e'),,3) - say 'Stirling' Format(x,4,1) r '('e 'seconds)' - end -end -exit - -Gamma: -/* Gamma */ -procedure expose glob. fact. -arg x -/* Formulas for negative and positive (half)integers */ -if x < 0 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 - return y+0 - end -end -if x > 0 then do - if Whole(x) then - return Fact(x-1) - 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 - return y+0 - end -end -p = Digits() -if p < 61 then do -/* Lanczos with predefined coefficients */ -/* Map negative x to positive x */ - if x < 0 then - return Pi()/(Gamma(1-x)*Sin(Pi()*x)) -/* Argument reduction to interval (0.5,1.5) */ - numeric digits p+2 - c = Trunc(x); x = x-c - if x < 0.5 then do - x = x+1; c = c-1 - end -/* Series coefficients 1/Gamma(x) in 80 digits Fransen & Wrigge */ - c.1 = 1.00000000000000000000000000000000000000000000000000000000000000000000000000000000 - c.2 = 0.57721566490153286060651209008240243104215933593992359880576723488486772677766467 - c.3 = -0.65587807152025388107701951514539048127976638047858434729236244568387083835372210 - c.4 = -0.04200263503409523552900393487542981871139450040110609352206581297618009687597599 - c.5 = 0.16653861138229148950170079510210523571778150224717434057046890317899386605647425 - c.6 = -0.04219773455554433674820830128918739130165268418982248637691887327545901118558900 - c.7 = -0.00962197152787697356211492167234819897536294225211300210513886262731167351446074 - c.8 = 0.00721894324666309954239501034044657270990480088023831800109478117362259497415854 - c.9 = -0.00116516759185906511211397108401838866680933379538405744340750527562002584816653 - c.10 = -0.00021524167411495097281572996305364780647824192337833875035026748908563946371678 - c.11 = 0.00012805028238811618615319862632816432339489209969367721490054583804120355204347 - c.12 = -0.00002013485478078823865568939142102181838229483329797911526116267090822918618897 - c.13 = -0.00000125049348214267065734535947383309224232265562115395981534992315749121245561 - c.14 = 0.00000113302723198169588237412962033074494332400483862107565429550539546040842730 - c.15 = -0.00000020563384169776071034501541300205728365125790262933794534683172533245680371 - c.16 = 0.00000000611609510448141581786249868285534286727586571971232086732402927723507435 - c.17 = 0.00000000500200764446922293005566504805999130304461274249448171895337887737472132 - c.18 = -0.00000000118127457048702014458812656543650557773875950493258759096189263169643391 - c.19 = 0.00000000010434267116911005104915403323122501914007098231258121210871073927347588 - c.20 = 0.00000000000778226343990507125404993731136077722606808618139293881943550732692987 - c.21 = -0.00000000000369680561864220570818781587808576623657096345136099513648454655443000 - c.22 = 0.00000000000051003702874544759790154813228632318027268860697076321173501048565735 - c.23 = -0.00000000000002058326053566506783222429544855237419746091080810147188058196444349 - c.24 = -0.00000000000000534812253942301798237001731872793994898971547812068211168095493211 - c.25 = 0.00000000000000122677862823826079015889384662242242816545575045632136601135999606 - c.26 = -0.00000000000000011812593016974587695137645868422978312115572918048478798375081233 - c.27 = 0.00000000000000000118669225475160033257977724292867407108849407966482711074006109 - c.28 = 0.00000000000000000141238065531803178155580394756670903708635075033452562564122263 - c.29 = -0.00000000000000000022987456844353702065924785806336992602845059314190367014889830 - c.30 = 0.00000000000000000001714406321927337433383963370267257066812656062517433174649858 - c.31 = 0.00000000000000000000013373517304936931148647813951222680228750594717618947898583 - c.32 = -0.00000000000000000000020542335517666727893250253513557337960820379352387364127301 - c.33 = 0.00000000000000000000002736030048607999844831509904330982014865311695836363370165 - c.34 = -0.00000000000000000000000173235644591051663905742845156477979906974910879499841377 - c.35 = -0.00000000000000000000000002360619024499287287343450735427531007926413552145370486 - c.36 = 0.00000000000000000000000001864982941717294430718413161878666898945868429073668232 - c.37 = -0.00000000000000000000000000221809562420719720439971691362686037973177950067567580 - c.38 = 0.00000000000000000000000000012977819749479936688244144863305941656194998646391332 - c.39 = 0.00000000000000000000000000000118069747496652840622274541550997151855968463784158 - c.40 = -0.00000000000000000000000000000112458434927708809029365467426143951211941179558301 - c.41 = 0.00000000000000000000000000000012770851751408662039902066777511246477487720656005 - c.42 = -0.00000000000000000000000000000000739145116961514082346128933010855282371056899245 - c.43 = 0.00000000000000000000000000000000001134750257554215760954165259469306393008612196 - c.44 = 0.00000000000000000000000000000000004639134641058722029944804907952228463057968680 - c.45 = -0.00000000000000000000000000000000000534733681843919887507741819670989332090488591 - c.46 = 0.00000000000000000000000000000000000032079959236133526228612372790827943910901464 - c.47 = -0.00000000000000000000000000000000000000444582973655075688210159035212464363740144 - c.48 = -0.00000000000000000000000000000000000000131117451888198871290105849438992219023663 - c.49 = 0.00000000000000000000000000000000000000016470333525438138868182593279063941453996 - c.50 = -0.00000000000000000000000000000000000000001056233178503581218600561071538285049997 - c.51 = 0.00000000000000000000000000000000000000000026784429826430494783549630718908519485 - c.52 = 0.00000000000000000000000000000000000000000002424715494851782689673032938370921241 -/* Series expansion */ - x = x-1; s = 0 - do k = 52 by -1 to 1 - s = s*x+c.k - end - y = 1/s -/* Undo reduction */ - if c = -1 then - y = y/x - else do - do i = 1 to c - y = (x+i)*y - end - end -end -else do - x = x-1 -/* Spouge */ -/* Estimate digits and iterations */ - q = Floor(p*1.5); a = Floor(p*1.3) - numeric digits q -/* Series */ - s = 0 - do k = 1 to a-1 - s = s+((-1)**(k-1)*Power(a-k,k-0.5)*Exp(a-k))/(Fact(k-1)*(x+k)) - end - s = s+Sqrt(2*Pi()); y = Power(x+a,x+0.5)*Exp(-a-x)*s -end -/* Normalize */ -numeric digits p -return y+0 - -Stirling: -/* Sterling */ -procedure expose glob. fact. -arg x -return Sqrt(2*Pi()/x) * Power(x/e(),x) - -include Constants -include Functions -include Numbers -include Abend diff --git a/Task/Gamma-function/REXX/gamma-function.rexx b/Task/Gamma-function/REXX/gamma-function.rexx new file mode 100644 index 0000000000..9b91fe493d --- /dev/null +++ b/Task/Gamma-function/REXX/gamma-function.rexx @@ -0,0 +1,55 @@ +include Settings + +say version; say 'Gamma'; say +arg n; if n = '' then n = 100; numeric digits n +say '(Half)integers formulas' +w = '-99.5 -10.5 -5.5 -2.5 -1.5 -0.5 0.5 1 1.5 2 2.5 5 5.5 10 10.5 99 99.5' +numeric digits n +do i = 1 to Words(w) + x = Word(w,i); call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) + say 'Formulas' Format(x,4,1) r '('e 'seconds)' +end +say +say 'Lanczos (max 60 decimals) vs Spouge (no limit) vs Stirling (no limit) approximation' +w = '-12.8 -6.4 -3.2 -1.6 -0.8 -0.4 -0.2 -0.1 0.1 0.2 0.4 0.8 1.6 3.2 6.4 12.8' +do i = 1 to Words(w) + x = Word(w,i) + numeric digits Min(60,n) + call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) + say 'Lanczos ' Format(x,4,1) r '('e 'seconds)' + numeric digits n + call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) + say 'Spouge ' Format(x,4,1) r '('e 'seconds)' + if x > 0 then do + call Time('r'); r = Stirling(x); e = Format(Time('e'),,3) + say 'Stirling' Format(x,4,1) r '('e 'seconds)' + end +end +say +say 'Same for a bigger number' +w = '-99.9 99.9' +do i = 1 to Words(w) + x = Word(w,i) + numeric digits Min(60,n) + call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) + say 'Lanczos ' Format(x,4,1) r '('e 'seconds)' + numeric digits n + call Time('r'); r = Gamma(x); e = Format(Time('e'),,3) + say 'Spouge ' Format(x,4,1) r '('e 'seconds)' + if x > 0 then do + call Time('r'); r = Stirling(x); e = Format(Time('e'),,3) + say 'Stirling' Format(x,4,1) r '('e 'seconds)' + end +end +exit + +Stirling: +/* Sterling */ +procedure expose glob. fact. +arg x +return Sqrt(2*Pi()/x) * Power(x/e(),x) + +include Constants +include Functions +include Numbers +include Abend diff --git a/Task/Gaussian-elimination/PascalABC.NET/gaussian-elimination.pas b/Task/Gaussian-elimination/PascalABC.NET/gaussian-elimination.pas new file mode 100644 index 0000000000..e6f257930e --- /dev/null +++ b/Task/Gaussian-elimination/PascalABC.NET/gaussian-elimination.pas @@ -0,0 +1,16 @@ +uses NumLibABC; + +begin + var A := new real[6, 6] ((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)); + + var b := new real[6] (-0.01, 0.61, 0.91, 0.99, 0.60, 0.02); + + var oL := new Decomp(A); + oL.Solve(b); + b.Println; +end. diff --git a/Task/Generate-Chess960-starting-position/Chipmunk-Basic/generate-chess960-starting-position.basic b/Task/Generate-Chess960-starting-position/Chipmunk-Basic/generate-chess960-starting-position.basic new file mode 100644 index 0000000000..35d08c975c --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Chipmunk-Basic/generate-chess960-starting-position.basic @@ -0,0 +1,15 @@ +100 randomize timer +110 for i = 1 to 10 +120 inicio$ = "RKR" +130 pieza$ = "QNN" +140 for n = 1 to len(pieza$) +150 posic = int(rnd(len(inicio$)+1))+1 +160 inicio$ = left$(inicio$,posic-1)+mid$(pieza$,n,1)+right$(inicio$,len(inicio$)-posic+1) +170 next n +180 posic = int(rnd(len(inicio$)+1))+1 +190 inicio$ = left$(inicio$,posic-1)+"B"+right$(inicio$,len(inicio$)-posic+1) +200 posic = posic+1+2*int(int(rnd(len(inicio$)-posic))/2) +210 inicio$ = left$(inicio$,posic-1)+"B"+right$(inicio$,len(inicio$)-posic+1) +220 print inicio$ +230 next i +240 end diff --git a/Task/Generate-Chess960-starting-position/EasyLang/generate-chess960-starting-position.easy b/Task/Generate-Chess960-starting-position/EasyLang/generate-chess960-starting-position.easy index 2c6c527052..80dca8ffad 100644 --- a/Task/Generate-Chess960-starting-position/EasyLang/generate-chess960-starting-position.easy +++ b/Task/Generate-Chess960-starting-position/EasyLang/generate-chess960-starting-position.easy @@ -18,4 +18,4 @@ repeat randins "Q" 1 8 b1 randins "N" 1 8 b1 randins "N" 1 8 b1 -print strjoin t$[] +print strjoin t$[] "" diff --git a/Task/Generate-Chess960-starting-position/FreeBASIC/generate-chess960-starting-position.basic b/Task/Generate-Chess960-starting-position/FreeBASIC/generate-chess960-starting-position.basic index 4121b4fe91..ec27d49e50 100644 --- a/Task/Generate-Chess960-starting-position/FreeBASIC/generate-chess960-starting-position.basic +++ b/Task/Generate-Chess960-starting-position/FreeBASIC/generate-chess960-starting-position.basic @@ -9,9 +9,12 @@ For i As Byte = 1 To 10 Mid(pieza, n, 1) +_ Right(inicio, Len(inicio) - posic + 1) Next n + posic = Int(Rnd*(Len(inicio) + 1)) + 1 inicio = Left(inicio, posic-1) + "B" + Right(inicio, Len(inicio) - posic + 1) - posic = posic + 1 + 2 * Int(Int(Rnd*(Len(inicio) - posic)) / 2) + + posic += 1 + 2 * (Int(Rnd*(Len(inicio) - posic)) \ 2) inicio = Left(inicio, posic-1) + "B" + Right(inicio, Len(inicio) - posic + 1) + Print inicio Next i diff --git a/Task/Generate-Chess960-starting-position/Gambas/generate-chess960-starting-position.gambas b/Task/Generate-Chess960-starting-position/Gambas/generate-chess960-starting-position.gambas new file mode 100644 index 0000000000..bd592b61f9 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Gambas/generate-chess960-starting-position.gambas @@ -0,0 +1,21 @@ +Public Sub Main() + + Randomize + + For i As Integer = 1 To 10 + Dim inicio As String = "RKR" + Dim pieza As String = "QNN" + Dim posic As Integer + + For n As Integer = 1 To Len(pieza) + posic = Int(Rnd * (Len(inicio) + 1)) + 1 + inicio = Left(inicio, posic - 1) & Mid(pieza, n, 1) & Right(inicio, Len(inicio) - posic + 1) + Next + posic = Int(Rnd * (Len(inicio) + 1)) + 1 + inicio = Left(inicio, posic - 1) & "B" & Right(inicio, Len(inicio) - posic + 1) + posic += 1 + 2 * Int(Int(Rnd * (Len(inicio) - posic)) / 2) + inicio = Left(inicio, posic - 1) & "B" & Right(inicio, Len(inicio) - posic + 1) + Print inicio + Next + +End diff --git a/Task/Generate-Chess960-starting-position/PascalABC.NET/generate-chess960-starting-position.pas b/Task/Generate-Chess960-starting-position/PascalABC.NET/generate-chess960-starting-position.pas new file mode 100644 index 0000000000..b45cbcaded --- /dev/null +++ b/Task/Generate-Chess960-starting-position/PascalABC.NET/generate-chess960-starting-position.pas @@ -0,0 +1,15 @@ +## +function random960: string; +begin + var start := 'RKR'; + + foreach var piece in 'QNN' do + Insert(piece, start, Random(start.length + 1) + 1); + + var bishpos := Random(start.length + 1) + 1; + Insert('B', start, bishpos); + Insert('B', start, Range(bishpos + 1, start.Length + 1, 2).ToArray.RandomElement); + result := start; +end; + +random960.Println; diff --git a/Task/Generate-Chess960-starting-position/PureBasic/generate-chess960-starting-position.basic b/Task/Generate-Chess960-starting-position/PureBasic/generate-chess960-starting-position.basic new file mode 100644 index 0000000000..3a41d96d22 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/PureBasic/generate-chess960-starting-position.basic @@ -0,0 +1,21 @@ +OpenConsole() +RandomSeed(Date()) +For i = 1 To 10 + inicio.s = "RKR" + pieza.s = "QNN" + + For n = 1 To Len(pieza) + posic = Random(Len(inicio)) + 1 + inicio = Left(inicio, posic - 1) + Mid(pieza, n, 1) + Right(inicio, Len(inicio) - posic + 1) + Next n + + posic = Random(Len(inicio)) + 1 + inicio = Left(inicio, posic - 1) + "B" + Right(inicio, Len(inicio) - posic + 1) + posic + 1 + 2 * Int(Random(Len(inicio) - posic) / 2) + inicio = Left(inicio, posic - 1) + "B" + Right(inicio, Len(inicio) - posic + 1) + + PrintN(inicio) +Next i + +PrintN(#CRLF$ + "Press ENTER to exit"): Input() +CloseConsole() diff --git a/Task/Generate-Chess960-starting-position/QBasic/generate-chess960-starting-position.basic b/Task/Generate-Chess960-starting-position/QBasic/generate-chess960-starting-position.basic index 004f9491ad..aa667deeb1 100644 --- a/Task/Generate-Chess960-starting-position/QBasic/generate-chess960-starting-position.basic +++ b/Task/Generate-Chess960-starting-position/QBasic/generate-chess960-starting-position.basic @@ -1,9 +1,8 @@ -RANDOMIZE TIMER +RANDOMIZE TIMER ' DELETE for Run BASIC, Just Basic & Liberty BASIC FOR i = 1 TO 10 inicio$ = "RKR" pieza$ = "QNN" - 'Dim posic FOR n = 1 TO LEN(pieza$) posic = INT(RND * (LEN(inicio$) + 1)) + 1 diff --git a/Task/Generate-lower-case-ASCII-alphabet/Ada/generate-lower-case-ascii-alphabet-4.ada b/Task/Generate-lower-case-ASCII-alphabet/Ada/generate-lower-case-ascii-alphabet-4.ada new file mode 100644 index 0000000000..49649e5209 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/Ada/generate-lower-case-ascii-alphabet-4.ada @@ -0,0 +1,34 @@ +-- Here is the fleshed-out code using the snippets from above +-- Note that I could have enhanced the output by not displaying the last comma +-- December 2024, R. B. E. + +with Ada.Text_IO; + +procedure Generate_Lower_Case_ASCII_Alphabet is + +-- We start with a strong type definition: A character range that can only hold lower-case letters: + + type Lower_Case is new Character range 'a' .. 'z'; + +-- Now we define an array type and initialize the Array A of that type with the 26 letters: + + type Arr_Type is array (Integer range <>) of Lower_Case; + A : Arr_Type (1 .. 26) := "abcdefghijklmnopqrstuvwxyz"; + +-- Strong typing would catch two errors: (1) any upper-case letters or +-- other symbols in the string assigned to A, and (2) too many or too +-- few letters assigned to A. However, a letter might still appear +-- twice (or more) in A, at the cost of one or more other +-- letters. Array B is safe even against such errors: + + B : Arr_Type (1 .. 26); +begin + B(B'First) := 'a'; + for I in B'First .. B'Last-1 loop + B(I+1) := Lower_Case'Succ(B(I)); + end loop; -- now all the B(I) are different + for I in B'First .. B'Last loop + Ada.Text_IO.Put (B(I)'Image & ", "); + end loop; + Ada.Text_IO.New_Line; +end Generate_Lower_Case_ASCII_Alphabet; diff --git a/Task/Generate-lower-case-ASCII-alphabet/M2000-Interpreter/generate-lower-case-ascii-alphabet.m2000 b/Task/Generate-lower-case-ASCII-alphabet/M2000-Interpreter/generate-lower-case-ascii-alphabet.m2000 index fe1a6ae9a8..d1934f96d8 100644 --- a/Task/Generate-lower-case-ASCII-alphabet/M2000-Interpreter/generate-lower-case-ascii-alphabet.m2000 +++ b/Task/Generate-lower-case-ASCII-alphabet/M2000-Interpreter/generate-lower-case-ascii-alphabet.m2000 @@ -1,9 +1,19 @@ \\ old style Basic, including a Binary.Or() function Module OldStyle { 10 LET A$="" - 20 FOR I=ASC("A") TO ASC("Z") - 30 LET A$=A$+CHR$(BINARY.OR(I, 32)) - 40 NEXT I - 50 PRINT A$ + 20 DEF FNUP$(I)=""""+CHR$(BINARY.OR(I, 32))+"""" + 30 FOR I=ASC("A") TO ASC("Y") + 40 LET A$= A$ + FNUP$(I, 32)+", " + 50 NEXT I + 60 LET A$ = A$+ FNUP$(I, 32) + 70 PRINT A$ } CALL OldStyle + +Module new_style { + a=("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z") + map1= lambda ->{push binary.or(asc(letter$), 32)} + map2= lambda ->{push chr$(number)} + Print """"+a#map(map1, map2)#str$({", "})+"""" +} +new_style diff --git a/Task/Generate-lower-case-ASCII-alphabet/X86-64-Assembly/generate-lower-case-ascii-alphabet.x86-64 b/Task/Generate-lower-case-ASCII-alphabet/X86-64-Assembly/generate-lower-case-ascii-alphabet-1.x86-64 similarity index 100% rename from Task/Generate-lower-case-ASCII-alphabet/X86-64-Assembly/generate-lower-case-ascii-alphabet.x86-64 rename to Task/Generate-lower-case-ASCII-alphabet/X86-64-Assembly/generate-lower-case-ascii-alphabet-1.x86-64 diff --git a/Task/Generate-lower-case-ASCII-alphabet/X86-64-Assembly/generate-lower-case-ascii-alphabet-2.x86-64 b/Task/Generate-lower-case-ASCII-alphabet/X86-64-Assembly/generate-lower-case-ascii-alphabet-2.x86-64 new file mode 100644 index 0000000000..fd17eea75d --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/X86-64-Assembly/generate-lower-case-ascii-alphabet-2.x86-64 @@ -0,0 +1,26 @@ +format ELF64 executable 3 +entry begin + +segment executable readable +begin: + mov rcx, 26 + mov rdi, alphabet + mov rax, 'a' + .loop0: + stosb + inc rax + loop .loop0 + mov byte[alphabet + 26], 0x0a + .print0: + mov rax, 1 + mov rdi, 1 + mov rsi, alphabet + mov rdx, 27 + syscall + .end: + mov rax, 60 + xor rdi, rdi + syscall + +segment readable writeable +alphabet: rb 27 diff --git a/Task/Get-system-command-output/Wren/get-system-command-output-1.wren b/Task/Get-system-command-output/Wren/get-system-command-output-1.wren deleted file mode 100644 index 4695b3d104..0000000000 --- a/Task/Get-system-command-output/Wren/get-system-command-output-1.wren +++ /dev/null @@ -1,6 +0,0 @@ -/* Get_system_command_output.wren */ -class Command { - foreign static output(name, param) // the code for this is provided by Go -} - -System.print(Command.output("ls", "-ls")) diff --git a/Task/Get-system-command-output/Wren/get-system-command-output-2.wren b/Task/Get-system-command-output/Wren/get-system-command-output-2.wren deleted file mode 100644 index 0bc8713e26..0000000000 --- a/Task/Get-system-command-output/Wren/get-system-command-output-2.wren +++ /dev/null @@ -1,39 +0,0 @@ -/* Get_system_command_output.go */ -package main - -import ( - wren "github.com/crazyinfin8/WrenGo" - "log" - "os" - "os/exec" -) - -type any = interface{} - -func getCommandOutput(vm *wren.VM, parameters []any) (any, error) { - name := parameters[1].(string) - param := parameters[2].(string) - var cmd *exec.Cmd - if param != "" { - cmd = exec.Command(name, param) - } else { - cmd = exec.Command(name) - } - cmd.Stderr = os.Stderr - bytes, err := cmd.Output() - if err != nil { - log.Fatal(err) - } - return string(bytes), nil -} - -func main() { - vm := wren.NewVM() - fileName := "Get_system_command_output.wren" - methodMap := wren.MethodMap{"static output(_,_)": getCommandOutput} - classMap := wren.ClassMap{"Command": wren.NewClass(nil, nil, methodMap)} - module := wren.NewModule(classMap) - vm.SetModule(fileName, module) - vm.InterpretFile(fileName) - vm.Free() -} diff --git a/Task/Get-system-command-output/Wren/get-system-command-output.wren b/Task/Get-system-command-output/Wren/get-system-command-output.wren new file mode 100644 index 0000000000..411638195b --- /dev/null +++ b/Task/Get-system-command-output/Wren/get-system-command-output.wren @@ -0,0 +1,3 @@ +import "os" for Process + +System.print(Process.read("ls", ["-ls"])) diff --git a/Task/Goldbachs-comet/PascalABC.NET/goldbachs-comet.pas b/Task/Goldbachs-comet/PascalABC.NET/goldbachs-comet.pas new file mode 100644 index 0000000000..234717b9bc --- /dev/null +++ b/Task/Goldbachs-comet/PascalABC.NET/goldbachs-comet.pas @@ -0,0 +1,36 @@ +uses GraphWPF; + +const colpick = (Colors.Red, Colors.Green, Colors.Blue); + +function IsPrime(x: longword): boolean; +begin + var i := 2; + while (i * i <= x) and (x mod i <> 0) do + i += 1; + Result := i * i > x; +end; + +function g(n: integer): integer; +begin + assert((n > 2) and (n mod 2 = 0), '“n” must be even and greater than 2.'); + for var i := 2 to (n div 2) do + if isPrime(i) and isPrime(n - i) then + result += 1; +end; + +begin + println('First 100 G numbers:'); + foreach var n in (2..101) index i do + begin + write(g( 2 * n):3); + if (i + 1) mod 10 = 0 then writeln; + end; + println; + println('G(1_000_000) =', g(1_000_000)); + + setMathematicCoords(0, 4000, 0, false); + foreach var x in range(4, 4002, 2) do + begin + fillcircle(x, g(x)*15, 10, colpick[(x div 2) mod 3]); + end; +end. diff --git a/Task/Golden-ratio-Convergence/Quackery/golden-ratio-convergence.quackery b/Task/Golden-ratio-Convergence/Quackery/golden-ratio-convergence.quackery new file mode 100644 index 0000000000..1f4c606229 --- /dev/null +++ b/Task/Golden-ratio-Convergence/Quackery/golden-ratio-convergence.quackery @@ -0,0 +1,23 @@ + [ $ "bigrat.qky" loadfile ] now! + + 0 temp put + 1 n->v + [ 1 temp tally + 2dup 1/v 1 n->v v+ + 2over 2over + 5 approx= not while ( i.e. to five digits after the decimal point ) + 2swap 2drop again ] + say " After " + temp take echo + say " iterations: " + 63 point$ echo$ cr + say "As a vulgar fraction: " + 2dup vulgar$ echo$ cr + 2dup + [ 2dup 1/v 1 n->v v+ ( Continue to 63 digits after the decimal point ) + 2over 2over ( to find the approximate error to same accuracy ) + 63 approx= not while ( as Wolfram Alpha. ) + 2swap 2drop again ] + 2drop 2swap v- + say " Approximate error: " + 63 point$ echo$ cr diff --git a/Task/Gotchas/C/gotchas-1.c b/Task/Gotchas/C/gotchas-1.c index f46446548f..5d12d22ba7 100644 --- a/Task/Gotchas/C/gotchas-1.c +++ b/Task/Gotchas/C/gotchas-1.c @@ -1,3 +1,3 @@ -if(a=b){} //assigns to "a" the value of "b". Then, if "a" is nonzero, the code in the curly braces is run. - -if(a==b){} //runs the code in the curly braces if and only if the value of "a" equals the value of "b". +if (a=b) { + ...; /* this is run if b is non-zero */ +} diff --git a/Task/Gotchas/C/gotchas-10.c b/Task/Gotchas/C/gotchas-10.c index d0512d7776..f1d321c444 100644 --- a/Task/Gotchas/C/gotchas-10.c +++ b/Task/Gotchas/C/gotchas-10.c @@ -1,7 +1,2 @@ -int main() -{ -int x = 3; -int y = 5; -int z = 7; -printf("%d %d %d %x %x",x,y,z); //on an Intel cpu the first %x reveals %%ebp and the second reveals the return address.) -} +myArray[40]; +int x = gotcha(&myArray[0]); diff --git a/Task/Gotchas/C/gotchas-11.c b/Task/Gotchas/C/gotchas-11.c index 8bd998e6a1..f4cdf00887 100644 --- a/Task/Gotchas/C/gotchas-11.c +++ b/Task/Gotchas/C/gotchas-11.c @@ -1,3 +1,7 @@ -(let numbers [1 2 3 4] - maximum (max numbers)) ;should be (... max numbers) -(+ maximum 5) +int foo(char buf[],int length){} + +int main() +{ +char myArray[30]; +int j = foo(myArray,sizeof(myArray)); //passes 30 as the length parameter. +} diff --git a/Task/Gotchas/C/gotchas-12.c b/Task/Gotchas/C/gotchas-12.c index f43e241d84..08a2b7c6c0 100644 --- a/Task/Gotchas/C/gotchas-12.c +++ b/Task/Gotchas/C/gotchas-12.c @@ -1,2 +1,4 @@ -(mock + (fn a b ((unmocked +) a b 1))) -(+ 2 3) +int x = 3; +int y = 5; +printf("%d %d %x\n",x,y); /* this may crash or print undefined values after 3 5 */ +printf("testing %n\n"); /* this writes the int value 8 to an undefined location */ diff --git a/Task/Gotchas/C/gotchas-13.c b/Task/Gotchas/C/gotchas-13.c new file mode 100644 index 0000000000..30ecde47fc --- /dev/null +++ b/Task/Gotchas/C/gotchas-13.c @@ -0,0 +1,7 @@ +void +say_hello(const char *name) /* assume name is something the user entered */ +{ + printf("hello "); + printf(name); /* the name entered could be "%s" or "%n" or something */ + printf("\n"); +} diff --git a/Task/Gotchas/C/gotchas-2.c b/Task/Gotchas/C/gotchas-2.c index fd9a19497b..d5c6ab4190 100644 --- a/Task/Gotchas/C/gotchas-2.c +++ b/Task/Gotchas/C/gotchas-2.c @@ -1 +1,3 @@ -int foo[4] = {4,8,12,16}; +if (a==b) { + ...; /* this is run if a and b are equal */ +} diff --git a/Task/Gotchas/C/gotchas-3.c b/Task/Gotchas/C/gotchas-3.c index bf983982ce..035755e086 100644 --- a/Task/Gotchas/C/gotchas-3.c +++ b/Task/Gotchas/C/gotchas-3.c @@ -1,4 +1,3 @@ -int foo[4] = {4,8,12,16}; -int x = foo[0]; //x = 4 -int y = foo[3]; //y = 16 -int z = foo[4]; //z = ????????? +if ( (a=b) ) { /* this shows that an assignment was intended */ + ...; +} diff --git a/Task/Gotchas/C/gotchas-4.c b/Task/Gotchas/C/gotchas-4.c index 6bbd139b94..33537501dd 100644 --- a/Task/Gotchas/C/gotchas-4.c +++ b/Task/Gotchas/C/gotchas-4.c @@ -1,5 +1 @@ -int foo() -{ -char bar[20]; -return sizeof(bar); -} +int foo[4] = { 4, 8, 12, 16 }; diff --git a/Task/Gotchas/C/gotchas-5.c b/Task/Gotchas/C/gotchas-5.c index 1783b1cadd..7a03a2d3b7 100644 --- a/Task/Gotchas/C/gotchas-5.c +++ b/Task/Gotchas/C/gotchas-5.c @@ -1,7 +1,4 @@ -int foo() -{ -#define size_of_bar 20 //the sizeof operator is the same as doing this essentially. - -char bar[size_of_bar]; -return size_of_bar; -} +int foo[4] = { 4, 8, 12, 16 }; +int x = foo[0]; /* x = 4 */ +int y = foo[3]; /* y = 16 */ +int z = foo[4]; /* z contains whatever was after foo[3] in memory */ diff --git a/Task/Gotchas/C/gotchas-6.c b/Task/Gotchas/C/gotchas-6.c index 604364d864..5934e16574 100644 --- a/Task/Gotchas/C/gotchas-6.c +++ b/Task/Gotchas/C/gotchas-6.c @@ -1,4 +1,5 @@ -int gotcha(char bar[]) -{ -return sizeof(bar); +int i; +int squarenums[10]; +for (i=0; i<=10; i++) { + squarenums[i] = i * i; } diff --git a/Task/Gotchas/C/gotchas-7.c b/Task/Gotchas/C/gotchas-7.c index adfaa38c5d..d91e167014 100644 --- a/Task/Gotchas/C/gotchas-7.c +++ b/Task/Gotchas/C/gotchas-7.c @@ -1,2 +1,5 @@ -myArray[40]; -int x = gotcha(myArray); +int foo() +{ + char bar[20]; + return sizeof(bar); /* returns 20 as expected */ +} diff --git a/Task/Gotchas/C/gotchas-8.c b/Task/Gotchas/C/gotchas-8.c index f1d321c444..c5c984bbcd 100644 --- a/Task/Gotchas/C/gotchas-8.c +++ b/Task/Gotchas/C/gotchas-8.c @@ -1,2 +1,4 @@ -myArray[40]; -int x = gotcha(&myArray[0]); +int gotcha(char bar[]) /* could have been: int gotcha(char *bar) */ +{ + return sizeof(bar); /* returns the size of a pointer to char, probably 4 on 32-bit systems and 8 on 64-bit systems */ +} diff --git a/Task/Gotchas/C/gotchas-9.c b/Task/Gotchas/C/gotchas-9.c index f4cdf00887..1e79626483 100644 --- a/Task/Gotchas/C/gotchas-9.c +++ b/Task/Gotchas/C/gotchas-9.c @@ -1,7 +1,2 @@ -int foo(char buf[],int length){} - -int main() -{ -char myArray[30]; -int j = foo(myArray,sizeof(myArray)); //passes 30 as the length parameter. -} +char myArray[40]; +int x = gotcha(myArray); diff --git a/Task/Gotchas/X86-Assembly/gotchas.x86 b/Task/Gotchas/X86-Assembly/gotchas.x86 index 3026998ad2..ab771d3e0b 100644 --- a/Task/Gotchas/X86-Assembly/gotchas.x86 +++ b/Task/Gotchas/X86-Assembly/gotchas.x86 @@ -1,4 +1,15 @@ +; this takes two bytes, it is slower on some processors but faster or the same on others label: -;loop body goes here -DEC ECX -JNZ label + loop label + +; this takes three bytes but is slower on some processors +label: + dec ecx + jnz label + +; this is takes five bytes and is potentially faster than the above +label: + sub ecx,1 + jnz label + +; there is also a two-byte jecxz instruction but no jecxnz diff --git a/Task/Gray-code/FutureBasic/gray-code.basic b/Task/Gray-code/FutureBasic/gray-code.basic new file mode 100644 index 0000000000..9bb50c362a --- /dev/null +++ b/Task/Gray-code/FutureBasic/gray-code.basic @@ -0,0 +1,31 @@ +// Gray Code +//https://rosettacode.org/wiki/Gray_code + +local fn gray2bin(g As uint32) As uint32 + uint32 b = g + While g + g = g >> 1 + b = b Xor g + Wend + Return b +End fn = b + +local fn bin2gray(b As uint32) As uint32 +End fn = b Xor (b >> 1) + +// ------=< MAIN >=------ + +uint32 i +Print " DEC Binary Gray GrayToBinary" + +For i = 0 To 31 + print str$(i) + " "; + if i < 10 then print " "; + print " " + right$(bin$(i),5); + print " -->"; + print " " + right$(bin$(fn bin2gray(i)),5); + print " -->"; + print " " + right$(bin$(fn gray2bin(fn bin2gray(i))),5) +Next + +handleevents diff --git a/Task/Greatest-common-divisor/YAMLScript/greatest-common-divisor.ys b/Task/Greatest-common-divisor/YAMLScript/greatest-common-divisor.ys index 75ae864e19..b77cb8bd55 100644 --- a/Task/Greatest-common-divisor/YAMLScript/greatest-common-divisor.ys +++ b/Task/Greatest-common-divisor/YAMLScript/greatest-common-divisor.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(a=42 b=63): say: "gcd($a $b) -> $gcd(a b)" diff --git a/Task/Greyscale-bars-Display/Nim/greyscale-bars-display.nim b/Task/Greyscale-bars-Display/Nim/greyscale-bars-display.nim index 405fc25cb1..0a0338495a 100644 --- a/Task/Greyscale-bars-Display/Nim/greyscale-bars-display.nim +++ b/Task/Greyscale-bars-Display/Nim/greyscale-bars-display.nim @@ -1,12 +1,11 @@ -import gintro/[glib, gobject, gtk, gio, cairo] +import gtk2, gdk2, cairo const Width = 640 Height = 480 -#--------------------------------------------------------------------------------------------------- -proc draw(area: DrawingArea; context: Context) = +proc draw(area: PDrawingArea; cr: ptr Context) = ## Draw the greyscale bars. const @@ -25,43 +24,39 @@ proc draw(area: DrawingArea; context: Context) = # Draw rectangles. for _ in 1..nrect: - context.rectangle(x, y, rectWidth, rectHeight) - context.setSource([grey, grey, grey]) - context.fill() + cr.rectangle(x, y, rectWidth, rectHeight) + cr.setSourceRgb(grey, grey, grey) + cr.fill() x += rectWidth grey += incr y += rectHeight nrect *= 2 -#--------------------------------------------------------------------------------------------------- -proc onDraw(area: DrawingArea; context: Context; data: pointer): bool = +proc onExposeEvent(area: PDrawingArea; event: PEventExpose; data: pointer): bool = ## Callback to draw/redraw the drawing area contents. - - area.draw(context) + let cr = cairoCreate(area.window) + area.draw(cr) result = true -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +proc onDestroyEvent(widget: PWidget; data: pointer): bool = + mainQuit() - let window = app.newApplicationWindow() - window.setSizeRequest(Width, Height) - window.setTitle("Greyscale bars") - # Create the drawing area. - let area = newDrawingArea() - window.add(area) +nimInit() +let window = windowNew(WINDOW_TOPLEVEL) +window.setSizeRequest(Width, Height) +window.setTitle("Greyscale bars") +discard window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) - # Connect the "draw" event to the callback to draw the spiral. - discard area.connect("draw", ondraw, pointer(nil)) +# Create the drawing area. +let area = drawingAreaNew() +window.add area - window.showAll() +# Connect the "expose" event to the callback to draw the bars. +discard area.signalConnect("expose-event", SIGNAL_FUNC(onExposeEvent), nil) -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.GreyscaleBars") -discard app.connect("activate", activate) -discard app.run() +window.showAll() +main() diff --git a/Task/Guess-the-number/EMal/guess-the-number.emal b/Task/Guess-the-number/EMal/guess-the-number.emal new file mode 100644 index 0000000000..ddc2333cad --- /dev/null +++ b/Task/Guess-the-number/EMal/guess-the-number.emal @@ -0,0 +1,6 @@ +int number ← random(1, 10 + 1) +int guess ← when(Runtime.args.length æ 1, number, -1) +while number ≠ guess + guess ← ask(int, "Guess the number between 1 and 10 inclusive: ") +end +writeLine("Well guessed!") diff --git a/Task/Guess-the-number/Langur/guess-the-number.langur b/Task/Guess-the-number/Langur/guess-the-number.langur index fe84301d0f..650b318cd4 100644 --- a/Task/Guess-the-number/Langur/guess-the-number.langur +++ b/Task/Guess-the-number/Langur/guess-the-number.langur @@ -2,7 +2,11 @@ writeln "Guess a number from 1 to 10" val n = string(random(10)) for { - val guess = read(">> ", RE/^0*(?:[1-9]|10)(?:\.0+)?$/, "bad data\n", 7, "") + val guess = read( + prompt=">> ", + validation=RE/^0*(?:[1-9]|10)(?:\.0+)?$/, + errmsg="bad data\n", maxattempts=7, alt=zls) + if guess == "" { writeln "too much bad data" break diff --git a/Task/HTTP/Visual-Basic-.NET/http.vb b/Task/HTTP/Visual-Basic-.NET/http.vb index 1f09d1f81e..4fdf9c2351 100644 --- a/Task/HTTP/Visual-Basic-.NET/http.vb +++ b/Task/HTTP/Visual-Basic-.NET/http.vb @@ -1,5 +1,11 @@ Imports System.Net -Dim client As WebClient = New WebClient() -Dim content As String = client.DownloadString("http://www.google.com") -Console.WriteLine(content) +Module RCHttp + + Public Sub Main(args As String()) + Dim client As New WebClient() + Dim content As String = client.DownloadString("http://www.google.com") + Console.WriteLine(content) + End Sub + +End Module diff --git a/Task/HTTP/Wren/http-1.wren b/Task/HTTP/Wren/http-1.wren deleted file mode 100644 index 68b4d13a8d..0000000000 --- a/Task/HTTP/Wren/http-1.wren +++ /dev/null @@ -1,31 +0,0 @@ -/* HTTP.wren */ - -var CURLOPT_URL = 10002 -var CURLOPT_FOLLOWLOCATION = 52 -var CURLOPT_ERRORBUFFER = 10010 - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() -if (curl == 0) { - System.print("Error initializing cURL.") - return -} -curl.easySetOpt(CURLOPT_URL, "http://www.rosettacode.org/") -curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1) -curl.easySetOpt(CURLOPT_ERRORBUFFER, 0) // buffer to be supplied by C - -var status = curl.easyPerform() -if (status != 0) { - System.print("Failed to perform task.") - return -} -curl.easyCleanup() diff --git a/Task/HTTP/Wren/http-2.wren b/Task/HTTP/Wren/http-2.wren deleted file mode 100644 index f352990519..0000000000 --- a/Task/HTTP/Wren/http-2.wren +++ /dev/null @@ -1,127 +0,0 @@ -/* gcc HTTP.c -o HTTP -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -/* C <=> Wren interface functions */ - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLcode cc = curl_easy_perform(curl); - wrenSetSlotDouble(vm, 0, (double)cc); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - if (opt < 10000) { - long lparam = (long)wrenGetSlotDouble(vm, 2); - curl_easy_setopt(curl, opt, lparam); - } else { - if (opt == CURLOPT_URL) { - const char *url = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, url); - } else if (opt == CURLOPT_ERRORBUFFER) { - char buffer[CURL_ERROR_SIZE]; - curl_easy_setopt(curl, opt, buffer); - } - } -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "HTTP.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/HTTP/Wren/http.wren b/Task/HTTP/Wren/http.wren new file mode 100644 index 0000000000..082cf7690c --- /dev/null +++ b/Task/HTTP/Wren/http.wren @@ -0,0 +1,3 @@ +import "os" for Process + +Process.exec("curl -s -L http://www.rosettacode.org/") diff --git a/Task/HTTPS-Authenticated/FutureBasic/https-authenticated.basic b/Task/HTTPS-Authenticated/FutureBasic/https-authenticated.basic new file mode 100644 index 0000000000..d9eb17ef39 --- /dev/null +++ b/Task/HTTPS-Authenticated/FutureBasic/https-authenticated.basic @@ -0,0 +1,11 @@ +// HTTPS/Authenticated task +// https://rosettacode.org/wiki/HTTPS/Authenticated# + +CFStringRef response +CFDataRef dta +response = unix @"curl -u admin:admin https://httpbin.org/basic-auth/admin/admin" +dta = fn StringData( response, NSUTF8StringEncoding ) + +print fn StringWithData( dta, NSUTF8StringEncoding ) + +handleevents diff --git a/Task/HTTPS-Authenticated/Wren/https-authenticated-1.wren b/Task/HTTPS-Authenticated/Wren/https-authenticated-1.wren deleted file mode 100644 index 57f5ccf7af..0000000000 --- a/Task/HTTPS-Authenticated/Wren/https-authenticated-1.wren +++ /dev/null @@ -1,31 +0,0 @@ -/* HTTPS_Authenticated.wren */ - -var CURLOPT_URL = 10002 -var CURLOPT_FOLLOWLOCATION = 52 -var CURLOPT_ERRORBUFFER = 10010 - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() -if (curl == 0) { - System.print("Error initializing cURL.") - return -} -curl.easySetOpt(CURLOPT_URL, "https://user:password@secure.example.com/") -curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1) -curl.easySetOpt(CURLOPT_ERRORBUFFER, 0) // buffer to be supplied by C - -var status = curl.easyPerform() -if (status != 0) { - System.print("Failed to perform task.") - return -} -curl.easyCleanup() diff --git a/Task/HTTPS-Authenticated/Wren/https-authenticated-2.wren b/Task/HTTPS-Authenticated/Wren/https-authenticated-2.wren deleted file mode 100644 index f57b8f7e7d..0000000000 --- a/Task/HTTPS-Authenticated/Wren/https-authenticated-2.wren +++ /dev/null @@ -1,127 +0,0 @@ -/* gcc HTTPS_Authenticated.c -o HTTPS_Authenticated -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -/* C <=> Wren interface functions */ - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLcode cc = curl_easy_perform(curl); - wrenSetSlotDouble(vm, 0, (double)cc); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - if (opt < 10000) { - long lparam = (long)wrenGetSlotDouble(vm, 2); - curl_easy_setopt(curl, opt, lparam); - } else { - if (opt == CURLOPT_URL) { - const char *url = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, url); - } else if (opt == CURLOPT_ERRORBUFFER) { - char buffer[CURL_ERROR_SIZE]; - curl_easy_setopt(curl, opt, buffer); - } - } -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "HTTPS_Authenticated.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/HTTPS-Authenticated/Wren/https-authenticated.wren b/Task/HTTPS-Authenticated/Wren/https-authenticated.wren new file mode 100644 index 0000000000..1fd4bcd5f1 --- /dev/null +++ b/Task/HTTPS-Authenticated/Wren/https-authenticated.wren @@ -0,0 +1,5 @@ +import "os" for Process + +var userPwd = "admin:admin" +var url = "https://httpbin.org/basic-auth/admin/admin" +Process.exec("curl", ["-u", userPwd, url]) diff --git a/Task/HTTPS-Client-authenticated/FreeBASIC/https-client-authenticated.basic b/Task/HTTPS-Client-authenticated/FreeBASIC/https-client-authenticated.basic new file mode 100644 index 0000000000..3d6a030dce --- /dev/null +++ b/Task/HTTPS-Client-authenticated/FreeBASIC/https-client-authenticated.basic @@ -0,0 +1,64 @@ +#ifdef __FB_WIN32__ + #include once "win/winsock2.bi" + Declare Function fbsocket Alias "socket" (af As Long, Type As Long, protocol As Long) As SOCKET +#else + #include once "sys/socket.bi" + #include once "netinet/in.bi" + #include once "arpa/inet.bi" + #include once "netdb.bi" + Declare Function fbsocket Alias "socket" (af As Long, Type As Long, protocol As Long) As Long +#endif + +Function main() As Integer + #ifdef __fb_win32__ + Dim As WSADATA wsaData + WSAStartup(MAKEWORD(2, 2), @wsaData) + #endif + + ' Create socket + Dim As Long sock = fbsocket(AF_INET, SOCK_STREAM, 0) + + ' Get host info + Dim As hostent Ptr host = gethostbyname("www.example.com") + + ' Set up address structure + Dim As sockaddr_in addr + addr.sin_family = AF_INET + addr.sin_port = htons(443) + addr.sin_addr = *Cast(in_addr Ptr, host->h_addr) + + ' Connect + connect(sock, Cast(sockaddr Ptr, @addr), Sizeof(sockaddr_in)) + + ' Send request + Dim As String request = "GET / HTTP/1.1" & Chr(13, 10) & _ + "Host: www.example.com" & Chr(13, 10) & _ + Chr(13, 10) + send(sock, request, Len(request), 0) + + ' Receive response + Dim As String response + Dim As String buffer = Space(4096) + Dim As Integer bytes + + Do + bytes = recv(sock, buffer, 4096, 0) + If bytes > 0 Then response &= Left(buffer, bytes) + Loop While bytes > 0 + + Print response + + ' Cleanup + #ifdef __fb_win32__ + closesocket(sock) + WSACleanup() + #Else + Close(sock) + #endif + + Return 0 +End Function + +main() + +Sleep diff --git a/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated-1.wren b/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated-1.wren deleted file mode 100644 index 9bd8870f49..0000000000 --- a/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated-1.wren +++ /dev/null @@ -1,34 +0,0 @@ -/* HTTPS_Client-authenticated.wren */ - -var CURLOPT_URL = 10002 -var CURLOPT_SSLCERT = 10025 -var CURLOPT_SSLKEY = 10087 -var CURLOPT_KEYPASSWD = 10258 - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() -if (curl == 0) { - System.print("Error initializing cURL.") - return -} - -curl.easySetOpt(CURLOPT_URL, "https://example.com/") -curl.easySetOpt(CURLOPT_SSLCERT, "cert.pem") -curl.easySetOpt(CURLOPT_SSLKEY, "key.pem") -curl.easySetOpt(CURLOPT_KEYPASSWD, "s3cret") - -var status = curl.easyPerform() -if (status != 0) { - System.print("Failed to perform task.") - return -} -curl.easyCleanup() diff --git a/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated-2.wren b/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated-2.wren deleted file mode 100644 index 6cb74e498d..0000000000 --- a/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated-2.wren +++ /dev/null @@ -1,117 +0,0 @@ -/* gcc HTTPS_Client-authenticated.c -o HTTPS_Client-authenticated -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -/* C <=> Wren interface functions */ - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLcode cc = curl_easy_perform(curl); - wrenSetSlotDouble(vm, 0, (double)cc); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - const char *arg = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, arg); -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "HTTPS_Client-authenticated.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated.wren b/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated.wren new file mode 100644 index 0000000000..dcf8f261a0 --- /dev/null +++ b/Task/HTTPS-Client-authenticated/Wren/https-client-authenticated.wren @@ -0,0 +1,7 @@ +import "os" for Process + +var certFile = "myCert.pem" +var keyFile = "myKey.pem" +var url = "www.example.com" + +Process.exec("curl", ["--cert", certFile, "--key", keyFile, url]) diff --git a/Task/HTTPS/Wren/https-1.wren b/Task/HTTPS/Wren/https-1.wren deleted file mode 100644 index c26b4bd296..0000000000 --- a/Task/HTTPS/Wren/https-1.wren +++ /dev/null @@ -1,31 +0,0 @@ -/* HTTPS.wren */ - -var CURLOPT_URL = 10002 -var CURLOPT_FOLLOWLOCATION = 52 -var CURLOPT_ERRORBUFFER = 10010 - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() -if (curl == 0) { - System.print("Error initializing cURL.") - return -} -curl.easySetOpt(CURLOPT_URL, "https://www.w3.org/") -curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1) -curl.easySetOpt(CURLOPT_ERRORBUFFER, 0) // buffer to be supplied by C - -var status = curl.easyPerform() -if (status != 0) { - System.print("Failed to perform task.") - return -} -curl.easyCleanup() diff --git a/Task/HTTPS/Wren/https-2.wren b/Task/HTTPS/Wren/https-2.wren deleted file mode 100644 index dc70c2b81b..0000000000 --- a/Task/HTTPS/Wren/https-2.wren +++ /dev/null @@ -1,127 +0,0 @@ -/* gcc HTTPS.c -o HTTPS -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -/* C <=> Wren interface functions */ - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLcode cc = curl_easy_perform(curl); - wrenSetSlotDouble(vm, 0, (double)cc); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - if (opt < 10000) { - long lparam = (long)wrenGetSlotDouble(vm, 2); - curl_easy_setopt(curl, opt, lparam); - } else { - if (opt == CURLOPT_URL) { - const char *url = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, url); - } else if (opt == CURLOPT_ERRORBUFFER) { - char buffer[CURL_ERROR_SIZE]; - curl_easy_setopt(curl, opt, buffer); - } - } -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "HTTPS.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/HTTPS/Wren/https.wren b/Task/HTTPS/Wren/https.wren new file mode 100644 index 0000000000..1d35125f6e --- /dev/null +++ b/Task/HTTPS/Wren/https.wren @@ -0,0 +1,3 @@ +import "os" for Process + +Process.exec("curl -s -L https://www.w3.org/") diff --git a/Task/Hailstone-sequence/Jq/hailstone-sequence-2.jq b/Task/Hailstone-sequence/Jq/hailstone-sequence-2.jq index c6b0fe55d9..06fd8b01e9 100644 --- a/Task/Hailstone-sequence/Jq/hailstone-sequence-2.jq +++ b/Task/Hailstone-sequence/Jq/hailstone-sequence-2.jq @@ -3,5 +3,5 @@ "The first four numbers: \($h[0:4])", "The last four numbers: \($h|.[length-4:length])", "", - max_hailstone(100000) as $m - | "Maximum length for n|hailstone for n in 1..100000 is \($m[1]) (n == \($m[0]))" + (max_hailstone(100000) as $m + | "Maximum length for n|hailstone for n in 1..100000 is \($m[1]) (n == \($m[0]))") diff --git a/Task/Hailstone-sequence/M2000-Interpreter/hailstone-sequence.m2000 b/Task/Hailstone-sequence/M2000-Interpreter/hailstone-sequence.m2000 index 36d886dcb9..6cdcbfba59 100644 --- a/Task/Hailstone-sequence/M2000-Interpreter/hailstone-sequence.m2000 +++ b/Task/Hailstone-sequence/M2000-Interpreter/hailstone-sequence.m2000 @@ -7,7 +7,7 @@ Module hailstone.Task { n*=3 : n++: val=n } } - Count=Lambda (n) ->{ + count=Lambda (n as long) ->{ m=lambda n ->{ if n=1 then =false: exit =true :if n mod 2=0 then n/=2 :exit diff --git a/Task/Halt-and-catch-fire/FutureBasic/halt-and-catch-fire.basic b/Task/Halt-and-catch-fire/FutureBasic/halt-and-catch-fire.basic new file mode 100644 index 0000000000..858825d80b --- /dev/null +++ b/Task/Halt-and-catch-fire/FutureBasic/halt-and-catch-fire.basic @@ -0,0 +1 @@ +~ 0,0 diff --git a/Task/Halt-and-catch-fire/Uiua/halt-and-catch-fire.uiua b/Task/Halt-and-catch-fire/Uiua/halt-and-catch-fire.uiua new file mode 100644 index 0000000000..414ff2f8ec --- /dev/null +++ b/Task/Halt-and-catch-fire/Uiua/halt-and-catch-fire.uiua @@ -0,0 +1 @@ +⍤@a 0 diff --git a/Task/Halt-and-catch-fire/Zig/halt-and-catch-fire.zig b/Task/Halt-and-catch-fire/Zig/halt-and-catch-fire.zig new file mode 100644 index 0000000000..d8b5049869 --- /dev/null +++ b/Task/Halt-and-catch-fire/Zig/halt-and-catch-fire.zig @@ -0,0 +1,3 @@ +pub fn main() void { + unreachable; +} diff --git a/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-1.v b/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-1.v index 509ec16025..bd63012c8d 100644 --- a/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-1.v +++ b/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-1.v @@ -1,9 +1,7 @@ import math.big fn min(a big.Integer, b big.Integer) big.Integer { - if a < b { - return a - } + if a < b {return a} return b } diff --git a/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-2.v b/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-2.v index 3f7755a80b..4fa74da146 100644 --- a/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-2.v +++ b/Task/Hamming-numbers/V-(Vlang)/hamming-numbers-2.v @@ -63,7 +63,7 @@ fn (lr LogRep) str() string { } struct HammingsLog { - mut: + mut: // automatically initialized with LogRep = one (defult)... s2 []LogRep = []LogRep { len: 1024, cap: 1024 } s3 []LogRep = []LogRep { len: 1024, cap: 1024 } diff --git a/Task/Harmonic-series/ALGOL-60/harmonic-series.alg b/Task/Harmonic-series/ALGOL-60/harmonic-series.alg new file mode 100644 index 0000000000..7b5f62d6ba --- /dev/null +++ b/Task/Harmonic-series/ALGOL-60/harmonic-series.alg @@ -0,0 +1,32 @@ +begin + +real i, h, n, limit; + +limit := 20; +h := 0; +outstring(1,"First"); +outreal(1,limit); +outstring(1,"numbers in the harmonic series\n"); +for i := 1, i + 1 while i <= limit do + begin + h := h + 1 / i; + outreal(1,i); + outreal(1,h); + outstring(1,"\n"); + end; + +for i := 1, i + 1 while i <= 5 do + begin + h := 1; + for n := 2, n + 1 while h <= i do + begin + h := h + 1 / n; + end; + outstring(1,"First harmonic number >"); + outreal(1,i); + outstring(1,"is at position"); + outreal(1,n-1); + outstring(1,"\n"); + end; + +end diff --git a/Task/Hash-from-two-arrays/Emacs-Lisp/hash-from-two-arrays.l b/Task/Hash-from-two-arrays/Emacs-Lisp/hash-from-two-arrays.l index da8a189a6d..7967d72d53 100644 --- a/Task/Hash-from-two-arrays/Emacs-Lisp/hash-from-two-arrays.l +++ b/Task/Hash-from-two-arrays/Emacs-Lisp/hash-from-two-arrays.l @@ -1,3 +1,11 @@ -(let ((keys ["a" "b" "c"]) - (values [1 2 3])) - (apply 'vector (cl-loop for i across keys for j across values collect (vector i j)))) +(defun hash-from-two-arrays (seq1 seq2) + (let ((hash (make-hash-table :test 'equal)) + (list1 (if (listp seq1) seq1 (append seq1 nil))) + (list2 (if (listp seq2) seq2 (append seq2 nil)))) + (while (and list1 list2) + (puthash (car list1) (car list2) hash) + (setq list1 (cdr list1) + list2 (cdr list2))) + hash)) + +(hash-from-two-arrays (list 'a 'b 'c) [1 2 3]) diff --git a/Task/Hash-from-two-arrays/Langur/hash-from-two-arrays-2.langur b/Task/Hash-from-two-arrays/Langur/hash-from-two-arrays-2.langur index 02fa5dea1e..8b6190318f 100644 --- a/Task/Hash-from-two-arrays/Langur/hash-from-two-arrays-2.langur +++ b/Task/Hash-from-two-arrays/Langur/hash-from-two-arrays-2.langur @@ -1,5 +1,7 @@ -val new = foldfrom( - fn h, key, value:more(h, {key: value}), - {:}, fw/a b c d/, [1, 2, 3, 4], +val new = fold( + fw/a b c d/, [1, 2, 3, 4], + by=fn(h, key, value) { more h, {key: value} }, + init={:}, ) + writeln new diff --git a/Task/Hash-from-two-arrays/Uiua/hash-from-two-arrays.uiua b/Task/Hash-from-two-arrays/Uiua/hash-from-two-arrays.uiua new file mode 100644 index 0000000000..0b37a63ba3 --- /dev/null +++ b/Task/Hash-from-two-arrays/Uiua/hash-from-two-arrays.uiua @@ -0,0 +1,3 @@ +A ← {"carl" "randy" "sam"} +B ← {"robinson" "michaels" "wooley"} +map A B diff --git a/Task/Haversine-formula/PascalABC.NET/haversine-formula.pas b/Task/Haversine-formula/PascalABC.NET/haversine-formula.pas new file mode 100644 index 0000000000..8eafc78a1a --- /dev/null +++ b/Task/Haversine-formula/PascalABC.NET/haversine-formula.pas @@ -0,0 +1,19 @@ +const + r = 6372.8; + +function haversine(lat1, lon1, lat2, lon2: real): real; +begin + var dLat := degToRad(lat2 - lat1); + var dLon := degToRad(lon2 - lon1); + lat1 := degToRad(lat1); + lat2 := degToRad(lat2); + + var a := sin(dLat / 2) * sin(dLat / 2) + cos(lat1) * cos(lat2) * sin(dLon / 2) * sin(dLon / 2); + var c := 2 * arcsin(sqrt(a)); + + result := r * c; +end; + +begin + haversine(36.12, -86.67, 33.94, -118.40).Println; +end. diff --git a/Task/Hello-world-Graphical/AutoHotKey-V2/hello-world-graphical.ahk b/Task/Hello-world-Graphical/Autohotkey-V2/hello-world-graphical.ahk similarity index 100% rename from Task/Hello-world-Graphical/AutoHotKey-V2/hello-world-graphical.ahk rename to Task/Hello-world-Graphical/Autohotkey-V2/hello-world-graphical.ahk diff --git a/Task/Hello-world-Line-printer/Lua/hello-world-line-printer.lua b/Task/Hello-world-Line-printer/Lua/hello-world-line-printer.lua new file mode 100644 index 0000000000..ad8cf4ea5f --- /dev/null +++ b/Task/Hello-world-Line-printer/Lua/hello-world-line-printer.lua @@ -0,0 +1,7 @@ +require "io" + +lp = io.open("/dev/lp0", 'w') + +io.output(lp) +io.write("Hello World\n") +io.close(lp) diff --git a/Task/Hello-world-Line-printer/Wren/hello-world-line-printer-1.wren b/Task/Hello-world-Line-printer/Wren/hello-world-line-printer-1.wren deleted file mode 100644 index 93d982231b..0000000000 --- a/Task/Hello-world-Line-printer/Wren/hello-world-line-printer-1.wren +++ /dev/null @@ -1,7 +0,0 @@ -/* Hello_world_Line_printer.wren */ - -class C { - foreign static lprint(s) -} - -C.lprint("Hello World!") diff --git a/Task/Hello-world-Line-printer/Wren/hello-world-line-printer-2.wren b/Task/Hello-world-Line-printer/Wren/hello-world-line-printer-2.wren deleted file mode 100644 index 3c40e19b85..0000000000 --- a/Task/Hello-world-Line-printer/Wren/hello-world-line-printer-2.wren +++ /dev/null @@ -1,62 +0,0 @@ -/* gcc Hello_world_Line_printer.c -o Hello_world_Line_printer -lwren -lm */ - -#include -#include -#include -#include "wren.h" - -/* C <=> Wren interface functions */ - -void C_lprint(WrenVM* vm) { - const char *arg = wrenGetSlotString(vm, 1); - char command[strlen(arg) + 13]; - strcpy(command, "echo \""); - strcat(command, arg); - strcat(command, "\" | lp"); - system(command); -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "C") == 0) { - if (isStatic && strcmp(signature, "lprint(_)") == 0) return C_lprint; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Hello_world_Line_printer.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Hello-world-Line-printer/Wren/hello-world-line-printer.wren b/Task/Hello-world-Line-printer/Wren/hello-world-line-printer.wren new file mode 100644 index 0000000000..0b54029108 --- /dev/null +++ b/Task/Hello-world-Line-printer/Wren/hello-world-line-printer.wren @@ -0,0 +1,3 @@ +import "os" for Process + +Process.exec("echo \"Hello World!\" | lpr") diff --git a/Task/Hello-world-Standard-error/FutureBasic/hello-world-standard-error.basic b/Task/Hello-world-Standard-error/FutureBasic/hello-world-standard-error.basic new file mode 100644 index 0000000000..d481f57192 --- /dev/null +++ b/Task/Hello-world-Standard-error/FutureBasic/hello-world-standard-error.basic @@ -0,0 +1 @@ +alert 1,NSAlertStyleCritical,@"ERROR",@"",@"Goodbye World!" diff --git a/Task/Hello-world-Standard-error/Langur/hello-world-standard-error.langur b/Task/Hello-world-Standard-error/Langur/hello-world-standard-error.langur index 3e78e993c5..b8c0747ee1 100644 --- a/Task/Hello-world-Standard-error/Langur/hello-world-standard-error.langur +++ b/Task/Hello-world-Standard-error/Langur/hello-world-standard-error.langur @@ -1 +1 @@ -writelnErr "Goodbye, world." +writelnErr "Houston, we have a problem." diff --git a/Task/Hello-world-Standard-error/Wren/hello-world-standard-error.wren b/Task/Hello-world-Standard-error/Wren/hello-world-standard-error.wren index 6a71f0c607..fd53c2ca9d 100644 --- a/Task/Hello-world-Standard-error/Wren/hello-world-standard-error.wren +++ b/Task/Hello-world-Standard-error/Wren/hello-world-standard-error.wren @@ -1 +1,3 @@ -Fiber.abort("Goodbye, World!") +import "io" for Stderr + +Stderr.print("Goodbye, World!") diff --git a/Task/Hello-world-Text/LLVM/hello-world-text.llvm b/Task/Hello-world-Text/LLVM/hello-world-text.llvm index ceedc75fe4..c9ac842688 100644 --- a/Task/Hello-world-Text/LLVM/hello-world-text.llvm +++ b/Task/Hello-world-Text/LLVM/hello-world-text.llvm @@ -1,11 +1,11 @@ ; const char str[14] = "Hello World!\00" -@.str = private unnamed_addr constant [14 x i8] c"Hello, world!\00" +@str = private unnamed_addr constant [14 x i8] c"Hello, world!\00" ; declare extern `puts` method declare i32 @puts(i8*) nounwind define i32 @main() { - call i32 @puts( i8* getelementptr ([14 x i8]* @str, i32 0,i32 0)) + call i32 @puts( i8* getelementptr ([14 x i8], [14 x i8]* @str, i32 0,i32 0)) ret i32 0 } diff --git a/Task/Hello-world-Text/M2000-Interpreter/hello-world-text.m2000 b/Task/Hello-world-Text/M2000-Interpreter/hello-world-text.m2000 index 344c7f6491..095ca03aef 100644 --- a/Task/Hello-world-Text/M2000-Interpreter/hello-world-text.m2000 +++ b/Task/Hello-world-Text/M2000-Interpreter/hello-world-text.m2000 @@ -1,3 +1,4 @@ -Print "Hello World!" \\ printing on columns, in various ways defined by last $() for specific layer -Print $(4),"Hello World!" \\ proportional printing using columns, expanded to a number of columns as the length of string indicates. -Report "Hello World!" \\ proportional printing with word wrap, for text, can apply justification and rendering a range of text lines +module HelloWorld { + print "Hello World!" +} +HelloWorld diff --git a/Task/Hello-world-Text/Retro/hello-world-text.retro b/Task/Hello-world-Text/Retro/hello-world-text.retro index bea2713ce6..6ba876ba35 100644 --- a/Task/Hello-world-Text/Retro/hello-world-text.retro +++ b/Task/Hello-world-Text/Retro/hello-world-text.retro @@ -1 +1 @@ -'Hello_world! s:put +'Hello_world! s:put nl diff --git a/Task/Hello-world-Text/YAMLScript/hello-world-text.ys b/Task/Hello-world-Text/YAMLScript/hello-world-text.ys index 0432ff6961..11f7569ea9 100644 --- a/Task/Hello-world-Text/YAMLScript/hello-world-text.ys +++ b/Task/Hello-world-Text/YAMLScript/hello-world-text.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 say: "Hello, world!" diff --git a/Task/Hello-world-Text/Zig/hello-world-text.zig b/Task/Hello-world-Text/Zig/hello-world-text.zig index 6090c0bd6c..bde0254043 100644 --- a/Task/Hello-world-Text/Zig/hello-world-text.zig +++ b/Task/Hello-world-Text/Zig/hello-world-text.zig @@ -1,6 +1,6 @@ const std = @import("std"); -pub fn main() std.fs.File.WriteError!void { +pub fn main() !void { const stdout = std.io.getStdOut(); try stdout.writeAll("Hello world!\n"); diff --git a/Task/Here-document/EasyLang/here-document.easy b/Task/Here-document/EasyLang/here-document.easy index 9ad6f150d5..eb9d1a19cd 100644 --- a/Task/Here-document/EasyLang/here-document.easy +++ b/Task/Here-document/EasyLang/here-document.easy @@ -11,4 +11,4 @@ This is a 'raw' string with the following properties: - interpolation such as %(a) is also interpreted literally. - """ is also interpreted literally. -`Have fun!` +Have fun! diff --git a/Task/Here-document/FutureBasic/here-document.basic b/Task/Here-document/FutureBasic/here-document.basic new file mode 100644 index 0000000000..f673e6d968 --- /dev/null +++ b/Task/Here-document/FutureBasic/here-document.basic @@ -0,0 +1,5 @@ +text @"Monaco" // Mono spaced font +print @"Here" +print @" Doc" + +handleevents diff --git a/Task/Heronian-triangles/PascalABC.NET/heronian-triangles.pas b/Task/Heronian-triangles/PascalABC.NET/heronian-triangles.pas new file mode 100644 index 0000000000..7a00c8ae30 --- /dev/null +++ b/Task/Heronian-triangles/PascalABC.NET/heronian-triangles.pas @@ -0,0 +1,42 @@ +uses school; + +function hero(a, b, c: integer): real; +begin + var s := (a + b + c) / 2; + var a2 := s * (s - a) * (s - b) * (s - c); + result := if a2 > 0 then a2.sqrt else 0; +end; + +function is_heronian(a, b, c: integer): boolean; +begin + var h := hero(a, b, c); + result := (h > 0) and (h = h.Ceil); +end; + +function gcd3(x, y, z: integer) := gcd(gcd(x, y), z); + +function heronians(n: integer): sequence of (integer, integer, integer); +begin + for var x := 1 to n do + for var y := x to n do + for var z := y to n do + if (x + y > z) and (gcd3(x, y, z) = 1) and is_heronian(x, y, z) then + yield (x, y, z); +end; + +begin + var n := 200; + var hsorted := heronians(n).OrderBy(t -> hero(t[0], t[1], t[2])) + .ThenBy(t -> t[0] + t[1] + t[2]) + .ThenBy(t -> t[2]); + + writeln('Primitive Heronian triangles with sides up to ', n, ': ', hsorted.count); + writeln; + writeln('First ten when ordered by increasing area, then perimeter, then maximum sides:'); + foreach var h in hsorted.Take(10) do + writeln(h:12, ' perim: ', h[0] + h[1] + h[2]:3, ' area: ', hero(h[0], h[1], h[2]):3); + writeln; + writeln('All with area 210 subject to the previous ordering:'); + foreach var h in hsorted.Where(t -> hero(t[0], t[1], t[2]) = 210) do + writeln(h:12, ' perim: ', h[0] + h[1] + h[2]:3, ' area: ', hero(h[0], h[1], h[2]):3); +end. diff --git a/Task/Hex-words/PascalABC.NET/hex-words.pas b/Task/Hex-words/PascalABC.NET/hex-words.pas new file mode 100644 index 0000000000..82c258f36c --- /dev/null +++ b/Task/Hex-words/PascalABC.NET/hex-words.pas @@ -0,0 +1,38 @@ +uses System.Net, system.Globalization; + +function digroot(n: integer): integer; +begin + while n > 9 do + n := n.ToString.Select(x -> x.ToDigit).Sum; + result := n; +end; + +begin + var client := new WebClient(); + var text := client.DownloadString('http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'); + var words: sequence of string := text.ToWords(|#10, #13|); + words := words.Where(w -> w.length >= 4) + .Where(w -> w.All(c -> c in 'abcdef')); + + var results := new List<(string, integer, integer)>; + foreach var w in words do + begin + var wnum := integer.Parse(w, NumberStyles.HexNumber); + results.Add((w, wnum, digroot(wnum))); + end; + + println('Hex words in unixdict.txt:'); + println('Root Word Base 10'); + println('-' * 23); + foreach var a in results.OrderBy(t -> t[2]) do + writeln(a[2], a[0]:10, a[1]:11); + println('Total count of these words:', results.Count); + println; + println('Hex words with > 3 distinct letters:'); + println('Root Word Base 10'); + println('-' * 23); + results := results.Where(a -> (hset(a[0].ToCharArray).Count >= 4)).ToList; + foreach var a in results.OrderByDescending(t -> t[1]) do + writeln(a[2], a[0]:10, a[1]:11); + println('Total count of those words:', results.Count) +end. diff --git a/Task/Hickerson-series-of-almost-integers/Free-Pascal-Lazarus/hickerson-series-of-almost-integers.pas b/Task/Hickerson-series-of-almost-integers/Free-Pascal-Lazarus/hickerson-series-of-almost-integers.pas new file mode 100644 index 0000000000..f127845ab8 --- /dev/null +++ b/Task/Hickerson-series-of-almost-integers/Free-Pascal-Lazarus/hickerson-series-of-almost-integers.pas @@ -0,0 +1,35 @@ +{$mode ObjFPC} {$H+} + +Uses sysutils,math; + +Function fact(n : integer): qword; +Begin + If n <= 1 Then + result := 1 + Else + result := n * fact(n-1); +End; + +Function hickerson(n : integer): extended; +Begin + result := fact(n) / (2*power(ln(2),n+1)); +End; + +Function AlmostInteger(n : extended): boolean; + +Var firstdec : integer; +Begin + firstdec := trunc(n * 10) Mod 10; + result := (firstdec = 0) Or (firstdec = 9); +End; + +Var i : integer; + hick : extended; + +Begin + For i := 1 To 17 Do + Begin + hick := hickerson(i); + writeln('H(',i:2,') = ',hick:25:4,almostinteger(hick): 7); + End; +End. diff --git a/Task/Hickerson-series-of-almost-integers/PascalABC.NET/hickerson-series-of-almost-integers.pas b/Task/Hickerson-series-of-almost-integers/PascalABC.NET/hickerson-series-of-almost-integers.pas new file mode 100644 index 0000000000..0147f61abc --- /dev/null +++ b/Task/Hickerson-series-of-almost-integers/PascalABC.NET/hickerson-series-of-almost-integers.pas @@ -0,0 +1,12 @@ +## +var ln2: decimal := decimal.Parse('0.693147180559945309417232121458'); +var h := decimal(0.5) / ln2; + +for var i := 1 to 17 do +begin + h := h * i / ln2; + var w := BigInteger(h); + var d := (h - decimal(w)).ToString.Substring(2, 1); + + Writeln('n: ', i:2, ' h: ', h, ' Nearly integer: ', (d = '0') or (d = '9')); +end; diff --git a/Task/Higher-order-functions/REXX/higher-order-functions-1.rexx b/Task/Higher-order-functions/REXX/higher-order-functions-1.rexx new file mode 100644 index 0000000000..11f07018d9 --- /dev/null +++ b/Task/Higher-order-functions/REXX/higher-order-functions-1.rexx @@ -0,0 +1,27 @@ +include Settings + +Main: +say version; say 'Higher-order functions'; say +call Calculate '1/x',6 +call Calculate 'Sqrt(x)',2 +call Calculate 'Sin(x)',1 +call Calculate 'Cos(x)',2 +call Calculate 'Tan(x)',3 +call Calculate 'Sin(x)/Cos(x)-Tan(x)',1 +call Calculate 'x**2-3*x+Arcsin(x)-Sinh(x)/x-Pi()+E()',1/3 +exit + +Calculate: +procedure +parse arg ff,xx +say ff 'for x='xx 'makes' Evaluate(ff,xx)+0 +return + +Evaluate: +procedure +parse arg f,x +interpret 'return' f + +include Functions +include Constants +include Abend diff --git a/Task/Higher-order-functions/REXX/higher-order-functions.rexx b/Task/Higher-order-functions/REXX/higher-order-functions-2.rexx similarity index 100% rename from Task/Higher-order-functions/REXX/higher-order-functions.rexx rename to Task/Higher-order-functions/REXX/higher-order-functions-2.rexx diff --git a/Task/Hofstadter-Conway-$10-000-sequence/ALGOL-68/hofstadter-conway-$10-000-sequence.alg b/Task/Hofstadter-Conway-$10-000-sequence/ALGOL-68/hofstadter-conway-$10-000-sequence.alg index f73c6d20c7..562efb8774 100644 --- a/Task/Hofstadter-Conway-$10-000-sequence/ALGOL-68/hofstadter-conway-$10-000-sequence.alg +++ b/Task/Hofstadter-Conway-$10-000-sequence/ALGOL-68/hofstadter-conway-$10-000-sequence.alg @@ -3,8 +3,8 @@ BEGIN [max]INT a list; INT k1 := 2, lg2 := 1, - v := a list[1] := a list[2] := 1; # Concurrent declaration and assignment in declarations are allowed # - + v := a list[1] := a list[2] := 1; # Concurrent declaration and assignment # + # in declarations are allowed # INT nmax; LONG REAL amax := 0.0; @@ -13,15 +13,16 @@ BEGIN FOR n FROM 3 TO max DO v := a list[n] := a list[v] + a list[n-v]; - ( amax < v/n | amax := v/n; nmax := n ); # When given a Boolean as the 1st expression, ( | ) is the short form of IF...THEN...FI # - - IF v/n >= 0.55 THEN # This is the equivalent full form of the above construct # + ( amax < v/n | amax := v/n; nmax := n ); # When given a Boolean as the 1st expression, # + # ( | ) is the short form of IF...THEN...FI # + IF v/n >= 0.55 THEN # This is the equivalent full form of the above construct # mallows number := n FI; IF ABS(BIN k1 AND BIN n) = 0 THEN # 'BIN' converts an INT type to a BITS type; In this context, 'ABS' reverses that operation # - printf(($"Maximum between 2^"g(0)" and 2^"g(0)" is about "g(-10,8)" at "g(0)l$, lg2,lg2+1, amax, nmax)); + print(("Maximum between 2^",whole(lg2,0)," and 2^",whole(lg2+1,0)," is about ",fixed(amax,-10,8))); + print((" at ",whole(nmax,0),newline)); amax := 0; lg2 PLUSAB 1 # 'PLUSAB' (plus-and-becomes) has the short form +:= # FI; @@ -30,7 +31,4 @@ BEGIN mallows number # the result of the last expression evaluated is returned as the result of the PROC # END; -INT mallows number = do sqnc(2**20); # This definition of 'mallows number' does not clash with the variable - of the same name inside PROC do sqnc - they are in different scopes# - -printf(($"You too might have won $1000 with an answer of n = "g(0)$, mallows number)) +print(("You too might have won $1000 with an answer of n = ", whole(do sqnc(2**20),0))) diff --git a/Task/Hofstadter-Conway-$10-000-sequence/PascalABC.NET/hofstadter-conway-$10-000-sequence.pas b/Task/Hofstadter-Conway-$10-000-sequence/PascalABC.NET/hofstadter-conway-$10-000-sequence.pas new file mode 100644 index 0000000000..2cae58c01e --- /dev/null +++ b/Task/Hofstadter-Conway-$10-000-sequence/PascalABC.NET/hofstadter-conway-$10-000-sequence.pas @@ -0,0 +1,22 @@ +[cache] +function hof(n: integer): integer; +begin + if n < 3 then result := 1 + else result := hof(hof(n - 1)) + hof(n - hof(n - 1)) +end; + +begin + for var nmax := 1 to 19 do + begin + var amax := 0.0; + for var n := 1 shl nmax to 1 shl (nmax + 1) do + amax := max(amax, hof(n) / n); + writeln('Maximum between 2^', nmax, ' and 2^', nmax + 1, ' was ', amax); + end; + + var prize := 1 shl 20; + repeat + prize -= 1; + until (hof(prize) / prize >= 0.55); + println('Mallows'' number =', prize); +end. diff --git a/Task/Hofstadter-Figure-Figure-sequences/PascalABC.NET/hofstadter-figure-figure-sequences.pas b/Task/Hofstadter-Figure-Figure-sequences/PascalABC.NET/hofstadter-figure-figure-sequences.pas new file mode 100644 index 0000000000..12cfa59ae1 --- /dev/null +++ b/Task/Hofstadter-Figure-Figure-sequences/PascalABC.NET/hofstadter-figure-figure-sequences.pas @@ -0,0 +1,31 @@ +function ffs: sequence of integer; forward; + +function ffr: sequence of integer; +begin + var n := 1; + yield n; + foreach var s in ffs do + begin + n += s; + yield n; + end; +end; + +function ffs: sequence of integer; +begin + yield 2; + yield 4; + var u := 5; + foreach var r in ffr do + begin + if r <= u then continue; + foreach var x in (u..r - 1) do yield x; + u := r + 1; + end; +end; + +begin + ffr.Take(10).Println; + var a := ffr.Take(40) + ffs.Take(960); + (1..1000).SequenceEqual(a.Sorted).Println; +end. diff --git a/Task/Hofstadter-Q-sequence/ALGOL-68/hofstadter-q-sequence.alg b/Task/Hofstadter-Q-sequence/ALGOL-68/hofstadter-q-sequence.alg index 071be33dcf..02d0922aa4 100644 --- a/Task/Hofstadter-Q-sequence/ALGOL-68/hofstadter-q-sequence.alg +++ b/Task/Hofstadter-Q-sequence/ALGOL-68/hofstadter-q-sequence.alg @@ -1,24 +1,16 @@ -#!/usr/local/bin/a68g --script # - -INT n = 100000; -main: -( - INT flip; - [n]INT q; +BEGIN + [100000]INT q; + INT flips := 0; q[1] := q[2] := 1; - - FOR i FROM 3 TO n DO - q[i] := q[i - q[i - 1]] + q[i - q[i - 2]] OD; + FOR i FROM 3 TO UPB q DO + q[i] := q[i - q[i - 1]] + q[i - q[i - 2]]; + IF q[i] < q[i - 1] THEN flips +:= 1 FI + OD; FOR i TO 10 DO - printf(($g(0)$, q[i], $b(l,x)$, i = 10)) OD; + print((whole(q[i],0), IF i = 10 THEN newline ELSE space FI)) OD; - printf(($g(0)l$, q[1000])); - - flip := 0; - FOR i TO n-1 DO - flip +:= ABS (q[i] > q[i + 1]) OD; - - printf(($"flips: "g(0)l$, flip)) -) + print((whole(q[1000],0), newline)); + print(("flips: ", whole(flips,0), newline)) +END diff --git a/Task/Hofstadter-Q-sequence/FutureBasic/hofstadter-q-sequence.basic b/Task/Hofstadter-Q-sequence/FutureBasic/hofstadter-q-sequence.basic new file mode 100644 index 0000000000..c9f3691860 --- /dev/null +++ b/Task/Hofstadter-Q-sequence/FutureBasic/hofstadter-q-sequence.basic @@ -0,0 +1,19 @@ +_limit = 100000 + +Long Q(_limit), i, count = 0 + +Q(1) = 1 +Q(2) = 1 +For i = 3 To _limit + Q(i) = Q(i-Q(i-1)) + Q(i-Q(i-2)) + If Q(i) < Q(i-1) Then count += 1 +Next i + +Print "First 10 elements:"; +For i = 1 To 10 + Print str$(Q(i)) + " "; +Next i +Print +Print "Q(1000) is "; Q(1000) +Print "There were" + str$(count) + " inversions" +handleevents diff --git a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-2.hs b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-2.hs index 37c7f28e2d..3a361b185b 100644 --- a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-2.hs +++ b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-2.hs @@ -1,21 +1,13 @@ -import Data.Array +douglasHofstadter :: Int -> [Int] +douglasHofstadter m = reverse (dSeqEffect [1,1] 2 m) + where + dSeqEffect xs n m | n > m = xs + | otherwise = dSeqEffect (((xs !! (xs !! (n - 1))) + (xs !! (n - (xs !! (n - 1)))) ) : xs) (n + 1) m -qSequence n = arr - where - arr = listArray (1,n) $ 1:1: map g [3..n] - g i = arr!(i - arr!(i-1)) + - arr!(i - arr!(i-2)) +-- main +getIntArg :: IO Int +getIntArg = fmap (read . head) getArgs -gradualth m k arr -- gradually precalculate m-th item - | m <= v = pre `seq` arr!m -- in steps of k - where -- to prevent STACK OVERFLOW - pre = foldl1 (\a b-> a `seq` arr!b) [u,u+k..m] - (u,v) = bounds arr - -qSeqTest m n = let arr = qSequence $ max m n in - ( take 10 . elems $ arr -- 10 first items - , gradualth m 10000 $ arr -- m-th item - , length . filter (> 0) -- reversals in n items - . _S (zipWith (-)) tail . take n . elems $ arr ) - -_S f g x = f x (g x) +main = do + args <- getIntArg + print (douglasHofstadter args) diff --git a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-3.hs b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-3.hs index 162d5cee47..37c7f28e2d 100644 --- a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-3.hs +++ b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-3.hs @@ -1,7 +1,21 @@ -Prelude Main> qSeqTest 1000 100000 -- reversals in 100,000 -([1,1,2,3,3,4,5,5,6,6],502,49798) -(0.09 secs, 18879708 bytes) +import Data.Array -Prelude Main> qSeqTest 1000000 100000 -- 1,000,000-th item -([1,1,2,3,3,4,5,5,6,6],512066,49798) -(2.80 secs, 87559640 bytes) +qSequence n = arr + where + arr = listArray (1,n) $ 1:1: map g [3..n] + g i = arr!(i - arr!(i-1)) + + arr!(i - arr!(i-2)) + +gradualth m k arr -- gradually precalculate m-th item + | m <= v = pre `seq` arr!m -- in steps of k + where -- to prevent STACK OVERFLOW + pre = foldl1 (\a b-> a `seq` arr!b) [u,u+k..m] + (u,v) = bounds arr + +qSeqTest m n = let arr = qSequence $ max m n in + ( take 10 . elems $ arr -- 10 first items + , gradualth m 10000 $ arr -- m-th item + , length . filter (> 0) -- reversals in n items + . _S (zipWith (-)) tail . take n . elems $ arr ) + +_S f g x = f x (g x) diff --git a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs index 40d00cdae6..162d5cee47 100644 --- a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs +++ b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs @@ -1,16 +1,7 @@ -q = qq (listArray (1,2) [1,1]) 1 where - qq ar n = (arr!n) : qq arr (n+1) where - l = snd (bounds ar) - step n =arr!(n - (fromIntegral (arr!(n - 1)))) + - arr!(n - (fromIntegral (arr!(n - 2)))) - arr :: Array Int Integer - arr | n <= l = ar - | otherwise = listArray (1, l*2)$ - ([ar!i | i <- [1..l]] ++ - [step i | i <- [l+1..l*2]]) +Prelude Main> qSeqTest 1000 100000 -- reversals in 100,000 +([1,1,2,3,3,4,5,5,6,6],502,49798) +(0.09 secs, 18879708 bytes) -main = do - putStr("first 10: "); print (take 10 q) - putStr("1000-th: "); print (q !! 999) - putStr("flips: ") - print $ length $ filter id $ take 100000 (zipWith (>) q (tail q)) +Prelude Main> qSeqTest 1000000 100000 -- 1,000,000-th item +([1,1,2,3,3,4,5,5,6,6],512066,49798) +(2.80 secs, 87559640 bytes) diff --git a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs index d7722cbb4d..40d00cdae6 100644 --- a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs +++ b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs @@ -1,21 +1,16 @@ -import Data.Array -import Data.Int (Int64) +q = qq (listArray (1,2) [1,1]) 1 where + qq ar n = (arr!n) : qq arr (n+1) where + l = snd (bounds ar) + step n =arr!(n - (fromIntegral (arr!(n - 1)))) + + arr!(n - (fromIntegral (arr!(n - 2)))) + arr :: Array Int Integer + arr | n <= l = ar + | otherwise = listArray (1, l*2)$ + ([ar!i | i <- [1..l]] ++ + [step i | i <- [l+1..l*2]]) -q = qq [listArray (1,2) [1,1]] 1 where - qq a n = seek aa n : qq aa (1 + n) where - aa | n <= l = a - | otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a - where - l = snd (bounds $ head a) - lst = seek a (l-1):seek a l:(ext lst (l+1)) - ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i) - g = seek aa - seek (ar:ars) n - | n >= fst (bounds ar) = ar ! n - | otherwise = seek ars n - --- Only a perf test. Task can be done exactly the same as above -main = print $ sum qqq - where - qqq :: [Int64] - qqq = map fromIntegral $ take 3000000 q +main = do + putStr("first 10: "); print (take 10 q) + putStr("1000-th: "); print (q !! 999) + putStr("flips: ") + print $ length $ filter id $ take 100000 (zipWith (>) q (tail q)) diff --git a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-6.hs b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-6.hs new file mode 100644 index 0000000000..d7722cbb4d --- /dev/null +++ b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-6.hs @@ -0,0 +1,21 @@ +import Data.Array +import Data.Int (Int64) + +q = qq [listArray (1,2) [1,1]] 1 where + qq a n = seek aa n : qq aa (1 + n) where + aa | n <= l = a + | otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a + where + l = snd (bounds $ head a) + lst = seek a (l-1):seek a l:(ext lst (l+1)) + ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i) + g = seek aa + seek (ar:ars) n + | n >= fst (bounds ar) = ar ! n + | otherwise = seek ars n + +-- Only a perf test. Task can be done exactly the same as above +main = print $ sum qqq + where + qqq :: [Int64] + qqq = map fromIntegral $ take 3000000 q diff --git a/Task/Hofstadter-Q-sequence/Kotlin/hofstadter-q-sequence.kts b/Task/Hofstadter-Q-sequence/Kotlin/hofstadter-q-sequence-1.kts similarity index 100% rename from Task/Hofstadter-Q-sequence/Kotlin/hofstadter-q-sequence.kts rename to Task/Hofstadter-Q-sequence/Kotlin/hofstadter-q-sequence-1.kts diff --git a/Task/Hofstadter-Q-sequence/Kotlin/hofstadter-q-sequence-2.kts b/Task/Hofstadter-Q-sequence/Kotlin/hofstadter-q-sequence-2.kts new file mode 100644 index 0000000000..ac07d6cc8e --- /dev/null +++ b/Task/Hofstadter-Q-sequence/Kotlin/hofstadter-q-sequence-2.kts @@ -0,0 +1,24 @@ +fun Q(n: Int): List { + val mem = mutableMapOf().also { + it[1] = 1 + it[2] = 1 + } + q(n, mem) + return mem.values.toList() +} + +private fun q(n: Int, mem: MutableMap): Int { + if (!mem.containsKey(n)) { + mem[n] = + q(n - q(n - 1, mem), mem) + q(n - q(n - 2, mem), mem) + } + return mem[n]!! +} + +fun main() { + val n = 1000 + Q(n).also { qList -> + println("Q[1..10] = ${qList.take(10)}") + println("Q($n) = ${qList[1000 - 1]}") // 502 + } +} diff --git a/Task/Hofstadter-Q-sequence/PascalABC.NET/hofstadter-q-sequence.pas b/Task/Hofstadter-Q-sequence/PascalABC.NET/hofstadter-q-sequence.pas new file mode 100644 index 0000000000..6c1be48d54 --- /dev/null +++ b/Task/Hofstadter-Q-sequence/PascalABC.NET/hofstadter-q-sequence.pas @@ -0,0 +1,16 @@ +## +var q := |1, 1|.ToList; +for var n := 2 to 100_000 do + q.add(q[n - q[n - 1]] + q[n - q[n - 2]]); + +q.take(10).println; +assert(q.Take(10).SequenceEqual(|1, 1, 2, 3, 3, 4, 5, 5, 6, 6|)); + +q[999].println; +assert(q[999] = 502); + +var lessCount := 0; +for var n := 1 to 100_000 do + if q[n] < q[n - 1] then + lessCount += 1; +lessCount.Println; diff --git a/Task/Honeycombs/Nim/honeycombs.nim b/Task/Honeycombs/Nim/honeycombs.nim index 0069221f0f..8a8f5cbdab 100644 --- a/Task/Honeycombs/Nim/honeycombs.nim +++ b/Task/Honeycombs/Nim/honeycombs.nim @@ -1,7 +1,23 @@ -import lenientops, math, random, sequtils, strutils, tables +import std/[lenientops, math, random, sequtils, strutils, tables] -import gintro/[gobject, gdk, gtk, gio, cairo] -import gintro/glib except PI +import gtk2, gdk2, glib2, cairo + + +############################################################################### +# Missing gtk2 definition. + +when defined(win32): + const lib = "libgtk-win32-2.0-0.dll" +elif defined(macosx): + const lib = "(libgtk-quartz-2.0.0.dylib|libgtk-x11-2.0.dylib)" +else: + const lib = "libgtk-x11-2.0.so(|.0)" + +proc setCanFocus(widget: PWidget; canFocus: bool) {.cdecl, + importc: "gtk_widget_set_can_focus", dynlib: lib.} + + +############################################################################### const Size = 308 # Size of drawing area. @@ -12,44 +28,36 @@ const type - Letter = range['A'..'Z'] - # Description of a hexagon. Hexagon = object cx, cy: float - letter: Letter + letter: char selected: bool # Description of the honeycomb. - HoneyComb = ref object + HoneyComb = object hexagons: array[NHexagons, Hexagon] # List of hexagons. - indexes: tables.Table[char, int] # Mapping letter -> index of hexagon. - archive: seq[Letter] # List of selected letters. - label: Label # Label displaying the selected letters. + indexes: Table[char, int] # Mapping letter -> index of hexagon. + archive: seq[char] # List of selected letters. + label: PLabel # Label displaying the selected letters. -#--------------------------------------------------------------------------------------------------- -proc newHoneyComb(): HoneyComb = +proc initHoneyComb(): HoneyComb = ## Create a honeycomb. - - new(result) var letters = toSeq('A'..'Z') letters.shuffle() - for i in 0.. "; -30 INPUT LAT -40 PRINT "Enter longitude => "; -50 INPUT LNG -60 PRINT "Enter legal meridian => "; -70 INPUT REF -80 PRINT -90 LET PI = 4 * ATN(1) -100 LET SLAT = SIN(LAT * PI / 180) -110 PRINT " sine of latitude: "; USING "#.##^^^^"; SLAT -120 PRINT " diff longitude: "; USING "####.###"; LNG - REF -130 PRINT -140 PRINT "Hour, sun hour angle, dial hour line angle from 6am to 6pm" -150 FOR H% = -6 TO 6 -160 LET HRA = 15 * H% -170 LET HRA = HRA - (LNG - REF): ' correct for longitude difference -180 LET HLA = ATN(SLAT * TAN(HRA * PI / 180)) * 180 / PI -190 PRINT "HR="; USING "+##"; H%; -200 PRINT "; HRA="; USING "+###.###"; HRA; -210 PRINT "; HLA="; USING "+###.###"; HLA -220 NEXT H% -230 END +10 ' Horizontal sundial calculations +20 INPUT "Enter latitude => "; LAT +30 INPUT "Enter longitude => "; LNG +40 INPUT "Enter legal meridian => "; REF +50 PRINT +60 LET PI = 4 * ATN(1) +70 LET SLAT = SIN(LAT * PI / 180) +80 PRINT " sine of latitude: "; USING "#.##^^^^"; SLAT +90 PRINT " diff longitude: "; USING "####.###"; LNG - REF +100 PRINT +110 PRINT "Hour, sun hour angle, dial hour line angle from 6am to 6pm" +120 FOR H% = -6 TO 6 +130 LET HRA = 15 * H% +140 LET HRA = HRA - (LNG - REF) ' correct for longitude difference +150 LET HLA = ATN(SLAT * TAN(HRA * PI / 180)) * 180 / PI +160 PRINT "HR="; USING "+##"; H%; +170 PRINT "; HRA="; USING "+###.###"; HRA; +180 PRINT "; HLA="; USING "+###.###"; HLA +190 NEXT H% +200 END diff --git a/Task/Horizontal-sundial-calculations/JavaScript/horizontal-sundial-calculations-1.js b/Task/Horizontal-sundial-calculations/JavaScript/horizontal-sundial-calculations-1.js new file mode 100644 index 0000000000..bf19679c98 --- /dev/null +++ b/Task/Horizontal-sundial-calculations/JavaScript/horizontal-sundial-calculations-1.js @@ -0,0 +1,7 @@ + + + + + + + diff --git a/Task/Horizontal-sundial-calculations/JavaScript/horizontal-sundial-calculations-2.js b/Task/Horizontal-sundial-calculations/JavaScript/horizontal-sundial-calculations-2.js new file mode 100644 index 0000000000..364a0571bc --- /dev/null +++ b/Task/Horizontal-sundial-calculations/JavaScript/horizontal-sundial-calculations-2.js @@ -0,0 +1,41 @@ +// Horizontal sundial calculations + +function deg2rad(d) { + return d * Math.PI / 180; +} + +function rad2deg(r) { + return r / Math.PI * 180; +} + +document.write(""); +lat = prompt("Enter latitude"); +document.write("

Latitude: ", lat); +lng = prompt("Enter longitude"); +document.write("
Longitude: ", lng); +ref = prompt("Enter legal meridian"); +document.write("
Legal meridian: ", ref); +document.write("

"); +sLat = Math.sin(deg2rad(lat)); +document.write("

Sine of latitude: ", sLat.toFixed(5)); +document.write("
Diff longitude: ", (lng - ref).toFixed(5)); +document.write("

"); +document.write(""); +document.write(""); +document.write(""); +document.write(""); +document.write(""); +document.write("", + ""); +for (hour = -6; hour <= 6; hour++) { + hourAngle = 15 * hour - (lng - ref); + hourLineAngle = rad2deg(Math.atan(sLat * Math.tan(deg2rad(hourAngle)))); + document.write(""); + document.write(""); + document.write(""); + document.write(""); +} +document.write("
TimeSun hour angleDial hour line angle
", (hour + 12).toFixed(), ":00", hourAngle.toFixed(5), + "", hourLineAngle.toFixed(5), + "
"); +document.write(""); diff --git a/Task/Horizontal-sundial-calculations/PHP/horizontal-sundial-calculations.php b/Task/Horizontal-sundial-calculations/PHP/horizontal-sundial-calculations.php new file mode 100644 index 0000000000..d474be2cb0 --- /dev/null +++ b/Task/Horizontal-sundial-calculations/PHP/horizontal-sundial-calculations.php @@ -0,0 +1,28 @@ + '); +$lng = (float)readline('Enter longitude => '); +$ref = (float)readline('Enter legal meridian => '); +echo PHP_EOL; +$s_lat = sin(deg2rad($lat)); +echo ' sine of latitude: '.$s_lat.PHP_EOL; +echo ' diff longitude: '.($lng - $ref).PHP_EOL; +echo PHP_EOL; +echo 'Hour, sun hour angle, dial hour line angle from 6am to 6pm'.PHP_EOL; +for ($hour = -6; $hour <= 6; $hour++) { + $hour_angle = 15 * $hour; + $hour_angle = $hour_angle - ($lng - $ref); // correct for longitude difference + $hour_line_angle = rad2deg(atan($s_lat * tan(deg2rad($hour_angle)))); + echo 'HR='.dec_format($hour, 3, 0); + echo '; HRA='.dec_format($hour_angle, 8, 3); + echo '; HLA='.dec_format($hour_line_angle, 8, 3).PHP_EOL; +} +?> diff --git a/Task/Horizontal-sundial-calculations/PascalABC.NET/horizontal-sundial-calculations.pas b/Task/Horizontal-sundial-calculations/PascalABC.NET/horizontal-sundial-calculations.pas new file mode 100644 index 0000000000..8d18e7e8fa --- /dev/null +++ b/Task/Horizontal-sundial-calculations/PascalABC.NET/horizontal-sundial-calculations.pas @@ -0,0 +1,18 @@ +## +var lat := readlnreal('Enter latitude => '); +var lng := readlnreal('Enter longitude => '); +var med := readlnreal('Enter legal meridian => '); +println; + +var slat := sin(degToRad(lat)); +writeln(' sine of latitude: ', slat:5:3); +writeln(' diff longitude: ', lng - med:5:3); +println; +println('Hour, sun hour angle, dial hour line angle from 6am to 6pm'); + +for var h := -6 to 6 do +begin + var hra := 15 * h - lng + med; + var hla := radtodeg(arctan(slat * tan(degToRad(hra)))); + writeln('HR=', h:2, '; HRA=', hra:8:3, '; HLA=', hla:8:3); +end; diff --git a/Task/Horizontal-sundial-calculations/QBasic/horizontal-sundial-calculations.basic b/Task/Horizontal-sundial-calculations/QBasic/horizontal-sundial-calculations.basic new file mode 100644 index 0000000000..4822cf3a5c --- /dev/null +++ b/Task/Horizontal-sundial-calculations/QBasic/horizontal-sundial-calculations.basic @@ -0,0 +1,20 @@ +' Horizontal sundial calculations +INPUT "Enter latitude => "; Lat +INPUT "Enter longitude => "; Lng +INPUT "Enter legal meridian => "; Ref +PRINT +PI = 4 * ATN(1) +SLat = SIN(Lat * PI / 180) +PRINT " sine of latitude: "; USING "#.##^^^^"; SLat +PRINT " diff longitude: "; USING "####.###"; Lng - Ref +PRINT +PRINT "Hour, sun hour angle, dial hour line angle from 6am to 6pm" +FOR Hour% = -6 TO 6 + HourAngle = 15 * Hour% + HourAngle = HourAngle - (Lng - Ref): ' correct for longitude difference + HourLineAngle = ATN(SLat * TAN(HourAngle * PI / 180)) * 180 / PI + PRINT "HR="; USING "+##"; Hour%; + PRINT "; HRA="; USING "+###.###"; HourAngle; + PRINT "; HLA="; USING "+###.###"; HourLineAngle +NEXT Hour% +END diff --git a/Task/Horners-rule-for-polynomial-evaluation/Draco/horners-rule-for-polynomial-evaluation.draco b/Task/Horners-rule-for-polynomial-evaluation/Draco/horners-rule-for-polynomial-evaluation.draco new file mode 100644 index 0000000000..80ba616670 --- /dev/null +++ b/Task/Horners-rule-for-polynomial-evaluation/Draco/horners-rule-for-polynomial-evaluation.draco @@ -0,0 +1,14 @@ +proc horner([*]int coeff; int x) int: + int acc; + word i; + acc := 0; + for i from dim(coeff,1)-1 downto 0 do + acc := acc * x + coeff[i] + od; + acc +corp + +proc main() void: + [4]int coeff = (-19, 7, -4, 6); + writeln(horner(coeff, 3)) +corp diff --git a/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx b/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx index aa5cab3ea2..e565529a4c 100644 --- a/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx +++ b/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx @@ -1,19 +1,45 @@ -/*REXX program demonstrates using Horner's rule for polynomial evaluation. */ -numeric digits 30 /*use extra numeric precision. */ -parse arg x poly /*get value of X and the coefficients. */ -$= /*start with a clean slate equation. */ - do deg=0 until poly=='' /*get the equation's coefficients. */ - parse var poly c.deg poly; c.deg=c.deg/1 /*get equation coefficient & normalize.*/ - if c.deg>=0 then c.deg= '+'c.deg /*if ¬ negative, then prefix with a + */ - $=$ c.deg /*concatenate it to the equation. */ - if deg\==0 & c.deg\=0 then $=$'∙x^'deg /*¬1st coefficient & ¬0? Append X pow.*/ - $=$ ' ' /*insert some blanks, make it look nice*/ - end /*deg*/ -say ' x = ' x -say ' degree = ' deg -say ' equation = ' $ -a=c.deg /*A: is the accumulator (or answer). */ - do j=deg-1 by -1 for deg; a=a*x+c.j /*apply Horner's rule to the equations.*/ - end /*j*/ -say /*display a blank line for readability.*/ -say ' answer = ' a /*stick a fork in it, we're all done. */ +/* REXX --------------------------------------------------------------- +* 27.07.2012 Walter Pachl +* coefficients reversed to descending order of power +* I'm used to x**2+x-3 +* equation formatting prettified (coefficients 1 and 0) +*--------------------------------------------------------------------*/ + Numeric Digits 30 /* use extra numeric precision. */ + Parse Arg x poly /* get value of x and coefficients*/ + rpoly='' + Do p=0 To words(poly)-1 + rpoly=rpoly word(poly,words(poly)-p) + End + poly=rpoly + equ='' /* start with equation clean slate*/ + deg=words(poly)-1 + pdeg=deg + Do Until deg<0 /* get the equation's coefficients*/ + Parse Var poly c.deg poly /* in descending order of powers */ + c.deg=c.deg+0 /* normalize it */ + If c.deg>0 & deg0 Then /* build up the equation */ + equ=equ||prefix||term + deg=deg-1 + End + a=c.pdeg + Do p=pdeg To 1 By -1 /* apply Horner's rule. */ + pm1=p-1 + a=a*x+c.pm1 + End + Say ' x = ' x + Say ' degree = ' pdeg + Say ' equation = ' equ + Say ' ' + Say ' result = ' a diff --git a/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-2.rexx b/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-2.rexx index e565529a4c..b74d9bd5cb 100644 --- a/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-2.rexx +++ b/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-2.rexx @@ -1,45 +1,18 @@ -/* REXX --------------------------------------------------------------- -* 27.07.2012 Walter Pachl -* coefficients reversed to descending order of power -* I'm used to x**2+x-3 -* equation formatting prettified (coefficients 1 and 0) -*--------------------------------------------------------------------*/ - Numeric Digits 30 /* use extra numeric precision. */ - Parse Arg x poly /* get value of x and coefficients*/ - rpoly='' - Do p=0 To words(poly)-1 - rpoly=rpoly word(poly,words(poly)-p) - End - poly=rpoly - equ='' /* start with equation clean slate*/ - deg=words(poly)-1 - pdeg=deg - Do Until deg<0 /* get the equation's coefficients*/ - Parse Var poly c.deg poly /* in descending order of powers */ - c.deg=c.deg+0 /* normalize it */ - If c.deg>0 & deg0 Then /* build up the equation */ - equ=equ||prefix||term - deg=deg-1 - End - a=c.pdeg - Do p=pdeg To 1 By -1 /* apply Horner's rule. */ - pm1=p-1 - a=a*x+c.pm1 - End - Say ' x = ' x - Say ' degree = ' pdeg - Say ' equation = ' equ - Say ' ' - Say ' result = ' a +include Settings +say version; say 'Polynomial Horner''s rule'; say +call Evaluate '6 -4 7 -19',3 +call Evaluate '2',4 +call Evaluate '2 3',0 +call Evaluate '2 0 -3 0 4',5 +call Evaluate '1 2 3',Pi()+0 +exit + +Evaluate: +arg x,y +say Plst2form(x) '| x='y '=' Peval(x,y)+0 +return + +include Polynomial +include Functions +include Constants +include Abend diff --git a/Task/Horners-rule-for-polynomial-evaluation/Raku/horners-rule-for-polynomial-evaluation-2.raku b/Task/Horners-rule-for-polynomial-evaluation/Raku/horners-rule-for-polynomial-evaluation-2.raku index 17455ac1da..127c4def49 100644 --- a/Task/Horners-rule-for-polynomial-evaluation/Raku/horners-rule-for-polynomial-evaluation-2.raku +++ b/Task/Horners-rule-for-polynomial-evaluation/Raku/horners-rule-for-polynomial-evaluation-2.raku @@ -1,6 +1,5 @@ -multi horner(Numeric $c, $) { $c } -multi horner(Pair $c, $x) { - $c.key + $x * horner( $c.value, $x ) +multi horner(@c, $x) { + @c > 1 ?? @c.head + $x * samewith(@c.tail(*-1), $x) !! @c.pick } -say horner( [=>](-19, 7, -4, 6 ), 3 ); +say horner( [-19, 7, -4, 6 ], 3 ); diff --git a/Task/Horners-rule-for-polynomial-evaluation/Refal/horners-rule-for-polynomial-evaluation.refal b/Task/Horners-rule-for-polynomial-evaluation/Refal/horners-rule-for-polynomial-evaluation.refal new file mode 100644 index 0000000000..ca072c16c4 --- /dev/null +++ b/Task/Horners-rule-for-polynomial-evaluation/Refal/horners-rule-for-polynomial-evaluation.refal @@ -0,0 +1,8 @@ +$ENTRY Go { + = >; +}; + +Horner { + (e.X) = 0; + (e.X) (e.C) e.Cs = >>; +}; diff --git a/Task/Horners-rule-for-polynomial-evaluation/SETL/horners-rule-for-polynomial-evaluation.setl b/Task/Horners-rule-for-polynomial-evaluation/SETL/horners-rule-for-polynomial-evaluation.setl new file mode 100644 index 0000000000..abfc1e59e0 --- /dev/null +++ b/Task/Horners-rule-for-polynomial-evaluation/SETL/horners-rule-for-polynomial-evaluation.setl @@ -0,0 +1,11 @@ +program horners_rule; + print(horner([-19, 7, -4, 6], 3)); + + proc horner(coeff, x); + acc := 0; + loop for i in [#coeff, #coeff-1 .. 1] do + acc := acc * x + coeff(i); + end loop; + return acc; + end proc; +end program; diff --git a/Task/Horners-rule-for-polynomial-evaluation/UNIX-Shell/horners-rule-for-polynomial-evaluation.sh b/Task/Horners-rule-for-polynomial-evaluation/UNIX-Shell/horners-rule-for-polynomial-evaluation.sh new file mode 100644 index 0000000000..6650b786a9 --- /dev/null +++ b/Task/Horners-rule-for-polynomial-evaluation/UNIX-Shell/horners-rule-for-polynomial-evaluation.sh @@ -0,0 +1,13 @@ +horner() + if + local -i x=$1 + shift + (($#)) + then + local -i y=$1 + shift + echo $((y + x*$( horner $x "$@") )) + else echo 0 + fi + +horner 3 -19 7 -4 6 diff --git a/Task/Host-introspection/Wren/host-introspection-3.wren b/Task/Host-introspection/Wren/host-introspection-3.wren new file mode 100644 index 0000000000..4ee1fae58c --- /dev/null +++ b/Task/Host-introspection/Wren/host-introspection-3.wren @@ -0,0 +1,6 @@ +import "os" for Process + +var wordSize = Process.read("getconf LONG_BIT") +var endianness = Process.read("lscpu | grep \"Byte Order\"").split(":")[1].trimStart() +System.print("word size = %(wordSize) bits") +System.print("endianness = %(endianness)") diff --git a/Task/Hostname/Wren/hostname-1.wren b/Task/Hostname/Wren/hostname-1.wren deleted file mode 100644 index ef379c81bb..0000000000 --- a/Task/Hostname/Wren/hostname-1.wren +++ /dev/null @@ -1,6 +0,0 @@ -/* Hostname.wren */ -class Host { - foreign static name() // the code for this is provided by Go -} - -System.print(Host.name()) diff --git a/Task/Hostname/Wren/hostname-2.wren b/Task/Hostname/Wren/hostname-2.wren deleted file mode 100644 index 4227ab6330..0000000000 --- a/Task/Hostname/Wren/hostname-2.wren +++ /dev/null @@ -1,25 +0,0 @@ -/* Hostname.go */ -package main - -import ( - wren "github.com/crazyinfin8/WrenGo" - "os" -) - -type any = interface{} - -func hostname(vm *wren.VM, parameters []any) (any, error) { - name, _ := os.Hostname() - return name, nil -} - -func main() { - vm := wren.NewVM() - fileName := "Hostname.wren" - methodMap := wren.MethodMap{"static name()": hostname} - classMap := wren.ClassMap{"Host": wren.NewClass(nil, nil, methodMap)} - module := wren.NewModule(classMap) - vm.SetModule(fileName, module) - vm.InterpretFile(fileName) - vm.Free() -} diff --git a/Task/Hostname/Wren/hostname.wren b/Task/Hostname/Wren/hostname.wren new file mode 100644 index 0000000000..6a4cad7d44 --- /dev/null +++ b/Task/Hostname/Wren/hostname.wren @@ -0,0 +1,3 @@ +import "os" for Platform + +System.print(Platform.hostName) diff --git a/Task/Humble-numbers/PascalABC.NET/humble-numbers.pas b/Task/Humble-numbers/PascalABC.NET/humble-numbers.pas new file mode 100644 index 0000000000..4ea1f2542b --- /dev/null +++ b/Task/Humble-numbers/PascalABC.NET/humble-numbers.pas @@ -0,0 +1,25 @@ +## +function humbles: sequence of uint64; +begin + var s := hset(uint64(1)); + while True do + begin + var m := s.min; + yield m; + s -= m; + foreach var k in |2, 3, 5, 7| do s += k * m; + end; +end; + +println('The first 50 humble numbers are:'); +foreach var n in humbles.Take(50) index i do + write(n:4, if i mod 10 = 9 then #10 else ''); + +println; +println('Digits Count'); +for var dig := 1 to 18 do +begin + var count := humbles.SkipWhile(x -> x < 10 ** (dig - 1)) + .TakeWhile(x -> x < 10 ** dig).Count; + writeln(dig:2, count:10); +end; diff --git a/Task/Hunt-the-Wumpus/FutureBasic/hunt-the-wumpus.basic b/Task/Hunt-the-Wumpus/FutureBasic/hunt-the-wumpus.basic new file mode 100644 index 0000000000..714df4ab49 --- /dev/null +++ b/Task/Hunt-the-Wumpus/FutureBasic/hunt-the-wumpus.basic @@ -0,0 +1,229 @@ +// Hunt the Wumpus +// https://rosettacode.org/wiki/Hunt_the_Wumpus# + + +_w = 640 // window size width and height +_h = 400 +_window = 1 + +local fn BuildWindow + + CGRect r = fn cgrectmake(0,0,_w,_h) + window _Window, @"Hunt the Wumpus", r, NSWindowStyleMaskTitled + NSWindowStyleMaskMiniaturizable + windowcenter(_Window) + WindowSetBackgroundColor(_Window,fn ColorBlack) + WindowPrintViewSetTextInset( _window, 20) + + text ,14,fn colorWhite + +end fn + + +fn BuildWindow + + +//////////// Main Program ////////////// + +"Start" + +cls:restore + +data 7,13,19,12,18,20,16,17,19,11,14,18,13,15,18,9,14,16,1,15,17,10,16,20,6,11,19,8,12,17 +data 4,9,13,2,10,15,1,5,11,4,6,20,5,7,12,3,6,8,3,7,10,2,4,5,1,3,9,2,8,14 +data 1,2,3,1,3,2,2,1,3,2,3,1,3,1,2,3,2,1 + +uint32 i, j,tunnel(21,4),lost(7,4),targ,wump,player,bat1, bat2, pit1, pit2, d6, epi +player = int(rnd(20)) +uint32 arrows = 5 +CFStringRef choice + +for i = 1 to 20 //set up rooms + for j = 1 to 3 + read tunnel(i,j) + next j +next i + +for i = 1 to 6 //set up list of permuatations of 1-2-3 + for j = 1 to 3 + read lost(i,j) + next j +next i + + +//place wumpus, bats, and pits +do + wump = int(rnd(20)) +until wump <> player +do + pit1 = int(rnd(20)) +until pit1 <> player +do + pit2 = int(rnd(20)) +until pit2 <> player && pit2 <> pit1 +do + bat1 = int(rnd(20)) +until bat1 <> player && bat1 <> pit1 && bat1 <> pit2 +do + bat2 = int(rnd(20)) +until bat2 <> player && bat2 <> pit1 && bat2 <> pit2 && bat2 <> bat1 + +do + if player = wump + text ,,fn colorRed + print "You have been eaten by the Wumpus!" + Print: WindowPrintViewScrollToBottom( _window ) + goto "defeat" + end if + if player = pit1 || player = pit2 + text ,,fn colorRed + print "Aaaaaaaaaaa! You have fallen into a bottomless pit." + Print: WindowPrintViewScrollToBottom( _window ) + goto "defeat" + end if + if player = bat1 || player = bat2 + text ,,fn colorOrange + print "A bat has carried you into another empty room." + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + do + player = (rnd(20)) + until player <> wump && player <> pit1 && player <> pit2 && player <> bat1 && player <> bat2 + end if + + print + text ,,fn colorGreen + print "You are in room number" + str$(player) + ". There are tunnels to rooms"¬ + + str$(tunnel(player,1)) + "," str$(tunnel(player,2)) + " and" +str$(tunnel(player,3)) + if (tunnel(player,1)) + (tunnel(player,2)) + (tunnel(player,3)) = 0 then arrows = 5 : goto "Start" + text ,,fn colorYellow + print "You have" + str$(arrows) + " arrows left." + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + + d6 = int(rnd(6)) + for i = 1 to 3 + epi = tunnel(player,lost(d6,i)) + if epi = wump + text ,,fn colorRed + print "You smell something terrible nearby." + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + end if + if epi = bat1 || epi = bat2 + text ,,fn colorRed + print "You hear a rustling." + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + end if + if epi = pit1 || epi = pit2 + print "You feel a cold wind blowing from a nearby cavern." + Print: WindowPrintViewScrollToBottom( _window ) + end if + next i + "choices" + print + print "What would you like to do?" + Print: WindowPrintViewScrollToBottom( _window ) + + choice = input %(_w/2 - 260 , _h + 20),@"Type A to shoot an arrow, or a number to move to another room. ( or Q to quit )" + + select case left(choice,1) + + case @"q", @"Q" , @"x" , @"X" + end + + case @"a", @"A" + + CFStringRef targString + targString = input %(_w/2 - 140 , _h + 20), @"Which room would you like to shoot into? " + targ = fn StringIntegerValue(targString) + + print "You shot an arrow into room " + str$(targ) + + if targ = player + text ,,fn colorRed + print "You shot yourself. Why would you want to do such a thing?" + Print: WindowPrintViewScrollToBottom( _window ) + goto "defeat" + end if + + text ,,fn colorGreen + if targ = wump then goto "victory" + + if targ = tunnel(player,1) || targ = tunnel(player,2) || targ = tunnel(player,3) + text ,,fn colorYellow + print "The Wumpus awakes!" + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + if rnd(100) <= 75 + print "He moves to a nearby cavern." + Print: WindowPrintViewScrollToBottom( _window ) + short wumpRnd + wumpRnd = Int(Rnd(3)) + wump = Tunnel(wump,wumpRnd) + else + print "He goes back to sleep." + Print: WindowPrintViewScrollToBottom( _window ) + end if + else + text ,,fn colorRed + print "You can't shoot that room from here." + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + goto "choices" + end if + arrows -= 1 + + case @"0", @"1" ,@"2", @"3", @"4", @"5", @"6", @"7", @"8", @"9" + + targ = fn StringIntegerValue(choice) + if targ = player then print "You are already there." + + if targ = tunnel(player,1) || targ = tunnel(player,2) || targ = tunnel(player,3) + print using "You walk to room ##"; targ + player = targ + else + text ,,fn colorOrange + print "You can't get there from here." + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + end if + case else + text ,,fn colorRed + print "You are making no sense." + text ,,fn colorWhite + Print: WindowPrintViewScrollToBottom( _window ) + end select +until arrows = 0 +text ,,fn colorRed +print "You have run out of arrows!" +Print: WindowPrintViewScrollToBottom( _window ) +"defeat" +text ,,fn colorRed +print "You lose! Better luck next time." +Print: WindowPrintViewScrollToBottom( _window ) + +goto "End" + +"victory" +text ,20,fn colorGreen +print "You have slain the Wumpus!" +print "You won!" +Print: WindowPrintViewScrollToBottom( _window ) + +"End" + +text ,14,fn colorWhite +choice = input %(_w/2 -140 , _h + 20),@"Hit Return for another. ( or Q to quit )" + +select case left(choice,1) + + case @"q", @"Q" , @"x" , @"X" + end + + case else arrows = 5: goto "Start" + +end select + + +handleevents diff --git a/Task/I-before-E-except-after-C/BQN/i-before-e-except-after-c.bqn b/Task/I-before-E-except-after-C/BQN/i-before-e-except-after-c.bqn new file mode 100644 index 0000000000..dbbec600b8 --- /dev/null +++ b/Task/I-before-E-except-after-C/BQN/i-before-e-except-after-c.bqn @@ -0,0 +1,15 @@ +Func ← { + Filter ← {+´(∨´∘(𝕨⊸⍷))¨𝕩} + nei ← "ei" Filter 𝕩 + cei ← "cei" Filter 𝕩 + nie ← "ie" Filter 𝕩 + cie ← "cie" Filter 𝕩 + •Show (nie < 2×cie)◶⟨ + "I before E when not preceded by C is plausible" + "I before E when not preceded by C is not plausible" + ⟩@ + (nei > 2×cei)◶⟨ + "E before I when preceded by C is plausible" + "E before I when preceded by C is not plausible" + ⟩@ +} diff --git a/Task/I-before-E-except-after-C/Langur/i-before-e-except-after-c.langur b/Task/I-before-E-except-after-C/Langur/i-before-e-except-after-c.langur index 5b64809d01..4b8c215e68 100644 --- a/Task/I-before-E-except-after-C/Langur/i-before-e-except-after-c.langur +++ b/Task/I-before-E-except-after-C/Langur/i-before-e-except-after-c.langur @@ -1,4 +1,4 @@ -val words = split("\n", readfile("./data/unixdict.txt")) -> rest +val words = less(split(readfile("./data/unixdict.txt"), by="\n"), of=1) val print = fn*(support, against) { val ratio = support / against diff --git a/Task/IBAN/ALGOL-68/iban.alg b/Task/IBAN/ALGOL-68/iban.alg new file mode 100644 index 0000000000..93dc56bbc2 --- /dev/null +++ b/Task/IBAN/ALGOL-68/iban.alg @@ -0,0 +1,104 @@ +BEGIN # validate IBAN numbers # + + # country code and expected bank account length for IBAN codes # + MODE IBANCOUNTRY = STRUCT( [ 1 : 2 ]CHAR code, INT length ); + + []IBANCOUNTRY country info = + ( ("AL",28), ("AD",24), ("AT",20), ("AZ",28), ("BE",16), ("BH",22), ("BA",20), ("BR",29) + , ("BG",22), ("CR",21), ("HR",21), ("CY",28), ("CZ",24), ("DK",18), ("DO",28), ("EE",20) + , ("FO",18), ("FI",18), ("FR",27), ("GE",22), ("DE",22), ("GI",23), ("GR",27), ("GL",18) + , ("GT",28), ("HU",28), ("IS",26), ("IE",22), ("IL",23), ("IT",27), ("KZ",20), ("KW",30) + , ("LV",21), ("LB",28), ("LI",21), ("LT",20), ("LU",20), ("MK",19), ("MT",31), ("MR",27) + , ("MU",30), ("MC",27), ("MD",24), ("ME",22), ("NL",18), ("NO",15), ("PK",24), ("PS",29) + , ("PL",28), ("PT",25), ("RO",24), ("SM",27), ("SA",24), ("RS",22), ("SK",24), ("SI",19) + , ("ES",24), ("SE",24), ("CH",21), ("TN",24), ("TR",26), ("AE",23), ("GB",22), ("VG",24) + ); + + # returns "" if s could be a valid IBAN, an error message otherwise # + OP POSSIBLEIBAN = ( STRING s )STRING: + BEGIN + BOOL is valid := TRUE; + STRING result := ""; + # remove spaces and check we only have digits and spaces # + STRING iban := ""; + FOR s pos FROM LWB s TO UPB s WHILE is valid DO + CHAR c = s[ s pos ]; + IF c /= " " THEN + IF NOT ( is valid := ( c >= "A" AND c <= "Z" ) OR ( c >= "0" AND c <= "9" ) ) + THEN result := "Invalid character: " + c + FI; + iban +:= c + FI + OD; + IF is valid THEN + # OK so far - check the length matches the country code # + INT supplied length = ( UPB iban - LWB iban ) + 1; + is valid := FALSE; + IF supplied length <= 4 + THEN result := "Code is too short" + ELSE # enough characters for a country code and a check sum # + INT expected length := -1; + STRING supplied country = iban[ LWB iban : LWB iban + 1 ]; + FOR c pos FROM LWB country info TO UPB country info WHILE NOT is valid DO + IF is valid := code OF country info[ c pos ] = supplied country THEN + expected length := length OF country info[ c pos ] + FI + OD; + IF NOT is valid + THEN result := "Not a known IBAN country: " + supplied country + ELIF NOT ( is valid := expected length = supplied length ) + THEN result := "Expected code length: " + whole( expected length, 0 ) + + " but actual length is: " + whole( supplied length, 0 ) + ELSE # OK so far - check the checksum # + STRING rearranged iban = iban[ LWB iban + 4 : ] + iban[ LWB iban : LWB iban + 3 ]; + LONG LONG INT numeric iban := 0; + FOR c pos FROM LWB rearranged iban TO UPB rearranged iban DO + CHAR c = rearranged iban[ c pos ]; + IF c >= "0" AND c <= "9" THEN + numeric iban *:= 10 +:= ( ABS c - ABS "0" ) + ELSE + numeric iban *:= 100 +:= ( ABS c - ABS "A" ) + 10 + FI + OD; + IF NOT ( is valid := numeric iban MOD 97 = 1 ) + THEN result := "Incorrect checksum" + FI + FI + FI + FI; + IF is valid THEN "" ELIF result = "" THEN "Unknown error" ELSE result FI + END # POSSIBLEIBAN # ; + + BEGIN # tests # + []STRING valid codes = ( "GB82 WEST 1234 5698 7654 32", "GB82WEST12345698765432" + , "GR16 0110 1250 0000 0001 2300 695", "GB29 NWBK 6016 1331 9268 19" + , "SA03 8000 0000 6080 1016 7519", "CH93 0076 2011 6238 5295 7" + , "IL62 0108 0000 0009 9999 999" + ); + []STRING invalid codes = ( "gb82 west 1234 5698 7654 32" # invalid characters # + , "GB82 TEST 1234 5698 7654 32" # invalid check digits # + , "IL62-0108-0000-0009-9999-999" # invalid characters # + , "US12 3456 7890 0987 6543 210" # invalid country code # + , "GR16 0110 1250 0000 0001 2300 695X" # invalid code length # + , "" # code is too short # + , "G2" # code is too short # + , "GB271" # invalid code length # + ); + FOR t pos FROM LWB valid codes TO UPB valid codes DO + STRING code = valid codes[ t pos ]; + STRING message = POSSIBLEIBAN code; + IF message = "" + THEN print( ( "Possible IBAN: ", code, newline ) ) + ELSE print( ( "INVALID IBAN: ", code, ": UNEXPECTED ERROR: ", message, newline ) ) + FI + OD; + FOR t pos FROM LWB invalid codes TO UPB invalid codes DO + STRING code = invalid codes[ t pos ]; + STRING message = POSSIBLEIBAN code; + IF message = "" + THEN print( ( "POSSIBLE IBAN: ", code, " BUT EXPECTED AN ERROR MESSAGE", newline ) ) + ELSE print( ( "Invalid IBAN: ", code, ": ", message, newline ) ) + FI + OD + END +END diff --git a/Task/IBAN/PascalABC.NET/iban.pas b/Task/IBAN/PascalABC.NET/iban.pas new file mode 100644 index 0000000000..ad59a4e740 --- /dev/null +++ b/Task/IBAN/PascalABC.NET/iban.pas @@ -0,0 +1,33 @@ +var + countryLen := Dict( + ('AL', 28), ('AD', 24), ('AT', 20), ('AZ', 28), ('BE', 16), ('BH', 22), ('BA', 20), ('BR', 29), + ('BG', 22), ('CR', 21), ('HR', 21), ('CY', 28), ('CZ', 24), ('DK', 18), ('DO', 28), ('EE', 20), + ('FO', 18), ('FI', 18), ('FR', 27), ('GE', 22), ('DE', 22), ('GI', 23), ('GR', 27), ('GL', 18), + ('GT', 28), ('HU', 28), ('IS', 26), ('IE', 22), ('IL', 23), ('IT', 27), ('KZ', 20), ('KW', 30), + ('LV', 21), ('LB', 28), ('LI', 21), ('LT', 20), ('LU', 20), ('MK', 19), ('MT', 31), ('MR', 27), + ('MU', 30), ('MC', 27), ('MD', 24), ('ME', 22), ('NL', 18), ('NO', 15), ('PK', 24), ('PS', 29), + ('PL', 28), ('PT', 25), ('RO', 24), ('SM', 27), ('SA', 24), ('RS', 22), ('SK', 24), ('SI', 19), + ('ES', 24), ('SE', 24), ('CH', 21), ('TN', 24), ('TR', 26), ('AE', 23), ('GB', 22), ('VG', 24)); + +function validIban(iban: string): boolean; +begin + result := False; + iban := iban.Replace(' ', '').Replace(#9, ''); + if not iban.All(c -> c.isupper or c.isdigit) then exit; + + if iban.Length <> countryLen.Get(iban[1:3]) then exit; + + iban := iban[5:iban.Length + 1] + iban[1:5]; + var digits: string := ''; + foreach var ch in iban do + case ch of + '0'..'9': digits += ch; + 'A'..'Z': digits += (Ord(ch) - Ord('A') + 10).ToString; + end; + result := digits.ToBigInteger mod 97 = 1; +end; + +begin + foreach var account in |'GB82 WEST 1234 5698 7654 32', 'GB82 TEST 1234 5698 7654 32'| do + Println(account, 'validation is:', validIban(account)); +end. diff --git a/Task/ISBN13-check-digit/JavaScript/isbn13-check-digit.js b/Task/ISBN13-check-digit/JavaScript/isbn13-check-digit.js new file mode 100644 index 0000000000..0d39e85b78 --- /dev/null +++ b/Task/ISBN13-check-digit/JavaScript/isbn13-check-digit.js @@ -0,0 +1,25 @@ +/** + * Validate that the given string of digits is an ISBN13 number + * If we allow 8, 12, 13, and 14-digit numbers, this becomes a GTIN validator. + * See: https://ref.gs1.org/standards/genspecs/ + * @param {string} s + * @returns {boolean} True if the given string is a GS1 GTIN number + */ +const check = s => { + const _multiply = (e, i) => i % 2 ? e * 1 : e * 3; + const _sum = (p, c) => p + c; + const arr = [...s.replaceAll('-', '') + .replaceAll(' ', '')]; + if ([13].includes(arr.length)) { + const [last, ...rest] = [...arr].reverse(); + const result = rest.map(_multiply).reduce(_sum, last * 1); + return result % 10 === 0; + } + return false; +} + +[ + "978-0596528126", + "978-0596528120", + "978-1788399081", + "978-1788399083"].map(check) diff --git a/Task/ISBN13-check-digit/Langur/isbn13-check-digit.langur b/Task/ISBN13-check-digit/Langur/isbn13-check-digit.langur index d8bb48c1ff..2a6e6518dc 100644 --- a/Task/ISBN13-check-digit/Langur/isbn13-check-digit.langur +++ b/Task/ISBN13-check-digit/Langur/isbn13-check-digit.langur @@ -1,7 +1,7 @@ val isbn13checkdigit = fn(var s) { - s = replace(s, RE/[\- ]/) + s = replace(s, by=RE/[\- ]/) s -> re/^[0-9]{13}$/ and - fold(fn{+}, map([_, fn{*3}], s2n(s))) div 10 + fold(map(s2n(s), by=[_, fn{*3}]), by=fn{+}) div 10 } val tests = { diff --git a/Task/ISBN13-check-digit/M2000-Interpreter/isbn13-check-digit.m2000 b/Task/ISBN13-check-digit/M2000-Interpreter/isbn13-check-digit.m2000 new file mode 100644 index 0000000000..119a762eea --- /dev/null +++ b/Task/ISBN13-check-digit/M2000-Interpreter/isbn13-check-digit.m2000 @@ -0,0 +1,37 @@ +Module CheckISBN (filename as string, feed as array) { + if len(feed)=0 then exit + link feed to isbn() ' just change interface + open filename for output as #f ' use "" for output to screen (f=-2) + for n = 0 to len(feed)-1 + long sum = 0, k = 0 + string isbnStr = filter$(isbn(n), "- ") + if len(isbnStr)=0 then continue + for m = 1 to len(isbnStr) + if m mod 2 = 0 then + num = 3 * val(mid$(isbnStr, m, 1)) + else + num = val(mid$(isbnStr, m, 1)) + end if + sum += num + k++ + next m + + print #f, isbn(n); + if k<>13 then + print #f, ": not an ISBN 13" + else.if sum mod 10 = 0 then + print #f, ": good" + else + print #f, ": bad (last digit should be:"+((10-(sum-num) mod 10) mod 10)+")" + end if + next n + close #f +} +Flush +Data "978-0596528126", "978-0596528120", "978-1788399081" +Data "978-1788399083", "978-2-74839-908-0", "978-2-74839-908-5" +Data "978 1 86197 876 9", "9603313440" +a=array([]) ' get current stack (leave an empty one) then return an array +CheckISBN "isbn.txt", a +win file.app$("txt"), dir$+"isbn.txt" +CheckISBN "", a diff --git a/Task/ISBN13-check-digit/PascalABC.NET/isbn13-check-digit.pas b/Task/ISBN13-check-digit/PascalABC.NET/isbn13-check-digit.pas new file mode 100644 index 0000000000..4d9b209fe5 --- /dev/null +++ b/Task/ISBN13-check-digit/PascalABC.NET/isbn13-check-digit.pas @@ -0,0 +1,18 @@ +## +function CheckISBN13(code: string): boolean; +begin + result := false; + code := code.Replace('-', '').Replace(' ', ''); + if (code.Length <> 13) then exit; + var sum := 0; + foreach var digit in code index i do + if digit.isdigit then + sum += digit.ToDigit * (if i mod 2 = 0 then 1 else 3) + else exit; + result := sum mod 10 = 0; +end; + +CheckISBN13('978-0596528126').Println; +CheckISBN13('978-0596528120').Println; +CheckISBN13('978-1788399081').Println; +CheckISBN13('978-1788399083').Println; diff --git a/Task/ISBN13-check-digit/Scala/isbn13-check-digit.scala b/Task/ISBN13-check-digit/Scala/isbn13-check-digit.scala new file mode 100644 index 0000000000..910add1d43 --- /dev/null +++ b/Task/ISBN13-check-digit/Scala/isbn13-check-digit.scala @@ -0,0 +1,26 @@ +object ISBNValidator: + private def checkChecksum(isbn: String): Boolean = + val digits = isbn.map(_.asDigit) + val checksum = digits.zipWithIndex.map { + case (digit, idx) => + if idx % 2 == 0 then digit + else digit * 3 + }.sum + checksum % 10 == 0 + + def isValidISBN13(isbn: String): Boolean = + val cleaned = isbn.filter(_.isDigit) + cleaned.length == 13 && checkChecksum(cleaned) + +@main def main(): Unit = + def test(isbn: String): Unit = + val result = ISBNValidator.isValidISBN13(isbn) + println(s"$isbn: $result") + + List( + "978-0596528126", + "978-0596528120", + "978-1788399081", + "978-1788399083" + ) + .foreach(test) diff --git a/Task/Include-a-file/Uiua/include-a-file.uiua b/Task/Include-a-file/Uiua/include-a-file.uiua new file mode 100644 index 0000000000..1f81fb39a5 --- /dev/null +++ b/Task/Include-a-file/Uiua/include-a-file.uiua @@ -0,0 +1 @@ +~ "example.ua" diff --git a/Task/Increasing-gaps-between-consecutive-Niven-numbers/PascalABC.NET/increasing-gaps-between-consecutive-niven-numbers.pas b/Task/Increasing-gaps-between-consecutive-Niven-numbers/PascalABC.NET/increasing-gaps-between-consecutive-niven-numbers.pas new file mode 100644 index 0000000000..67152f2e87 --- /dev/null +++ b/Task/Increasing-gaps-between-consecutive-Niven-numbers/PascalABC.NET/increasing-gaps-between-consecutive-niven-numbers.pas @@ -0,0 +1,37 @@ +function digitsSum(n, sum: int64): int64; +begin + result := sum + 1; + while (n > 0) and (n mod 10 = 0) do + begin + result -= 9; + n := n div 10; + end; +end; + +begin + var niven: int64 := 0; + var gap: int64 := 0; + var sum: int64 := 0; + var nivenIndex: int64 := 0; + var previous: int64 := 1; + var gapIndex: int64 := 1; + + println('Gap index Gap Niven index Niven number'); + + while gapIndex <= 32 do + begin + niven += 1; + sum := digitsSum(niven, sum); + if niven mod sum = 0 then + begin + if niven > previous + gap then + begin + gap := niven - previous; + writeln(gapIndex:9, gap:5, nivenIndex:13, previous:14); + gapIndex += 1; + end; + previous := niven; + nivenIndex += 1; + end; + end; +end. diff --git a/Task/Infinity/Uiua/infinity.uiua b/Task/Infinity/Uiua/infinity.uiua new file mode 100644 index 0000000000..f82e41ab43 --- /dev/null +++ b/Task/Infinity/Uiua/infinity.uiua @@ -0,0 +1 @@ +&p∞ diff --git a/Task/Inheritance-Single/Arturo/inheritance-single.arturo b/Task/Inheritance-Single/Arturo/inheritance-single.arturo new file mode 100644 index 0000000000..9f1606abe4 --- /dev/null +++ b/Task/Inheritance-Single/Arturo/inheritance-single.arturo @@ -0,0 +1,24 @@ +; Base Animal type +define :animal [ + init: constructor [name :string] +] + +; Dog type inheriting from Animal +define :dog is :animal [ + ; ... +] + +; Cat type inheriting from Animal +define :cat is :animal [ + ; ... +] + +; Lab type inheriting from Dog +define :lab is :dog [ + ; ... +] + +; Collie type inheriting from Dog +define :collie is :dog [ + ; ... +] diff --git a/Task/Integer-overflow/Applesoft-BASIC/integer-overflow-5.basic b/Task/Integer-overflow/Applesoft-BASIC/integer-overflow-5.basic index af3e54154a..342b708226 100644 --- a/Task/Integer-overflow/Applesoft-BASIC/integer-overflow-5.basic +++ b/Task/Integer-overflow/Applesoft-BASIC/integer-overflow-5.basic @@ -1 +1 @@ -A% = -32767 : POKE PEEK(131) + PEEK(132) * 256, 0 : ? A% +A% = -32767 : POKE PEEK(131) + PEEK(132) * 256 + 1, 0 : ? A% diff --git a/Task/Integer-overflow/FutureBasic/integer-overflow.basic b/Task/Integer-overflow/FutureBasic/integer-overflow.basic new file mode 100644 index 0000000000..722195a19e --- /dev/null +++ b/Task/Integer-overflow/FutureBasic/integer-overflow.basic @@ -0,0 +1,17 @@ +include "NSLog.incl" + +NSLog( @"FB Integer ranges:\n" ) + +NSLog( @"UInt64: 0 to %llu", ULLONG_MAX ) +NSLog( @"SInt64: %lld to %lld\n", LLONG_MIN, LLONG_MAX ) + +NSLog( @"UInt32: 0 to %u", UINT_MAX ) +NSLog( @"SInt32: %ld to %ld\n", INT_MIN, INT_MAX ) + +NSLog( @"UInt16: 0 to %hu", USHRT_MAX ) +NSLog( @"SInt16: %hd to %hd\n", SHRT_MIN, SHRT_MAX ) + +NSLog( @"UInt8: 0 to %u", UCHAR_MAX ) +NSLog( @"SInt8: %d to %d", CHAR_MIN, CHAR_MAX ) + +HandleEvents diff --git a/Task/Intersecting-number-wheels/PascalABC.NET/intersecting-number-wheels.pas b/Task/Intersecting-number-wheels/PascalABC.NET/intersecting-number-wheels.pas new file mode 100644 index 0000000000..f4cc88a641 --- /dev/null +++ b/Task/Intersecting-number-wheels/PascalABC.NET/intersecting-number-wheels.pas @@ -0,0 +1,39 @@ +function WheelCreator(wheel: string): () -> char; +begin + var index := 1; + + result := function(): char -> + begin + result := wheel[index]; + index := if index >= wheel.Length then 1 else index + 1; + end; +end; + +function TurnWheels(primary: char; wheels: dictionary char>): sequence of char; +begin + while true do + begin + var turn := wheels.Get(primary)(); + while not turn.IsDigit do + turn := wheels.Get(turn); + yield turn; + end; +end; + +begin + var allwheels := + ||('A', '123')|, + |('A', '1B2'), ('B', '34')|, + |('A', '1DD'), ('D', '678')|, + |('A', '1BC'), ('B', '34'), ('C', '5B')||; + + foreach var wheels in allwheels do + begin + foreach var w in wheels do + writeln(w[0], ': ', w[1]); + println('Generates:'); + var t := TurnWheels(wheels[0][0], wheels.ToDictionary(x -> x[0], x -> WheelCreator(x[1]))); + println(t.Take(20)); + println; + end; +end. diff --git a/Task/Introspection/Zig/introspection-1.zig b/Task/Introspection/Zig/introspection-1.zig index 7473a0ec4c..0a1d9a3921 100644 --- a/Task/Introspection/Zig/introspection-1.zig +++ b/Task/Introspection/Zig/introspection-1.zig @@ -8,7 +8,7 @@ pub fn abs(a: i32) i32 { } pub fn main() error{NotSupported}!void { - if (builtin.zig_version.order(.{ .major = 0, .minor = 11, .patch = 0 }) == .lt) { + if (builtin.zig_version.order(.{ .major = 0, .minor = 12, .patch = 1 }) == .lt) { std.debug.print("Version {any} is less than 0.11.0, not suitable, exiting!\n", .{builtin.zig_version}); return error.NotSupported; } else { diff --git a/Task/Introspection/Zig/introspection-2.zig b/Task/Introspection/Zig/introspection-2.zig index 5c15d3b78b..801c1e7015 100644 --- a/Task/Introspection/Zig/introspection-2.zig +++ b/Task/Introspection/Zig/introspection-2.zig @@ -1,4 +1,5 @@ const std = @import("std"); +const builtin = @import("builtin"); pub const first_integer_constant: i32 = 5; pub const second_integer_constant: i32 = 3; @@ -10,7 +11,18 @@ pub const another_non_integer_constant: bool = false; pub fn main() void { comptime var cnt: comptime_int = 0; comptime var sum: comptime_int = 0; - inline for (@typeInfo(@This()).Struct.decls) |decl_info| { + if (comptime builtin.zig_version.order(.{ .major = 0, .minor = 13, .patch = 0 }) == .gt) { + inline for (@typeInfo(@This()).@"struct".decls) |decl_info| { + const decl = @field(@This(), decl_info.name); + switch (@typeInfo(@TypeOf(decl))) { + .int, .comptime_int => { + sum += decl; + cnt += 1; + }, + else => continue, + } + } + } else inline for (@typeInfo(@This()).Struct.decls) |decl_info| { const decl = @field(@This(), decl_info.name); switch (@typeInfo(@TypeOf(decl))) { .Int, .ComptimeInt => { diff --git a/Task/Inverted-index/FreeBASIC/inverted-index.basic b/Task/Inverted-index/FreeBASIC/inverted-index.basic new file mode 100644 index 0000000000..4e7d383e4c --- /dev/null +++ b/Task/Inverted-index/FreeBASIC/inverted-index.basic @@ -0,0 +1,115 @@ +Const NULL As Any Ptr = 0 + +Type WordCant + arch As String + cant As Integer + sgte As WordCant Ptr +End Type + +Type WordEntry + word As String + cnts As WordCant Ptr + sgte As WordEntry Ptr +End Type + +Function addWord(root As WordEntry Ptr, word As String, arch As String) As WordEntry Ptr + Dim As WordEntry Ptr actual = root + Dim As WordCant Ptr newCant + + ' Search existing word + While actual <> NULL + If actual->word = word Then + ' Word exists, update cant for file + Dim As WordCant Ptr cant = actual->cnts + While cant <> NULL + If cant->arch = arch Then + cant->cant += 1 + Return root + End If + cant = cant->sgte + Wend + ' Add new file cant + newCant = New WordCant + newCant->arch = arch + newCant->cant = 1 + newCant->sgte = actual->cnts + actual->cnts = newCant + Return root + End If + actual = actual->sgte + Wend + + ' Add new word + Dim As WordEntry Ptr newEntry = New WordEntry + newCant = New WordCant + newCant->arch = arch + newCant->cant = 1 + newCant->sgte = NULL + + newEntry->word = word + newEntry->cnts = newCant + newEntry->sgte = root + Return newEntry +End Function + +Function makeDoubleIndex(files() As String) As WordEntry Ptr + Dim As WordEntry Ptr index = NULL + + For i As Integer = Lbound(files) To Ubound(files) + Dim As Integer ff = Freefile + Open files(i) For Input As #ff + + Dim As String linea, word + While Not Eof(ff) + Line Input #ff, linea + linea = Lcase(linea) + + Dim As Integer start = 1, posic + Do + posic = Instr(start, linea, Any " ,.;:!?()[]{}""'") + word = Mid(linea, start, Iif(posic = 0, Len(linea) - start + 1, posic - start)) + + word = Trim(word) + If Len(word) > 0 Then index = addWord(index, word, files(i)) + + start = posic + 1 + Loop Until posic = 0 + Wend + Close #ff + Next + + Return index +End Function + +Sub wordSearch(index As WordEntry Ptr, searchTerms() As String) + For i As Integer = Lbound(searchTerms) To Ubound(searchTerms) + Dim As String word = Lcase(searchTerms(i)) + Dim As WordEntry Ptr entry = index + + While entry <> NULL + If entry->word = word Then + Print Chr(34); word; Chr(34); " found in "; + Dim As WordCant Ptr cant = entry->cnts + While cant <> NULL + Print cant->arch; + If cant->sgte <> NULL Then Print ", "; + cant = cant->sgte + Wend + Print + Exit While + End If + entry = entry->sgte + Wend + + If entry = NULL Then Print Chr(34); word; """ not found." + Next +End Sub + +' Main program +Dim As String files(3) = {"file1.txt", "file2.txt", "file3.txt", "file4.txt"} +Dim As String searchTerms(4) = {"forehead", "of", "hand", "a", "foot"} + +Dim As WordEntry Ptr index = makeDoubleIndex(files()) +wordSearch(index, searchTerms()) + +Sleep diff --git a/Task/Isograms-and-heterograms/PascalABC.NET/isograms-and-heterograms.pas b/Task/Isograms-and-heterograms/PascalABC.NET/isograms-and-heterograms.pas new file mode 100644 index 0000000000..d4b5949986 --- /dev/null +++ b/Task/Isograms-and-heterograms/PascalABC.NET/isograms-and-heterograms.pas @@ -0,0 +1,28 @@ +uses System.Net; + +function isogram(word: string): integer; +begin + result := 0; + var letters := new Dictionary; + foreach var c in word do + letters[c] := letters.Get(c) + 1; + var counts: set of integer; + foreach var letter in letters do + counts += [letter.value]; + if counts.Count = 1 then + result := letters.Get(word[1]); +end; + +begin + var client := new WebClient(); + var text := client.DownloadString('http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'); + var words: sequence of string := text.ToWords(|#10, #13|); + words.Where(w -> isogram(w) > 1) + .OrderByDescending(w -> isogram(w)) + .ThenByDescending(w -> w.Length) + .ThenBy(w -> w).println; + println; + words.where(w -> (isogram(w) = 1) and (w.Length > 10)) + .OrderByDescending(w -> w.Length) + .ThenBy(w -> w).println; +end. diff --git a/Task/Isograms-and-heterograms/Python/isograms-and-heterograms.py b/Task/Isograms-and-heterograms/Python/isograms-and-heterograms.py new file mode 100644 index 0000000000..8adf7d3a1d --- /dev/null +++ b/Task/Isograms-and-heterograms/Python/isograms-and-heterograms.py @@ -0,0 +1,32 @@ +from collections import Counter + +def find_n_isograms(wordlist): + n_isograms = [] + for word in wordlist: + word_lower = word.lower() + freq = Counter(word_lower) + frequencies = freq.values() + if len(set(frequencies)) == 1 and next(iter(frequencies)) > 1: + n = next(iter(frequencies)) + n_isograms.append((-n, -len(word), word)) + n_isograms.sort() + return [word for _, _, word in n_isograms] + +def find_heterograms(wordlist): + heterograms = [] + for word in wordlist: + if len(word) > 10: + word_lower = word.lower() + if len(set(word_lower)) == len(word_lower): + heterograms.append((-len(word), word)) + heterograms.sort() + return [word for _, word in heterograms] + +with open('unidict.txt', 'r') as file: + wordlist = [line.strip() for line in file] + +n_isograms_result = find_n_isograms(wordlist) +heterograms_result = find_heterograms(wordlist) + +print("n-isograms (n > 1):", n_isograms_result) +print("Heterograms with more than 10 characters:", heterograms_result) diff --git a/Task/Isqrt-integer-square-root-of-X/Miranda/isqrt-integer-square-root-of-x.miranda b/Task/Isqrt-integer-square-root-of-X/Miranda/isqrt-integer-square-root-of-x.miranda new file mode 100644 index 0000000000..1036ac98b4 --- /dev/null +++ b/Task/Isqrt-integer-square-root-of-X/Miranda/isqrt-integer-square-root-of-x.miranda @@ -0,0 +1,36 @@ +main :: [sys_message] +main = [Stdout "isqrt of 0..65:\n", + Stdout (table 2 11 [show (isqrt x) | x <- [0..65]]), + Stdout "\nisqrt of 7^1 .. 7^73:\n", + Stdout (lay (map isqrtp7 [1,3..73]))] + +isqrtp7 :: num->[char] +isqrtp7 x = "isqrt(7^" ++ rjustify 2 (show x) ++ ") = " ++ + rjustify 41 (commatize (isqrt (7^x))) + +table :: num->num->[[char]]->[char] +table cw rw xs = lay [concat (map (rjustify cw) r) | r<-split rw xs] + +split :: num->[*]->[[*]] +split n [] = [] +split n xs = take n xs:split n (drop n xs) + +isqrt :: num->num +isqrt x = step qf x 0 + where qf = (hd . dropwhile (<= x) . iterate (*4)) 1 + step 1 z r = r + step q z r = step q' z' r'', otherwise + where q' = q div 4 + t = z - r - q' + r' = r div 2 + z' = t, if t>=0 + = z, otherwise + r'' = r' + q', if t>=0 + = r', otherwise + +commatize :: num->[char] +commatize n = show n, if n<1000 + = commatize (n div 1000) ++ ',':part (n mod 1000), otherwise + where part n = show n, if n>=100 + = '0':show n, if n>=10 + = '0':'0':show n, otherwise diff --git a/Task/Isqrt-integer-square-root-of-X/PascalABC.NET/isqrt-integer-square-root-of-x.pas b/Task/Isqrt-integer-square-root-of-X/PascalABC.NET/isqrt-integer-square-root-of-x.pas new file mode 100644 index 0000000000..70f2e379d2 --- /dev/null +++ b/Task/Isqrt-integer-square-root-of-X/PascalABC.NET/isqrt-integer-square-root-of-x.pas @@ -0,0 +1,30 @@ +function isqrt(x: biginteger): biginteger; +begin + var q := 1bi; + result := 0bi; + while q <= x do + q := q shl 2; + while q > 1 do + begin + q := q shr 2; + var t := x - result - q; + result := result shr 1; + if t >= 0 Then + begin + x := t; + result += q; + end; + end; +end; + +begin + for var n := 0 to 65 do + write(isqrt(n):2); + println(#10); + var n := 7bi; + for var i := 1 to 73 step 2 do + begin + writeln('isqrt(7^', i, ') = ', isqrt(n).ToString('N0')); + n *= 49; + end; +end. diff --git a/Task/Isqrt-integer-square-root-of-X/Refal/isqrt-integer-square-root-of-x.refal b/Task/Isqrt-integer-square-root-of-X/Refal/isqrt-integer-square-root-of-x.refal new file mode 100644 index 0000000000..861ed6e80d --- /dev/null +++ b/Task/Isqrt-integer-square-root-of-X/Refal/isqrt-integer-square-root-of-x.refal @@ -0,0 +1,64 @@ +$ENTRY Go { + = + + ; +}; + +Isqrt0To65 { + = + >>>; +}; + +IsqrtOddPow7 { + , >>: e.Pows + = ; +}; + +IsqrtPow7 { + s.Pow, : e.Pow7, + : e.Sqrt = + ') = ' >; +}; + +Isqrt { + e.X, : e.Q = ; +}; + +Isqrt1 { + (e.Q) e.X, : '+' = e.Q; + (e.Q) e.X = ) e.X>; + e.X = ; +}; + +Isqrt2 { + (1) (e.Z) (e.R) = e.R; + (e.Q) (e.Z) (e.R), +
: e.Q2, + ) e.Q2>: e.T, +
: e.R2, + e.T: { + '-' e.T2 = ; + e.T = )>; + }; +}; + +Pow { + (e.N) 0 = 1; + (e.N) e.P, : { + (e.P2) 0, : e.X = ; + (e.P2) 1, : e.X = >; + }; +}; + +Commatize { + e.N = >; +}; + +Commatize1 { + e.X s.F s.1 s.2 s.3 = ',' s.1 s.2 s.3; + e.X = e.X; +} + +Iota { s.E s.E = s.E; s.S s.E = s.S s.E>; }; +Each { (e.F) = ; (e.F) t.X e.XS = ; }; +Split { s.G = ; s.G e.X, : (e.F) e.R = (e.F) ; }; diff --git a/Task/Iterated-digits-squaring/PascalABC.NET/iterated-digits-squaring.pas b/Task/Iterated-digits-squaring/PascalABC.NET/iterated-digits-squaring.pas new file mode 100644 index 0000000000..adfa61198b --- /dev/null +++ b/Task/Iterated-digits-squaring/PascalABC.NET/iterated-digits-squaring.pas @@ -0,0 +1,48 @@ +function digits(n: integer): sequence of integer; +begin + result := new List; + repeat + result := result + n mod 10; + n := n div 10; + until n = 0; +end; + +function gen(n: integer): integer; +begin + result := n; + while (result <> 1) and (result <> 89) do + begin + var s := 0; + foreach var d in digits(result) do s += d * d; + result := s; + end; +end; + +function chainsEndingWith89(ndigits: integer): int64; +begin + var prevcount := new Dictionary; + var currcount := new Dictionary; + for var i := 0 to 9 do prevcount[i * i] := 1; + + loop ndigits - 1 do + begin + currcount.Clear; + foreach var prev in prevcount do + for var newdigit := 0 to 9 do + begin + var nextgen := newdigit * newdigit + prev.key; + currcount[nextgen] := currcount.get(nextgen) + prev.value; + end; + prevcount := new Dictionary(currcount); + end; + + foreach var curr in currcount do + if (curr.key <> 0) and (gen(curr.key) = 89) then + result += curr.value; +end; + +begin + println('For 8 digits: ', chainsEndingWith89(8)); + println('For 18 digits: ', chainsEndingWith89(18)); + println(milliseconds, 'ms'); +end. diff --git a/Task/Jacobi-symbol/PascalABC.NET/jacobi-symbol.pas b/Task/Jacobi-symbol/PascalABC.NET/jacobi-symbol.pas new file mode 100644 index 0000000000..7c26f92003 --- /dev/null +++ b/Task/Jacobi-symbol/PascalABC.NET/jacobi-symbol.pas @@ -0,0 +1,34 @@ +function jacobi(n, k: integer): integer; +begin + assert((k > 0) and (k mod 2 = 1)); + n := n mod k; + result := 1; + while n <> 0 do + begin + while n mod 2 = 0 do + begin + n := n shr 1; + if (k and 7) in [3, 5] then + result := -result; + end; + swap(n, k); + if ((n and 3) = 3) and ((k and 3) = 3) then + result := -result; + n := n mod k; + end; + if k <> 1 then result := 0; +end; + +begin + write('n/k|'); + for var n := 1 to 20 do write(n:3); + writeln(#10, '—' * 64); + + for var k := 1 to 21 step 2 do + begin + write(k:2, ' |'); + for var n := 1 to 20 do + write(jacobi(n, k):3); + writeln; + end; +end. diff --git a/Task/Jacobsthal-numbers/PascalABC.NET/jacobsthal-numbers.pas b/Task/Jacobsthal-numbers/PascalABC.NET/jacobsthal-numbers.pas new file mode 100644 index 0000000000..f3a1bac47a --- /dev/null +++ b/Task/Jacobsthal-numbers/PascalABC.NET/jacobsthal-numbers.pas @@ -0,0 +1,54 @@ +function IsPrime(n: integer): boolean; +begin + result := false; + if n < 2 then exit; + for var i: integer := 2 to round(sqrt(n)) do + if n mod i = 0 then exit; + result := true; +end; + +function jacobsthalSequence(prev, curr: int64): sequence of int64; +begin + yield prev; + yield curr; + while true do + begin + swap(prev, curr); + curr += curr + prev; + yield curr; + end; +end; + +function jacobsthalOblong(): sequence of int64; +begin + var prev := -1; + foreach var n in jacobsthalSequence(0, 1) do + begin + if prev >= 0 then yield prev * n; + prev := n; + end; +end; + +function jacobsthalPrimes(): sequence of int64; +begin + foreach var n in jacobsthalSequence(0, 1) do + if isPrime(n) then yield n +end; + +begin + writeln('First 30 Jacobsthal numbers:'); + foreach var n in jacobsthalSequence(0, 1).Take(30) index i do + write(n:11, if i mod 6 = 5 then #10 else ''); + + writeln(#10, 'First 30 Jacobsthal-Lucas numbers:'); + foreach var n in jacobsthalSequence(2, 1).Take(30) index i do + write(n:11, if i mod 6 = 5 then #10 else ''); + + writeln(#10, 'First 20 Jacobsthal oblong numbers:'); + foreach var n in jacobsthalOblong().Take(20) index i do + write(n:13, if i mod 5 = 4 then #10 else ''); + + writeln(#10, 'First 10 Jacobsthal prime numbers:'); + foreach var n in jacobsthalPrimes().Take(10) index i do + write(n:11, if i mod 5 = 4 then #10 else ''); +end. diff --git a/Task/Jaro-similarity/ALGOL-68/jaro-similarity.alg b/Task/Jaro-similarity/ALGOL-68/jaro-similarity.alg new file mode 100644 index 0000000000..5337666bb1 --- /dev/null +++ b/Task/Jaro-similarity/ALGOL-68/jaro-similarity.alg @@ -0,0 +1,29 @@ +BEGIN # Jaro distance - translated from the EasyLang sample # + PROC jaro distance = ( STRING s1, s2 )REAL: BEGIN + INT len s1 = ( UPB s1 - LWB s1 ) + 1; + INT len s2 = ( UPB s2 - LWB s2 ) + 1; + INT matchstd = IF len s1 > len s2 THEN len s1 ELSE len s2 FI OVER 2 - 1; + INT m := 0, p := 0; + FOR i1 FROM LWB s1 TO UPB s1 DO + FOR i2 FROM LWB s2 TO UPB s2 DO + IF s1[ i1 ] = s2[ i2 ] THEN + IF ABS ( i2 - i1 ) <= matchstd THEN + m +:= 1; + IF i2 = i1 THEN + p +:= 1 + FI + FI + FI + OD + OD; + INT t = ( m - p ) OVER 2; + 1 / 3 * ( m / len s1 + m / len s2 + ( m - t ) / m ) + END ; + PROC print jaro distance = ( STRING s1, s2 )VOID: + print( ( s1, " :: ", s2, " -> ", fixed( jaro distance( s1, s2 ), -6, 2 ), newline ) ); + + print jaro distance( "MARTHA", "MARHTA" ); + print jaro distance( "DIXON", "DICKSONX" ); + print jaro distance( "JELLYFISH", "SMELLYFISH" ) + +END diff --git a/Task/Jensens-Device/PascalABC.NET/jensens-device.pas b/Task/Jensens-Device/PascalABC.NET/jensens-device.pas new file mode 100644 index 0000000000..5220f30d17 --- /dev/null +++ b/Task/Jensens-Device/PascalABC.NET/jensens-device.pas @@ -0,0 +1,14 @@ +function Sum(var i: integer; lo, hi: integer; term: ()-> real): real; +begin + i := lo; + while i <= hi do + begin + result += term(); + i += 1; + end; +end; + +begin + var i := 0; + Writeln(Sum(i, 1, 100, () -> 1.0 / i)); +end. diff --git a/Task/Jordan-P-lya-numbers/Sidef/jordan-p-lya-numbers.sidef b/Task/Jordan-P-lya-numbers/Sidef/jordan-p-lya-numbers.sidef new file mode 100644 index 0000000000..4b6ef5a8c0 --- /dev/null +++ b/Task/Jordan-P-lya-numbers/Sidef/jordan-p-lya-numbers.sidef @@ -0,0 +1,60 @@ +func jordan_pólya_numbers(n, k, F, callback) { + + var factors = F.sort.uniq + var factors_end = factors.end + + if (k == 0) { + callback(1) + return nil + } + + func (m, k, i=0) { + + if (k == 1) { + + var L = idiv(n,m) + + for j in (i..factors_end) { + with (factors[j]) {|q| + q > L && break + callback(m*q) + } + } + + return nil + } + + var L = idiv(n,m).iroot(k) + + for j in (i..factors_end) { + with (factors[j]) { |q| + q > L && break + __FUNC__(m*q, k-1, j) + } + } + }(1, k) + + return nil +} + +func inverse_factorial_W(n) { + var l = (log(n) - log(Num.tau)/2) + l / lambert_w(l / Num.e) - 1/2 +} + +var limit = 100e6 +var factors = (2..inverse_factorial_W(limit).int -> map { .factorial }) +var terms = Set() + +for k in (0 .. limit.ilog2) { + jordan_pólya_numbers(limit, k, factors, {|v| terms << v }) +} + +terms.sort! + +say "The first 50 Jordan-Pólya numbers:" +terms.first(50).each_slice(10, {|*a| + a.map { '%5s' % _ }.join(' ').say +}) + +say "\nThere are #{terms.len} Jordan-Pólya numbers <= #{limit.commify}, where largest is #{terms.last}." diff --git a/Task/JortSort/PascalABC.NET/jortsort.pas b/Task/JortSort/PascalABC.NET/jortsort.pas new file mode 100644 index 0000000000..9acf98045a --- /dev/null +++ b/Task/JortSort/PascalABC.NET/jortsort.pas @@ -0,0 +1,10 @@ +## +function jortsort(Self: sequence of T): boolean; +extensionmethod; +begin + result := Self.SequenceEqual(Self.sorted); +end; + +(1..10).jortsort.println; +[1,2,3].jortsort.println; +'abcdefgc'.jortsort.Println; diff --git a/Task/Josephus-problem/PascalABC.NET/josephus-problem.pas b/Task/Josephus-problem/PascalABC.NET/josephus-problem.pas new file mode 100644 index 0000000000..90949fd051 --- /dev/null +++ b/Task/Josephus-problem/PascalABC.NET/josephus-problem.pas @@ -0,0 +1,21 @@ +procedure j(n, k: integer); +begin + var p := (0..n - 1).ToList; + var i := 0; + var s := new List; + + while p.Count > 0 do + begin + i := (i + k - 1) mod p.Count; + s.Add(p[i]); + p.RemoveAt(i); + end; + + println('Prisoner killing order:', s.SkipLast); + println('Survivor:', s.Last); +end; + +begin + j(5, 2); + j(41, 3); +end. diff --git a/Task/Joystick-position/XPL0/joystick-position.xpl0 b/Task/Joystick-position/XPL0/joystick-position.xpl0 new file mode 100644 index 0000000000..3b80fbdc16 --- /dev/null +++ b/Task/Joystick-position/XPL0/joystick-position.xpl0 @@ -0,0 +1,19 @@ +def X0=20, Y0=12; \center position (character cells) +def XL=X0-5, XR=X0+5; \left, right +def YD=Y0+5, YU=Y0-5; \down, up +int TblX, TblY, Key, KeyOld; +[SetVid($13); \set 320x200 graphics +\ 0 1 2 3 4 5 6 7 8 9 A B C D E F +TblX:= [X0, XR, X0, XR, XL, X0, XL, X0, X0, XR, X0, XR, XL, X0, XL, X0]; +TblY:= [Y0, Y0, YD, YD, Y0, Y0, YD, YD, YU, YU, Y0, Y0, YU, YU, Y0, Y0]; +KeyOld:= 0; +Cursor(TblX(KeyOld), TblY(KeyOld)); ChOut(6, ^+); \draw + in center +loop [repeat Key:= GetShiftKeys; + if Key < 0 then quit; \Esc = MSb + Key:= Key>>8 & $0F; + until Key # KeyOld; + Cursor(TblX(KeyOld), TblY(KeyOld)); ChOut(6, ^ ); \erase + at old loc + Cursor(TblX(Key), TblY(Key)); ChOut(6, ^+); \draw + at new loc + KeyOld:= Key; + ]; +] diff --git a/Task/Juggler-sequence/PascalABC.NET/juggler-sequence.pas b/Task/Juggler-sequence/PascalABC.NET/juggler-sequence.pas new file mode 100644 index 0000000000..c544ab9f82 --- /dev/null +++ b/Task/Juggler-sequence/PascalABC.NET/juggler-sequence.pas @@ -0,0 +1,46 @@ +function isqrt(x: biginteger): biginteger; +begin + var q := 1bi; + result := 0bi; + while q <= x do + q := q shl 2; + while q > 1 do + begin + q := q shr 2; + var t := x - result - q; + result := result shr 1; + if t >= 0 Then + begin + x := t; + result += q; + end; + end; +end; + +procedure juggler(k: biginteger; countdig: boolean := True); +begin + var m := k; + var maxj := k; + var maxjpos := 0; + for var i := 1 to 1000 do + begin + m := if m mod 2 = 0 then isqrt(m) else isqrt(m * m * m); + if m >= maxj then + (maxj, maxjpos) := (m, i); + if m = 1 then + begin + writeln(k:9, i:6, maxjpos:6, ' ', (if countdig then maxj.ToString.Length else maxj):20 + , if countdig then ' digits, ' + milliseconds.ToString + ' ms' else ''); + exit; + end; + end; +end; + +begin + writeln(' n l(n) i(n) h(n) or d(n)'); + for var k := 20 to 39 do + juggler(k, False); + + foreach var k in [113, 173, 193, 2183, 11229, 15065, 15845, 30817] do + juggler(k) +end. diff --git a/Task/Julia-set/PascalABC.NET/julia-set.pas b/Task/Julia-set/PascalABC.NET/julia-set.pas new file mode 100644 index 0000000000..479d731956 --- /dev/null +++ b/Task/Julia-set/PascalABC.NET/julia-set.pas @@ -0,0 +1,35 @@ +uses GraphWPF; + +const + W = 800; + H = 600; + Zoom = 1; + MaxIter = 255; + MoveX = 0; + MoveY = 0; + Cx = -0.7; + Cy = 0.27015; + +begin + var colors: array [0..255] of color; + for var n := 0 to 255 do + colors[n] := RGB(n shr 5 * 36, (n shr 3 and 7) * 36, (n and 3) * 85); + + Window.Title := 'Julia set'; + var image := new Color[W, H]; + + for var x := 0 to W - 1 do + for var y := 0 to H - 1 do + begin + var zx := 1.5 * (x - W / 2) / (0.5 * Zoom * W) + MoveX; + var zy := 1.0 * (y - H / 2) / (0.5 * Zoom * H) + MoveY; + var i := MaxIter; + while (zx * zx + zy * zy < 4) and (i > 1) do + begin + (zy, zx) := (2.0 * zx * zy + Cy, zx * zx - zy * zy + Cx); + i -= 1; + end; + image[x, y] := colors[i]; + end; + DrawPixels(0,0,image); +end. 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 49f65a5e24..c1f9ddbb06 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 @@ -1,71 +1,57 @@ -IF FILE input file; - STRING file name = "data.txt"; - open( input file, file name, stand in channel ) /= 0 -THEN - # failed to open the file # - print( ( "Unable to open """ + file name + """", newline ) ) -ELSE - # file opened OK # - BOOL at eof := FALSE; - # set the EOF handler for the file # - on logical file end( input file, ( REF FILE f )BOOL: - BEGIN - # note that we reached EOF on the latest read # - at eof := TRUE; - # return TRUE so processing can continue # - TRUE - END - ); - # return the real value of the specified field on the line # +BEGIN # Kernighan's large earthquake problem - show lines from data.txt that # + # record earthquakes greater than magnitude 6 # + + PR read "files.incl.a68" PR # include file utilities: EACHLINE, etc. # + + # return the real value of the specified field on the line # PROC real field = ( STRING line, INT field )REAL: BEGIN REAL result := 0; INT c pos := LWB line; - INT max pos := UPB line; + INT max pos = UPB line; STRING f := ""; - FOR f ield number TO field WHILE c pos <= max pos DO + FOR f ield number TO field WHILE c pos <= max pos AND f = "" DO # skip leading spaces # WHILE IF c pos > max pos THEN FALSE ELSE line[ c pos ] = " " FI DO c pos +:= 1 OD; - IF c pos <= max pos THEN - # have a field # + IF c pos <= max pos THEN # have a field # INT start pos = c pos; WHILE IF c pos > max pos THEN FALSE ELSE line[ c pos ] /= " " FI DO c pos +:= 1 OD; - IF field number = field THEN - # have the required field # + IF field number = field THEN # have the required field # f := line[ start pos : c pos - 1 ] FI FI OD; IF f /= "" THEN - # have the field - assume it a real value and convert it # + # have the field - assume it a real value and convert it # FILE real value; associate( real value, f ); - on value error( real value - , ( REF FILE ef )BOOL: - BEGIN - # "handle" invalid data # - result := 0; - # return TRUE so processing can continue # + on value error + ( real value + , ( REF FILE ef )BOOL: # "handles" ibvalid datq and # + BEGIN # returns TRUE so processing # + result := 0; # can continue # TRUE END - ); + ); get( real value, ( result ) ) FI; result END # real field # ; - # show the lines where the third field is > 6 # - WHILE NOT at eof - DO - STRING line; - get( input file, ( line, newline ) ); - IF real field( line, 3 ) > 6 THEN - print( ( line, newline ) ) - FI - OD; - # close the file # - close( input file ) -FI + # shows line if its third field is > 6, returns TRUE if it is # + PROC show large earthquake = ( STRING line, INT count so far )BOOL: + IF real field( line, 3 ) > 6 THEN + print( ( line, newline ) ); + TRUE + ELSE + FALSE + FI # show large earthquake # ; + + IF "data.txt" EACHLINE show large earthquake < 0 + THEN print( ( "Unable to open data.txt", newline ) ) + FI + +END diff --git a/Task/Kernighans-large-earthquake-problem/M2000-Interpreter/kernighans-large-earthquake-problem.m2000 b/Task/Kernighans-large-earthquake-problem/M2000-Interpreter/kernighans-large-earthquake-problem.m2000 index aa15495991..1b7668076e 100644 --- a/Task/Kernighans-large-earthquake-problem/M2000-Interpreter/kernighans-large-earthquake-problem.m2000 +++ b/Task/Kernighans-large-earthquake-problem/M2000-Interpreter/kernighans-large-earthquake-problem.m2000 @@ -18,3 +18,23 @@ Module Find_Magnitude { Close #F } Find_Magnitude +Module Find_MagnitudeUsingComma { + data$={8/27/1883 Krakatoa 8,8 + 5/18/1980 MountStHelens 7,6 + 3/13/2009 CostaRica 5,1 + 1/23/4567 EdgeCase1 6 + 1/24/4567 EdgeCase2 6,0 + 1/25/4567 EdgeCase3 6,1 + } + Open "data.txt" for output as F + Print #F, data$; + Close #F + Open "data.txt" for input as F + While not eof(#F) + Line Input #f, part$ + REM if val(mid$(part$,30), ",")>6 then print part$ + if val(mid$(part$,rinstr(rtrim$(part$)," ")),",")>6 then print part$ + End While + Close #F +} +Find_MagnitudeUsingComma diff --git a/Task/Kernighans-large-earthquake-problem/PascalABC.NET/kernighans-large-earthquake-problem.pas b/Task/Kernighans-large-earthquake-problem/PascalABC.NET/kernighans-large-earthquake-problem.pas new file mode 100644 index 0000000000..e9a71a4e27 --- /dev/null +++ b/Task/Kernighans-large-earthquake-problem/PascalABC.NET/kernighans-large-earthquake-problem.pas @@ -0,0 +1,4 @@ +## +foreach var s in ReadLines('data.txt') do + if StrToFloat(s.ToWords(' ')[2]) > 6 then + s.Println; diff --git a/Task/Keyboard-input-Obtain-a-Y-or-N-response/Nim/keyboard-input-obtain-a-y-or-n-response.nim b/Task/Keyboard-input-Obtain-a-Y-or-N-response/Nim/keyboard-input-obtain-a-y-or-n-response.nim index 0d670069b5..96191d8fce 100644 --- a/Task/Keyboard-input-Obtain-a-Y-or-N-response/Nim/keyboard-input-obtain-a-y-or-n-response.nim +++ b/Task/Keyboard-input-Obtain-a-Y-or-N-response/Nim/keyboard-input-obtain-a-y-or-n-response.nim @@ -1,41 +1,39 @@ -import strformat -import gintro/[glib, gobject, gtk, gio] -import gintro/gdk except Window +import std/strformat +import gtk2, glib2 +import gdk2 except PWindow -#--------------------------------------------------------------------------------------------------- -proc onKeyPress(window: ApplicationWindow; event: Event; label: Label): bool = - var keyval: int - if not event.getKeyval(keyval): return false +proc onKeyPress(window: PWindow; event: PEventKey; label: PLabel): bool = + let keyval = event.keyval.int if keyval in [ord('n'), ord('y')]: - label.setText(&"You pressed key '{chr(keyval)}'") + let text = &"You pressed key '{chr(keyval)}'" + label.setText(text.cstring) result = true -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +proc onDestroyEvent(widget: PWidget; data: pointer): gboolean {.cdecl.} = + ## Quit the application. + mainQuit() - let window = app.newApplicationWindow() - window.setTitle("Y/N response") - let hbox = newBox(Orientation.horizontal, 0) - window.add(hbox) - let vbox = newBox(Orientation.vertical, 10) - hbox.packStart(vbox, true, true, 20) +nimInit() +let window = windowNew(WINDOW_TOPLEVEL) +window.setSizeRequest(400, 200) +window.setTitle("Y/N response") - let label1 = newLabel(" Press 'y' or 'n' key ") - vbox.packStart(label1, true, true, 5) +let hbox = hboxNew(false, 0) +window.add hbox +let vbox = vboxNew(false, 10) +hbox.packStart(vbox, true, true, 20) - let label2 = newLabel() - vbox.packStart(label2, true, true, 5) +let label1 = labelNew(" Press 'y' or 'n' key ") +vbox.packStart(label1, true, true, 5) - discard window.connect("key-press-event", onKeyPress, label2) +let label2 = labelNew("") +vbox.packStart(label2, true, true, 5) - window.showAll() +discard window.signalConnect("key-press-event", SIGNAL_FUNC(onKeyPress), label2) +discard window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.YNResponse") -discard app.connect("activate", activate) -discard app.run() +window.showAll() +main() diff --git a/Task/Keyboard-macros/Nim/keyboard-macros.nim b/Task/Keyboard-macros/Nim/keyboard-macros.nim index d0581a54ea..6c6907507e 100644 --- a/Task/Keyboard-macros/Nim/keyboard-macros.nim +++ b/Task/Keyboard-macros/Nim/keyboard-macros.nim @@ -1,75 +1,73 @@ import tables -import gintro/[glib, gobject, gio] -import gintro/gtk except Table -import gintro/gdk except Window +import gtk2, glib2 +import gdk2 except PWindow type - MacroProc = proc(app: App) + MacroProc = proc(app: var App) MacroTable = Table[int, MacroProc] # Mapping key values -> procedures. - App = ref object of Application + App = object dispatchTable: MacroTable - label: Label + label: PLabel -#--------------------------------------------------------------------------------------------------- -proc addMacro(app: App; ch: char; macroProc: MacroProc) = +proc addMacro(app: var App; ch: char; macroProc: MacroProc) = ## Assign a procedure to a key. ## If the key is already assigned, nothing is done. let keyval = ord(ch) if keyval notin app.dispatchTable: app.dispatchTable[keyval] = macroProc -#--------------------------------------------------------------------------------------------------- + # Macro procedures. -proc proc1(app: App) = +proc proc1(app: var App) = app.label.setText("You called macro 1") -proc proc2(app: App) = +proc proc2(app: var App) = app.label.setText("You called macro 2") -proc proc3(app: App) = +proc proc3(app: var App) = app.label.setText("You called macro 3") -#--------------------------------------------------------------------------------------------------- -proc onKeyPress(window: ApplicationWindow; event: Event; app: App): bool = - var keyval: int - if not event.getKeyval(keyval): return false +proc onKeyPress(window: PWindow; event: PEventKey; app: var App): bool = + let keyval = event.keyval.int if keyval in app.dispatchTable: app.dispatchTable[keyval](app) result = true -#--------------------------------------------------------------------------------------------------- -proc activate(app: App) = - ## Activate the application. +proc onDestroyEvent(widget: PWidget; data: pointer): gboolean {.cdecl.} = + ## Quit the application. + mainQuit() - app.addMacro('1', proc1) - app.addMacro('2', proc2) - app.addMacro('3', proc3) - let window = app.newApplicationWindow() - window.setTitle("Keyboard macros") +var app: App - let hbox = newBox(Orientation.horizontal, 10) - window.add(hbox) - let vbox = newBox(Orientation.vertical, 10) - hbox.packStart(vbox, true, true, 10) +nimInit() - app.label = newLabel() - app.label.setWidthChars(18) - vbox.packStart(app.label, true, true, 5) +app.addMacro('1', proc1) +app.addMacro('2', proc2) +app.addMacro('3', proc3) - discard window.connect("key-press-event", onKeyPress, app) +let window = windowNew(WINDOW_TOPLEVEL) +window.setTitle("Keyboard macros") +window.setSizeRequest(300, 50) +discard window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) - window.showAll() +let hbox = hboxNew(false, 10) +window.add hbox +let vbox = vboxNew(false, 10) +hbox.packStart(vbox, true, true, 10) -#——————————————————————————————————————————————————————————————————————————————————————————————————— +app.label = labelNew(nil) +app.label.setWidthChars(18) +vbox.packStart(app.label, true, true, 5) -let app = newApplication(App, "Rosetta.KeyboardMacros") -discard app.connect("activate", activate) -discard app.run() +discard window.signalConnect("key-press-event", SIGNAL_FUNC(onKeyPress), app.addr) + +window.showAll() +main() diff --git a/Task/Knapsack-problem-0-1/Crystal/knapsack-problem-0-1.cr b/Task/Knapsack-problem-0-1/Crystal/knapsack-problem-0-1.cr index 2b6cdc7483..1fe589ff2b 100644 --- a/Task/Knapsack-problem-0-1/Crystal/knapsack-problem-0-1.cr +++ b/Task/Knapsack-problem-0-1/Crystal/knapsack-problem-0-1.cr @@ -26,7 +26,7 @@ class Knapsack candidate = items[candidate_index] # candidate is a best of available items, so if we fill remaining value with it # and still don't reach the threshold, the branch is wrong - return nil if taken.total_value + 1.0 * candidate.value / candidate.weight * remaining_weight < @threshold_value + return nil if taken.total_value + 1.0 * candidate.value / candidate.weight * remaining_weight <= @threshold_value # now recursively check both variants mask = taken.mask.clone mask[candidate_index] = true diff --git a/Task/Knapsack-problem-0-1/PascalABC.NET/knapsack-problem-0-1.pas b/Task/Knapsack-problem-0-1/PascalABC.NET/knapsack-problem-0-1.pas new file mode 100644 index 0000000000..bba4801d23 --- /dev/null +++ b/Task/Knapsack-problem-0-1/PascalABC.NET/knapsack-problem-0-1.pas @@ -0,0 +1,59 @@ +type + item = (string, integer, integer); + +const + wants: array of item = + |('map', 9, 150), + ('compass', 13, 35), + ('water', 153, 200), + ('sandwich', 50, 160), + ('glucose', 15, 60), + ('tin', 68, 45), + ('banana', 27, 60), + ('apple', 39, 40), + ('cheese', 23, 30), + ('beer', 52, 10), + ('suntan cream', 11, 70), + ('camera', 32, 30), + ('T-shirt', 24, 15), + ('trousers', 48, 10), + ('umbrella', 73, 40), + ('waterproof trousers', 42, 70), + ('waterproof overclothes', 43, 75), + ('note-case', 22, 80), + ('sunglasses', 7, 20), + ('towel', 18, 12), + ('socks', 4, 50), + ('book', 30, 10)|; + maxweight = 400; + +function m(i, w: integer): (List, integer, integer); +begin + var chosen := new List; + if (i < 0) or (w = 0) then + result := (chosen, 0, 0) + else if (wants[i].Item2 > w) then + result := m(i - 1, w) + else + begin + var (l0, w0, v0) := m(i - 1, w); + var (l1, w1, v1) := m(i - 1, w - wants[i].Item2); + v1 += wants[i].Item3; + if (v1 > v0) then + begin + l1.Add(wants[i]); + result := (l1, w1 + wants[i].Item2, v1); + end + else result := (l0, w0, v0); + end; +end; + +begin + var (chosenItems, totalWeight, totalValue) := m(wants.Count - 1, maxweight); + println('Knapsack Item Chosen Weight Value'); + println('---------------------- ------ -----'); + foreach var it in chosenItems do + writeln(it.Item1.PadRight(22), it.Item2:7, it.Item3:6); + println('---------------------- ------ -----'); + writeln('Total ', chosenItems.Count, ' Items Chosen', totalWeight:8, totalValue:6); +end. diff --git a/Task/Knights-tour/FutureBasic/knights-tour.basic b/Task/Knights-tour/FutureBasic/knights-tour.basic new file mode 100644 index 0000000000..40584f720b --- /dev/null +++ b/Task/Knights-tour/FutureBasic/knights-tour.basic @@ -0,0 +1,270 @@ +include "NSLog.incl" +output @"Knight's Move" + +_window = 1 +_layerView = 10 + +begin record moved + CGPoint offset + Int SquareMove +end record + +begin globals +dim move(8) as moved +int Squares(64) +CFMutableArrayRef gFinalArray +end globals + +gFinalArray = fn MutableArrayWithCapacity(0) + +local fn PointOffset( pt as CGPoint,offset as CGPoint) as CGPoint + pt.x += offset.x + pt.y += offset.y +end fn = pt + +local fn FindLocation( x as int ) as CGPoint + float a,b + float y = x/8 + float z = frac(y) + CGPoint pts + + If z == 0 + a = 8 + b = 8 - fix(y) + else + a = z*8 + b = 8 - fix(y) - 1 + end if + + pts.x = a*50 - 25 + pts.y = b*50 + 25 + +end fn = pts + +local fn SetRecord + for int x = 1 to 64 + Squares(x) = 0 + next + //8 possible moves for a Knight + move.offset.x(1) = -50 + move.offset.y(1) = -100 + move.SquareMove(1) = 15 + move.offset.x(2) = 50 + move.offset.y(2) = -100 + move.SquareMove(2) = 17 + move.offset.x(3) = -50 + move.offset.y(3) = 100 + move.SquareMove(3) = -17 + move.offset.x(4) = 50 + move.offset.y(4) = 100 + move.SquareMove(4) = -15 + move.offset.x(5) = 100 + move.offset.y(5) = 50 + move.SquareMove(5) = -6 + move.offset.x(6) = -100 + move.offset.y(6) = 50 + move.SquareMove(6) = -10 + move.offset.x(7) = 100 + move.offset.y(7) = -50 + move.SquareMove(7) = 10 + move.offset.x(8) = -100 + move.offset.y(8) = -50 + move.SquareMove(8) = 6 + +end fn + +local fn Check(y as int, x as int ) as bool + bool ans = NO + + select y + case 1 + select x + case > 48 + ans = No + case 1,9,17,25,33,41,49,57 + ans = NO + case else + ans = YES + end select + case 2 + select x + case > 48 + ans = NO + case 8,16,24,32,40,48,56,64 + ans = NO + case else + ans = YES + end select + case 3 + select x + case < 16 + ans = NO + case 1,9,17,25,33,41,49,57 + ans = NO + case else + ans = YES + end select + case 4 + select x + case < 16 + ans = NO + case 8,16,24,32,40,48,56,64 + ans = NO + case else + ans = YES + end select + case 5 + select x + case < 9 + ans = NO + case 7,8,15,16,23,24,31,32,39,40,47,48,55,56,63,64 + ans = NO + case else + ans = YES + end select + case 6 + select x + case < 9 + ans = NO + case 1,2,9,10,17,18,25,26,33,34,41,42,49,50,57,58 + ans = NO + case else + ans = YES + end select + case 7 + select x + case > 56 + ans = NO + case 7,8,15,16,23,24,31,32,39,40,47,48,55,56,63,64 + ans = NO + case else + ans = YES + end select + case 8 + select x + case > 56 + ans = NO + case 1,2,9,10,17,18,25,26,33,34,41,42,49,50,57,58 + ans = NO + case else + ans = YES + end select + end select +end fn = ans + +local fn DrawKnightsPassage( tag as long, array as CFArrayRef) as int + CALayerRef layer + CAShapeLayerRef shapeLayer + BezierPathRef path = fn BezierPathInit + int x,count = fn ArrayCount(array) + int square = fn StringIntValue(fn ArrayObjectAtIndex( array, 0)) + + layer = fn ViewLayer( tag ) + CALayerSetBackgroundColor( layer, fn ColorClear ) + CALayerSetBorderWidth( layer, 2 ) + shapeLayer = fn CAShapeLayerInit + CGPoint pt = fn FindLocation( square) + Squares(square) = 1 + BezierPathMoveToPoint( path, pt) + for x = 1 to count - 2 + square = fn StringIntValue(fn ArrayObjectAtIndex( array, x)) + pt = fn FindLocation( square) + BezierPathLineToPoint( path, pt) + next + + CAShapeLayerSetPath( shapeLayer, path ) + CAShapeLayerSetLineWidth( shapeLayer, 2 ) + CAShapeLayerSetLineCap( shapeLayer, kCALineCapRound ) + CAShapeLayerSetStrokeColor( shapeLayer, fn ColorBlue ) + CAShapeLayerSetFillColor( shapeLayer, fn ColorClear ) + CALayerAddSublayer( layer, shapeLayer ) + +end fn = x + +local fn KnightsTour as int + int x,j,y + int square = rnd(64)//58 //Starting square 58= White left Knight this is random start + CFMutableStringRef array = fn MutableStringWithCapacity(0) + CGPoint pt = fn FindLocation( square) + for x = 1 to 64 + Squares(x) = 0 + next + Squares(square) = 1 + MutableStringAppendString( array, fn StringWithFormat( @"%d:", square )) + + for x = 1 to 63 + j = 1 + do + y = rnd(8) + j++ + until (square > 0 && square < 65 && (fn Check(y,square)) && square + move.SquareMove(y) > 0 && Squares(square + move.SquareMove(y)) == 0) || j == 35 + if j == 35 then exit next + square += move.SquareMove(y) + MutableStringAppendString( array, fn StringWithFormat( @"%d:", square )) + + pt = fn PointOffset( pt, move.offset(y)) + Squares(square) = 1 + next + MutableArrayAddObject( gFinalArray, (CFTypeRef) array ) + +end fn = x + +void local fn BuildWnd + CGRect r + int x,y,j,Item(100000),max + ColorRef hue(1) // Thanks Jay + CALayerRef layer + bool i + CFTypeRef ans + CFArrayRef array + + window _window, @"Chess Board", ( 0,0,450,450) + view _layerView, (20,20,400,400) + WindowCenter(_window) + WindowSubclassContentView(_window) + ViewSetFlipped( _windowContentViewTag, YES ) + ViewSetNeedsDisplay( _windowContentViewTag ) + ViewSetWantsLayer( _layerView, YES ) + layer = fn ViewLayer( _layerview ) + ViewSetFlipped( _layerview, YES ) + CALayerSetBackgroundColor( layer, fn ColorClear ) + CALayerSetBorderWidth( layer, 2 ) + + r = fn CGREctMake( 20,20,50,50 ) + hue(NO) = fn colorLightGray + hue(YES) = fn ColorClear + i = YES + j = 1 + for x = 1 to 8 + for y = 1 to 8 + rect fill r, hue(i) + print %(r.origin.x,r.origin.y) j + r = fn CGRectOffset( r, 50,0) + j++ + if i == YES then i = NO else i = YES + next + if i == YES then i = NO else i = YES + r = fn CGRectOffset( r , - 400, 50 ) + next + for x = 1 to 100000 + item(x) = fn KnightsTour + next + max = 1 + y = 1 + for x = 1 to 99999 + if item(x) > max then max = item(x):y = x + next + + ans = fn ArrayObjectAtIndex(gFinalArray, y-1 ) + array = fn StringComponentsSeparatedByString(ans, @":" ) + + fn DrawKnightsPassage( _layerview, array) + NSLog(@"Starts at %@",fn ArrayObjectAtIndex( array, 0)) + NSLog(@"max= %d Item= %d try= %d", max, item(y), y ) + +end fn + +fn SetRecord +fn BuildWnd + +HandleEvents diff --git a/Task/Knuth-shuffle/Standard-ML/knuth-shuffle.ml b/Task/Knuth-shuffle/Standard-ML/knuth-shuffle.ml new file mode 100644 index 0000000000..5ee802311d --- /dev/null +++ b/Task/Knuth-shuffle/Standard-ML/knuth-shuffle.ml @@ -0,0 +1,23 @@ +val rng = ref (SplitMix64.init NONE) + +fun getRandInt max = + let + val (rng', next) = SplitMix64.nextRange (0, max) + val () = rng := rng' + in + Word64.toInt next + end + +fun knuthShuffle a = + let + val i = ref ((Array.length a) - 1) + in + while !i > 0 do + let + val a_i = Array.sub (a, !i) + val j = getRandInt !i + val a_j = Array.sub (a, j) + in + (Array.update (a, !i, a_j); Array.update (a, j, a_i); i := (!i - 1)) + end + end diff --git a/Task/Knuths-algorithm-S/PascalABC.NET/knuths-algorithm-s.pas b/Task/Knuths-algorithm-S/PascalABC.NET/knuths-algorithm-s.pas new file mode 100644 index 0000000000..e6116c92ff --- /dev/null +++ b/Task/Knuths-algorithm-S/PascalABC.NET/knuths-algorithm-s.pas @@ -0,0 +1,32 @@ +function s_of_n_creator(n: integer): T-> list; +begin + var sample := new List; + var i := 0; + + result := function(item: T): list -> + begin + i += 1; + if i <= n then + sample.add(item) + else if random(i) < n then + sample[random(n)] := item; + result := sample; + end; +end; + +begin + println('Digits counts for 100_000 runs:'); + var hist: array [0..9] of integer; + var sample := new List; + loop 100_000 do + begin + var s_of_n := s_of_n_creator&(3); + for var i := 0 to 9 do + sample := s_of_n(i); + foreach var val in sample do + hist[val] += 1; + end; + + foreach var count in hist index n do + writeln(n, ': ', count); +end. diff --git a/Task/Knuths-power-tree/PascalABC.NET/knuths-power-tree.pas b/Task/Knuths-power-tree/PascalABC.NET/knuths-power-tree.pas new file mode 100644 index 0000000000..c7321cb788 --- /dev/null +++ b/Task/Knuths-power-tree/PascalABC.NET/knuths-power-tree.pas @@ -0,0 +1,56 @@ +uses NumLibABC; + +var + p := Dict((1, 0)); + lvl := Lst(Lst(word(1))); + +function tofraction(s: string): fraction; +begin + var period := s.IndexOf('.'); + if period = -1 then result := Frc(s.ToBigInteger) + else result := Frc(s.Remove(period, 1).ToBigInteger, Power(10bi, s.Length - period - 1)); +end; + +function path(n: word): List; +begin + result := new List; + if n = 0 then exit; + while not p.ContainsKey(n) do + begin + var q := new List; + foreach var x in lvl[0] do + foreach var y in path(x) do + begin + if (x + y) in p then break; + p[x + y] := x; + q.add(x + y); + end; + lvl[0] := q; + end; + result := path(p[n]) + Lst(n); +end; + +function treePow(x: real; n: word): Fraction; +begin + var frac := tofraction(FloatToStr(x)); + var r := Dict((0, Frc(1)), (1, frac)); + var p := 0; + foreach var i in path(n) do + begin + r[i] := r[i - p] * r[p]; + p := i; + end; + result := r[n]; +end; + +procedure showPow(x: real; n: word); +begin + writeln(n, ': ', path(n)); + writeln(x, '^', n, ' = ', treePow(x, n), #10); +end; + +begin + for var n := 0 to 17 do showPow(2, n); + showPow(1.1, 81); + showPow(3, 191); +end. diff --git a/Task/Koch-curve/ALGOL-68/koch-curve.alg b/Task/Koch-curve/ALGOL-68/koch-curve.alg index bc36c46f10..2ecf137680 100644 --- a/Task/Koch-curve/ALGOL-68/koch-curve.alg +++ b/Task/Koch-curve/ALGOL-68/koch-curve.alg @@ -52,7 +52,7 @@ BEGIN # Koch Curve in SVG # put( svg file, ( "'/>", newline, "", newline ) ); close( svg file ) - FI # sierpinski square # ; + FI # koch curve # ; koch curve( "koch.svg", 600, 5, 4, 150, 150 ) diff --git a/Task/Kolakoski-sequence/PascalABC.NET/kolakoski-sequence.pas b/Task/Kolakoski-sequence/PascalABC.NET/kolakoski-sequence.pas new file mode 100644 index 0000000000..b22af518c0 --- /dev/null +++ b/Task/Kolakoski-sequence/PascalABC.NET/kolakoski-sequence.pas @@ -0,0 +1,59 @@ +function nextInCycle(a: array of integer; index: word) := a[index mod a.Length]; + +function kolakoski(a: array of integer; length: word): array of integer; +begin + SetLength(result, length); + var i := 0; + var k := 0; + + while true do + begin + result[i] := nextInCycle(a, k); + if result[k] > 1 then + for var j := 1 to result[k] - 1 do + begin + i += 1; + if i = length then exit; + result[i] := result[i - 1]; + end; + i += 1; + if i = length then exit; + k += 1; + end; +end; + +function possibleKolakoski(a: array of integer): boolean; +begin + var rle := new List; + var prev := a[0]; + var count := 1; + result := true; + + for var i := 1 to a.Count - 1 do + if a[i] = prev then + count += 1 + else + begin + rle.Add(count); + count := 1; + prev := a[i]; + end; + + foreach var val in rle index i do + if val <> a[i] then result := false; +end; + + +begin + var Ias := |[1, 2], [2, 1], [1, 3, 1, 2], [1, 3, 2, 1]|; + var Lengths := [20, 20, 30, 30]; + + foreach var (length, ia) in Zip(Lengths, Ias) do + begin + var kol := kolakoski(ia, length); + writeln('First ', length, ' members of the sequence generated by ', ia, ':'); + writeln(kol); + var s := if possibleKolakoski(kol) then 'Yes' else 'No'; + writeln('Possible Kolakoski sequence? ', s, #10); + end; +end. diff --git a/Task/Kosaraju/PascalABC.NET/kosaraju.pas b/Task/Kosaraju/PascalABC.NET/kosaraju.pas new file mode 100644 index 0000000000..157f2ee389 --- /dev/null +++ b/Task/Kosaraju/PascalABC.NET/kosaraju.pas @@ -0,0 +1,46 @@ +function kosaraju(g: List): array of integer; +var + size := g.Count; + vis: array of boolean := new boolean[size]; + l: array of integer := new integer[size]; + c: array of integer := new integer[size]; + x := size; + t: array of List := new List[size]; + + procedure visit(u: integer); + begin + if not vis[u] then + begin + vis[u] := true; + foreach var v in g[u] do + begin + visit(v); + t[v].Add(u); + end; + dec(x); + l[x] := u; + end; + end; + + procedure assign(u, root: integer); + begin + if vis[u] then + begin + vis[u] := false; + c[u] := root; + foreach var v in t[u] do assign(v, root); + end; + end; + +begin + for var i := 0 to t.Count - 1 do t[i] := new List; + + foreach var u in [0..size - 1] do visit(u); + foreach var u in l do assign(u, u); + result := c; +end; + +begin + var g := Lst(|1|, |2|, |0|, |1, 2, 4|, |3, 5|, |2, 6|, |5|, |4, 6, 7|); + println(kosaraju(g)); +end. diff --git a/Task/Kronecker-product-based-fractals/PascalABC.NET/kronecker-product-based-fractals.pas b/Task/Kronecker-product-based-fractals/PascalABC.NET/kronecker-product-based-fractals.pas new file mode 100644 index 0000000000..64856ba1fa --- /dev/null +++ b/Task/Kronecker-product-based-fractals/PascalABC.NET/kronecker-product-based-fractals.pas @@ -0,0 +1,39 @@ +type + Matrix = array [,] of integer; + +function kronecker(a, b: Matrix): Matrix; +begin + SetLength(result, a.RowCount * b.RowCount, a.ColCount * b.ColCount); + for var i := 0 to a.RowCount - 1 do + for var j := 0 to a.ColCount - 1 do + for var k := 0 to b.RowCount - 1 do + for var l := 0 to b.ColCount - 1 do + result[b.RowCount * i + k, b.ColCount * j + l] := a[i, j] * b[k, l]; +end; + +function kroneckerPower(m: Matrix; n: integer): Matrix; +begin + result := Copy(m); + foreach var i in 2..n do + result := kronecker(result, m) +end; + +procedure printMatrix(text: String; m: Matrix); +begin + println(text, 'fractal :'); + for var i := 0 to m.RowCount - 1 do + begin + for var j := 0 to m.ColCount - 1 do + write(if (m[i, j] = 1) then '*' else ' '); + println(); + end; + println(); +end; + +begin + var a: Matrix := ((0, 1, 0), (1, 1, 1), (0, 1, 0)); + printMatrix('Vicsek', kroneckerPower(a, 4)); + + var b: Matrix := ((1, 1, 1), (1, 0, 1), (1, 1, 1)); + printMatrix('Sierpinski carpet', kroneckerPower(b, 4)) +end. diff --git a/Task/Kronecker-product/PascalABC.NET/kronecker-product.pas b/Task/Kronecker-product/PascalABC.NET/kronecker-product.pas new file mode 100644 index 0000000000..6e0fb920fb --- /dev/null +++ b/Task/Kronecker-product/PascalABC.NET/kronecker-product.pas @@ -0,0 +1,22 @@ +type + Matrix = array [,] of integer; + +function kronecker(a, b: Matrix): Matrix; +begin + SetLength(result, a.RowCount * b.RowCount, a.ColCount * b.ColCount); + for var i := 0 to a.RowCount - 1 do + for var j := 0 to a.ColCount - 1 do + for var k := 0 to b.RowCount - 1 do + for var l := 0 to b.ColCount - 1 do + result[b.RowCount * i + k, b.ColCount * j + l] := a[i, j] * b[k, l]; +end; + +begin + var a1: Matrix := ((1, 2), (3, 4)); + var b1: Matrix := ((0, 5), (6, 7)); + kronecker(a1, b1).Println; + println; + var a2: Matrix := ((0, 1, 0), (1, 1, 1), (0, 1, 0)); + var b2: Matrix := ((1, 1, 1, 1), (1, 0, 0, 1), (1, 1, 1, 1)); + kronecker(a2, b2).Println; +end. diff --git a/Task/LZW-compression/PascalABC.NET/lzw-compression.pas b/Task/LZW-compression/PascalABC.NET/lzw-compression.pas new file mode 100644 index 0000000000..a21d45daa7 --- /dev/null +++ b/Task/LZW-compression/PascalABC.NET/lzw-compression.pas @@ -0,0 +1,63 @@ +function Compress(uncompressed: string): list; +begin + // build the dictionary + var dictionary := new Dictionary; + for var i := 0 to 255 do + dictionary[Chr(i).ToString] := i; + + var w := ''; + var compressed := new List; + + foreach var c in uncompressed do + begin + var wc := w + c; + if wc in dictionary then w := wc + else begin + // write w to output + compressed.Add(dictionary[w]); + // wc is a new sequence; add it to the dictionary + dictionary[wc] := dictionary.Count; + w := c.ToString; + end; + end; + + // write remaining output if necessary + if w <> '' then compressed.Add(dictionary[w]); + result := compressed; +end; + +function Decompress(compressed: list): string; +begin + // build the dictionary + var dictionary := new Dictionary; + for var i := 0 to 255 do + dictionary[i] := Chr(i).ToString; + + var w := dictionary[compressed[0]]; + compressed.RemoveAt(0); + var decompressed := new StringBuilder(w); + + foreach var k in compressed do + begin + var entry := ''; + if k in dictionary then entry := dictionary[k] + else + if k = dictionary.Count then entry := w + w[0]; + + decompressed.Append(entry); + + // new sequence; add it to the dictionary + dictionary[dictionary.Count] := w + entry[1]; + + w := entry; + end; + + result := decompressed.ToString; +end; + +begin + var compressed := Compress('TOBEORNOTTOBEORTOBEORNOT'); + Writeln(compressed); + var decompressed := Decompress(compressed); + Writeln(decompressed); +end. diff --git a/Task/Lah-numbers/Ada/lah-numbers.ada b/Task/Lah-numbers/Ada/lah-numbers.ada new file mode 100644 index 0000000000..67e6a3b0c0 --- /dev/null +++ b/Task/Lah-numbers/Ada/lah-numbers.ada @@ -0,0 +1,70 @@ +-- Rosetta Code Task written in Ada +-- Lah numbers +-- https://rosettacode.org/wiki/Lah_numbers +-- (Mostly) translated from the AWK example +-- Proper formatting of the Big Integers would be nice. +-- Not important here, but in general, the factorials should be cached for greater performance. +-- Could use alternate libraries for large integers... +-- January 2025, R. B. E. +-- Using GNAT Big Integers, GNAT version 14.2, MacOS 15.3, M1 chip + +pragma Ada_2022; +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Ada.Numerics.Big_Numbers.Big_Integers; use Ada.Numerics.Big_Numbers.Big_Integers; + +procedure Lah_Numbers is + + function Factorial (F : Natural) return Big_Positive is + Prod : Big_Positive := To_Big_Integer (1); + begin + for I in reverse 2..F loop + Prod := Prod * To_Big_Integer (I); + end loop; + return Prod; + end Factorial; + + function Lah (N, K : Natural) return Big_Natural is + begin + if (K = 1) then + return Factorial (N); + end if; + if (K = N) then + return (To_Big_Integer (1)); + end if; + if (K > N) then + return (To_Big_Integer (0)); + end if; + if ((K < 1) or (N < 1)) then + return (To_Big_Integer (0)); + end if; + return (Factorial (N) * Factorial (N-1)) / (Factorial (K) * Factorial (K-1)) / Factorial (N-K); + end Lah; + + Biggest_Lah_Number_in_Row_100 : Big_Natural := To_Big_Integer (0); + Candidate_Biggest_Lah_Number_in_Row_100 : Big_Positive; + +begin + Put_Line ("unsigned Lah numbers: L(n,k)"); + Put ("n/k"); + for I in 0..12 loop + Put (I, 3); + end loop; + New_Line; + for Row in 0..12 loop + Put (Row, 2); + for Col in 0..Row loop + Put (To_String (Lah (Row, Col))); + end loop; + New_Line; + end loop; + New_Line; + for Col in 0..12 loop + Candidate_Biggest_Lah_Number_in_Row_100 := Lah (100, Col); + if Biggest_Lah_Number_in_Row_100 < Candidate_Biggest_Lah_Number_in_Row_100 then + Biggest_Lah_Number_in_Row_100 := Candidate_Biggest_Lah_Number_in_Row_100; + end if; + end loop; + Put_Line ("Maximum value of L(n,k) where n = 100:"); + Put_Line (To_String (Biggest_Lah_Number_in_Row_100)); +end Lah_Numbers; diff --git a/Task/Lah-numbers/Forth/lah-numbers.fth b/Task/Lah-numbers/Forth/lah-numbers.fth new file mode 100644 index 0000000000..4236464c90 --- /dev/null +++ b/Task/Lah-numbers/Forth/lah-numbers.fth @@ -0,0 +1,34 @@ +: factorial ( u -- u ) + 1 swap + begin + dup 0> + while + tuck * swap 1- + repeat + drop ; + +: lah ( n k -- u ) + dup 1 = if drop factorial exit then + dup 1 < if 2drop 0 exit then + over 1 < if 2drop 0 exit then + 2dup = if 2drop 1 exit then + 2dup < if 2drop 0 exit then + dup factorial over 1- factorial * >r + swap dup factorial over 1- factorial * + r> / >r swap - factorial r> swap / ; + +: main ( -- ) + ." Unsigned Lah numbers L(n, k):" cr + ." n/k" + 13 1 do + i 11 .r + loop cr + 13 1 do + i 3 .r + i 1+ 1 do + j i lah 11 .r + loop cr + loop ; + +main +bye diff --git a/Task/Lah-numbers/PascalABC.NET/lah-numbers.pas b/Task/Lah-numbers/PascalABC.NET/lah-numbers.pas new file mode 100644 index 0000000000..6ee08fcda3 --- /dev/null +++ b/Task/Lah-numbers/PascalABC.NET/lah-numbers.pas @@ -0,0 +1,38 @@ +function binomial(n, k: integer): biginteger; +begin + result := 1bi; + for var i := 1 to k do + result := result * (n - i + 1) div i; +end; + +function factorial(n: integer): biginteger; +begin + result := 1bi; + for var i := 2 to n do + result *= i; +end; + +function lah(n, k: integer; signed: boolean := false): biginteger; +begin + if (n = 0) or (k = 0) or (k > n) then result := 0bi + else + if n = k then result := 1bi + else + if k = 1 then result := factorial(n) + else + begin + result := binomial(n, k) * binomial(n - 1, k - 1) * factorial(n - k); + if signed and ((n and 1) <> 0) then result := -result; + end; +end; + +begin + for var n := 0 to 12 do + begin + for var k := 0 to n do + print(lah(n, k)); + println; + end; + println; + (1..100).Select(k -> lah(100, k)).Max.Println; +end. diff --git a/Task/Lah-numbers/Refal/lah-numbers.refal b/Task/Lah-numbers/Refal/lah-numbers.refal new file mode 100644 index 0000000000..3f7d3df290 --- /dev/null +++ b/Task/Lah-numbers/Refal/lah-numbers.refal @@ -0,0 +1,60 @@ +$ENTRY Go { + = > + + + >>; +}; + +Fac { + 0 = 1; + e.N = >>; +}; + +Lah { + (e.N) e.N = 1; + (0) e.K = 0; + (e.N) 0 = 0; + (e.N) 1 = ; + (e.N) e.K, + ) >>: e.1, + ) >>: e.2, + >: e.3 = +
) e.3>; +}; + +FindMax { + = ; + (e.M) 101 = e.M; + (e.M) s.I, : e.C = + ) >; +}; + +Max { + (e.1) e.2, : { + '+' = e.1; + s.C = e.2; + }; +}; + +Rpt { + 0 s.C = ; + s.N s.C = s.C s.C>; +}; + +Fmt { + s.W e.N, >: (e.1) e.2 = e.2; +}; + +Row { + s.N = >>>; +}; + +Iota { + s.E s.E = s.E; + s.S s.E = s.S s.E>; +}; + +Each { + (e.F) = ; + (e.F) t.X e.Xs = ; +}; diff --git a/Task/Langtons-ant/PascalABC.NET/langtons-ant.pas b/Task/Langtons-ant/PascalABC.NET/langtons-ant.pas new file mode 100644 index 0000000000..22be724089 --- /dev/null +++ b/Task/Langtons-ant/PascalABC.NET/langtons-ant.pas @@ -0,0 +1,35 @@ +type + Direction = (up, right, down, left); + Color = (white, black); + +const + width = 75; + height = 52; + maxSteps = 12_000; + +begin + var m: array [1..height] of array [1..width] of color; + var dir := up; + var x := width div 2; + var y := height div 2; + + var i := 0; + while (i < maxSteps) and (x in (1..width )) and (y in (1..height )) do + begin + var turn := m[y][x] = black; + m[y][x] := if m[y][x] = black then white else black; + + dir := Direction((4 + integer(dir) + (if turn then 1 else -1)) mod 4); + case dir of + up: dec(y); + right: dec(x); + down: inc(y); + left: inc(x); + end; + + inc(i); + end; + + for var row := 1 to height do + m[row].select(x -> (if x = white then '.' else '#')).println; +end. diff --git a/Task/Largest-int-from-concatenated-ints/ALGOL-68/largest-int-from-concatenated-ints.alg b/Task/Largest-int-from-concatenated-ints/ALGOL-68/largest-int-from-concatenated-ints.alg index 6c96705df9..828bd7f5e9 100644 --- a/Task/Largest-int-from-concatenated-ints/ALGOL-68/largest-int-from-concatenated-ints.alg +++ b/Task/Largest-int-from-concatenated-ints/ALGOL-68/largest-int-from-concatenated-ints.alg @@ -1,5 +1,4 @@ BEGIN - # returns the integer value of s # OP TOINT = ( STRING s)INT: BEGIN INT result := 0; @@ -8,38 +7,21 @@ BEGIN OD; result END # TOINT # ; - # returns the first digit of n # - OP FIRSTDIGIT = ( INT n )INT: - BEGIN - INT result := ABS n; - WHILE result > 9 DO result OVERAB 10 OD; - result - END # FIRSTDIGIT # ; - # returns a string representaton of n # OP TOSTRING = ( INT n )STRING: whole( n, 0 ); - # returns an array containing the values of a sorted such that concatenating the values would result in the largest value # + OP PRINT = ( []INT a )VOID: + FOR a pos FROM LWB a TO UPB a DO + print( ( TOSTRING a[ a pos ] ) ) + OD # PRINT # ; + + # returns an array containing the values of a sorted such that # + # concatenating the values would result in the largest value # OP CONCATSORT = ( []INT a )[]INT: - IF LWB a >= UPB a THEN - # 0 or 1 element(s) # + IF LWB a >= UPB a THEN # 0 or 1 element(s) # a - ELSE - # 2 or more elements # + ELSE # 2 or more elements # [ 1 : ( UPB a - LWB a ) + 1 ]INT result := a[ AT 1 ]; - # sort the numbers into reverse first digit order # - FOR o pos FROM UPB result - 1 BY -1 TO 1 - WHILE BOOL swapped := FALSE; - FOR i pos TO o pos DO - IF FIRSTDIGIT result[ i pos ] < FIRSTDIGIT result[ i pos + 1 ] THEN - INT t = result[ i pos + 1 ]; - result[ i pos + 1 ] := result[ i pos ]; - result[ i pos ] := t; - swapped := TRUE - FI - OD; - swapped - DO SKIP OD; - # now re-order adjacent numbers so they have the highest concatenated value # - WHILE BOOL swapped := FALSE; + # re-order adjacent numbers so they have the highest concatenated # + WHILE BOOL swapped := FALSE; # value # FOR i pos TO UPB result - 1 DO STRING l := TOSTRING result[ i pos ]; STRING r := TOSTRING result[ i pos + 1 ]; @@ -54,11 +36,6 @@ BEGIN DO SKIP OD; result FI # CONCATSORT # ; - # prints the array a # - OP PRINT = ( []INT a )VOID: - FOR a pos FROM LWB a TO UPB a DO - print( ( TOSTRING a[ a pos ] ) ) - OD # PRINT # ; # task test cases # PRINT CONCATSORT []INT( 1, 34, 3, 98, 9, 76, 45, 4 ); diff --git a/Task/Largest-int-from-concatenated-ints/PascalABC.NET/largest-int-from-concatenated-ints.pas b/Task/Largest-int-from-concatenated-ints/PascalABC.NET/largest-int-from-concatenated-ints.pas new file mode 100644 index 0000000000..65036d600b --- /dev/null +++ b/Task/Largest-int-from-concatenated-ints/PascalABC.NET/largest-int-from-concatenated-ints.pas @@ -0,0 +1,10 @@ +## +function maxNum(x: array of integer): string; +begin + var s := x.select(n -> n.tostring).ToList; + sort(s, (x, y) -> (x > y)); + result := s.Aggregate((p, x) -> p + x); +end; + +maxNum([1, 34, 3, 98, 9, 76, 45, 4]).println; +maxNum([54, 546, 548, 60]).println; diff --git a/Task/Largest-number-divisible-by-its-digits/PascalABC.NET/largest-number-divisible-by-its-digits.pas b/Task/Largest-number-divisible-by-its-digits/PascalABC.NET/largest-number-divisible-by-its-digits.pas new file mode 100644 index 0000000000..cec834c71c --- /dev/null +++ b/Task/Largest-number-divisible-by-its-digits/PascalABC.NET/largest-number-divisible-by-its-digits.pas @@ -0,0 +1,37 @@ +function digits(n: int64; base: byte): List; +begin + result := new List; + repeat + result.Add(byte(n mod base)); + n := n div base; + until n = 0; +end; + +function isLynchBell(num: int64; base: byte) := digits(num, base).All(x -> num mod x = 0); + +begin + for var n := 9876432 downto 1 do + begin + var dignum := digits(n, 10); + if (dignum.Count = dignum.ToSet.Count) and (not dignum.Contains(0)) then + if islynchbell(n, 10) then + begin + Println('Largest decimal number is:', n); + break; + end; + end; + + var magic := 15 * 14 * 13 * 12 * 11; + var n := $fedcba987654321 div magic * magic; + while n > 0 do + begin + var dignum := digits(n, 16); + if (dignum.Count = dignum.ToSet.Count) and (not dignum.Contains(0)) then + if islynchbell(n, 16) then + begin + Println('Largest hex number is:', n.ToString('x')); + break; + end; + n -= magic; + end; +end. diff --git a/Task/Largest-proper-divisor-of-n/PascalABC.NET/largest-proper-divisor-of-n.pas b/Task/Largest-proper-divisor-of-n/PascalABC.NET/largest-proper-divisor-of-n.pas new file mode 100644 index 0000000000..647abc0431 --- /dev/null +++ b/Task/Largest-proper-divisor-of-n/PascalABC.NET/largest-proper-divisor-of-n.pas @@ -0,0 +1,5 @@ +## +function lpd(n: integer) := range((n / 2).Ceil, 1, -1).First(x -> n mod x = 0); + +for var n := 1 to 100 do + write(lpd(n):3, if n mod 10 = 0 then #10 else ''); diff --git a/Task/Last-Friday-of-each-month/PascalABC.NET/last-friday-of-each-month.pas b/Task/Last-Friday-of-each-month/PascalABC.NET/last-friday-of-each-month.pas new file mode 100644 index 0000000000..47e447bda8 --- /dev/null +++ b/Task/Last-Friday-of-each-month/PascalABC.NET/last-friday-of-each-month.pas @@ -0,0 +1,16 @@ +## +uses System; + +var year := ReadlnInteger('Enter year:'); +var date := new DateTime(year, 12, 31); + +var lastfridays := + (0..360) + .Select(x -> date.AddDays(-x)) + .where(x -> x.DayOfWeek = DayOfWeek.friday) + .GroupBy(x -> x.Month) + .Select(g -> g.First) + .Reverse; + +foreach var d in lastfridays do + writeln(d.Year, '-', d.Month, '-', d.Day); diff --git a/Task/Last-letter-first-letter/PascalABC.NET/last-letter-first-letter.pas b/Task/Last-letter-first-letter/PascalABC.NET/last-letter-first-letter.pas new file mode 100644 index 0000000000..f5a1935ff4 --- /dev/null +++ b/Task/Last-letter-first-letter/PascalABC.NET/last-letter-first-letter.pas @@ -0,0 +1,57 @@ +var + names: array of string := ( + 'audino', 'bagon', 'baltoy', 'banette', 'bidoof', + 'braviary', 'bronzor', 'carracosta', 'charmeleon', 'cresselia', + 'croagunk', 'darmanitan', 'deino', 'emboar', 'emolga', + 'exeggcute', 'gabite', 'girafarig', 'gulpin', 'haxorus', + 'heatmor', 'heatran', 'ivysaur', 'jellicent', 'jumpluff', + 'kangaskhan', 'kricketune', 'landorus', 'ledyba', 'loudred', + 'lumineon', 'lunatone', 'machamp', 'magnezone', 'mamoswine', + 'nosepass', 'petilil', 'pidgeotto', 'pikachu', 'pinsir', + 'poliwrath', 'poochyena', 'porygon2', 'porygonz', 'registeel', + 'relicanth', 'remoraid', 'rufflet', 'sableye', 'scolipede', + 'scrafty', 'seaking', 'sealeo', 'silcoon', 'simisear', + 'snivy', 'snorlax', 'spoink', 'starly', 'tirtouga', + 'trapinch', 'treecko', 'tyrogue', 'vigoroth', 'vulpix', + 'wailord', 'wartortle', 'whismur', 'wingull', 'yamask'); + +var + maxPathLength := 0; + maxPathLengthCount := 0; + maxPathExample := ''; + +procedure search(part: array of string; offset: integer); +begin + if (offset > maxPathLength) then + begin + maxPathLength := offset; + maxPathLengthCount := 1; + end + else if (offset = maxPathLength) then + begin + maxPathLengthCount += 1; + maxPathExample := ''; + foreach var i in (0..offset - 1) do + maxPathExample := maxpathexample + (if (i mod 5 = 0) then #10 else ' ') + part[i]; + end; + var lastChar := part[offset - 1].last; + foreach var i in (offset..part.Length - 1) do + if (part[i][1] = lastChar) then + begin + Swap(names[offset], names[i]); + search(names, offset + 1); + Swap(names[offset], names[i]); + end; +end; + +begin + foreach var i in (0..names.Length - 1) do + begin + Swap(names[0], names[i]); + search(names, 1); + Swap(names[0], names[i]); + end; + println('Maximum path length : ', maxPathLength); + println('Paths of that length : ', maxPathLengthCount); + println('Example path of that length : ', maxPathExample); +end. diff --git a/Task/Law-of-cosines---triples/PascalABC.NET/law-of-cosines---triples.pas b/Task/Law-of-cosines---triples/PascalABC.NET/law-of-cosines---triples.pas new file mode 100644 index 0000000000..8c73a2086b --- /dev/null +++ b/Task/Law-of-cosines---triples/PascalABC.NET/law-of-cosines---triples.pas @@ -0,0 +1,23 @@ +## +function issqr(n: integer) := n.Sqrt.Floor.sqr = n; + +var alltriples := (1..13).Cartesian(3).Where(x -> (x[0] <= x[1]) and (x[1] <= x[2])); + +var tri90 := alltriples.where(x -> x[0].sqr + x[1].sqr = x[2].sqr); +println('For an angle of 90 there are', tri90.count, 'solutions:'); +tri90.println; + +var tri60 := alltriples.Where(x -> (x[0].sqr + x[1].sqr - x[0] * x[1] = x[2].sqr) or + (x[0].sqr + x[2].sqr - x[0] * x[2] = x[1].sqr)); +println(#10, 'For an angle of 60 there are', tri60.count, 'solutions:'); +tri60.println; + +var tri120 := alltriples.Where(x -> x[0].sqr + x[1].sqr + x[0] * x[1] = x[2].sqr); +println(#10, 'For an angle of 120 there are', tri120.count, 'solutions:'); +tri120.println; + +var tri60notsame := (1..10_000) + .Combinations(2) + .Where(x -> issqr(x[0].sqr + x[1].sqr - x[0] * x[1])) + .Count; +println(#10, '60 degree triangle where sides are not equal, there are', tri60notsame, 'solutions'); diff --git a/Task/Leap-year/Uiua/leap-year.uiua b/Task/Leap-year/Uiua/leap-year.uiua new file mode 100644 index 0000000000..d2fba7928d --- /dev/null +++ b/Task/Leap-year/Uiua/leap-year.uiua @@ -0,0 +1 @@ +Leap ← ◿2/+=0◿100_400_4 diff --git a/Task/Leap-year/YAMLScript/leap-year.ys b/Task/Leap-year/YAMLScript/leap-year.ys index ef0b841aca..d26e73d558 100644 --- a/Task/Leap-year/YAMLScript/leap-year.ys +++ b/Task/Leap-year/YAMLScript/leap-year.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(year=2024): say: "$year is $when-not( diff --git a/Task/Left-factorials/Ada/left-factorials.ada b/Task/Left-factorials/Ada/left-factorials.ada new file mode 100644 index 0000000000..238684691c --- /dev/null +++ b/Task/Left-factorials/Ada/left-factorials.ada @@ -0,0 +1,76 @@ +-- Rosetta Code Task written in Ada +-- Left factorials +-- https://rosettacode.org/wiki/Left_factorials +-- (Mostly) translated from the AWK example +-- February 2025, R. B. E. +-- Using PragmARC.Unbounded_Numbers, GNAT version 14.2.0-3, MacOS 15.3, M1 chip + +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with PragmARC.Unbounded_Numbers.Integers; use PragmARC.Unbounded_Numbers.Integers; + +procedure Left_Factorials is + + function Left_Fact (F : Natural) return Unbounded_Integer is + Result : Unbounded_Integer := To_Unbounded_Integer (0); + Adder : Unbounded_Integer := To_Unbounded_Integer (1); + begin + if F = 0 then + return Result; + end if; + for K in 1..F loop + Result := Result + Adder; + Adder := Adder * To_Unbounded_Integer (K); + end loop; + return Result; + end Left_Fact; + + function Brute_Force_Digit_String_Length (N : in Unbounded_Integer) return Natural is + Big_Zero : constant Unbounded_Integer := To_Unbounded_Integer (0); + Big_Ten : constant Unbounded_Integer := To_Unbounded_Integer (10); + Local_N : Unbounded_Integer := N; + String_Length : Natural := 0; + begin + loop + exit when Local_N = Big_Zero; + Local_N := Local_N / Big_Ten; + String_Length := String_Length + 1; + end loop; + return String_Length; + end Brute_Force_Digit_String_Length; + +begin + for I in 0..10 loop + Put ("!"); + Put (I, 0); + Put (" = "); + Put (Image (Value => Left_Fact (I))); + New_Line; + end loop; + New_Line; + for I in 20..110 loop + if (I mod 10) = 0 then + Put ("!"); + Put (I, 0); + Put (" ="); + if I < 70 then + Put (" "); + else + New_Line; + end if; + Put (Image (Value => Left_Fact (I))); + New_Line; + end if; + end loop; + New_Line; + for I in 1_000..10_000 loop + if (I mod 1_000) = 0 then + Put ("!"); + Put (I, 0); + Put (" has "); + Put (Brute_Force_Digit_String_Length (Left_Fact (I)), 0); + Put_Line (" digits."); + end if; + end loop; + New_Line; +end Left_Factorials; diff --git a/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-1.rexx b/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-1.rexx new file mode 100644 index 0000000000..7dde8a8542 --- /dev/null +++ b/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-1.rexx @@ -0,0 +1,32 @@ +Main: +include Settings +say version; say 'Legendre Prime counter (no memoization)'; say +numeric digits 10 +do n = 0 to 9 + call Time('r') + a = 10**n; p = pi(a) + say '10^'n Right(p,9) Format(Time('e'),3,3)'s' +end +exit + +Pi: +procedure expose prim. +arg xx +if xx < 3 then + return 0+(xx=2) +n = Primes(Isqrt(xx)) +return Phi(xx,n)+n-1 + +Phi: +procedure expose prim. +arg xx,yy +if yy < 2 then + return xx-(xx%2)*(yy=1) +p = prim.prime.yy +if xx <= p then + return 1 +return Phi(xx,yy-1)-Phi(xx%p,yy-1) + +include Abend +include Functions +include Sequences diff --git a/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-2.rexx b/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-2.rexx new file mode 100644 index 0000000000..3ca9b25734 --- /dev/null +++ b/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-2.rexx @@ -0,0 +1,36 @@ +Main: +include Settings +say version; say 'Legendre Prime counter (with memoization)'; say +numeric digits 10 +do n = 0 to 9 + call Time('r') + a = 10**n; p = Pi(a) + say '10^'n Right(p,9) Format(Time('e'),3,3)'s' +end +exit + +Pi: +procedure expose prim. work. +arg xx +if xx < 3 then + return 0+(xx=2) +n = Primes(Isqrt(xx)) +work. = 0 +return Phi(xx,n)+n-1 + +Phi: +procedure expose prim. work. +arg xx,yy +if yy < 2 then + return xx-(xx%2)*(yy=1) +p = prim.prime.yy +if xx <= p then + return 1 +if work.xx.yy > 0 then + return work.xx.yy +work.xx.yy = Phi(xx,yy-1)-Phi(xx%p,yy-1) +return work.xx.yy + +include Abend +include Functions +include Sequences diff --git a/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-3.rexx b/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-3.rexx new file mode 100644 index 0000000000..44c20aa6e8 --- /dev/null +++ b/Task/Legendre-prime-counting-function/REXX/legendre-prime-counting-function-3.rexx @@ -0,0 +1,14 @@ +Main: +include Settings +say version; say 'Legendre Prime counter (sieving)'; say +numeric digits 10 +do n = 0 to 8 + call Time('r') + a = 10**n; p = Primes(a) + say '10^'n Right(p,9) Format(Time('e'),3,3)'s' +end +exit + +include Abend +include Functions +include Sequences diff --git a/Task/Leonardo-numbers/ANSI-BASIC/leonardo-numbers.basic b/Task/Leonardo-numbers/ANSI-BASIC/leonardo-numbers.basic new file mode 100644 index 0000000000..1ea42efc8e --- /dev/null +++ b/Task/Leonardo-numbers/ANSI-BASIC/leonardo-numbers.basic @@ -0,0 +1,18 @@ +100 REM Leonardo numbers +110 DECLARE EXTERNAL SUB PrintLeonardoNums +120 CALL PrintLeonardoNums(1, 1, 1, 25, "Leonardo numbers") +130 CALL PrintLeonardoNums(0, 1, 0, 25, "Fibonacci numbers") +140 END +150 REM ** +160 EXTERNAL SUB PrintLeonardoNums(L0, L1, Sum, Lmt, What$) +170 PRINT What$; " ("; L0; ","; L1; ","; Sum; "):" +180 IF Lmt >= 1 THEN PRINT L0; +190 IF Lmt >= 2 THEN PRINT L1; +200 FOR I = 3 TO Lmt +210 PRINT L0 + L1 + Sum; +220 LET Tmp = L0 +230 LET L0 = L1 +240 LET L1 = Tmp + L1 + Sum +250 NEXT I +260 PRINT +270 END SUB diff --git a/Task/Leonardo-numbers/Forth/leonardo-numbers.fth b/Task/Leonardo-numbers/Forth/leonardo-numbers.fth new file mode 100644 index 0000000000..cd123f5fa7 --- /dev/null +++ b/Task/Leonardo-numbers/Forth/leonardo-numbers.fth @@ -0,0 +1,18 @@ +: leonardo-next ( n1 n2 n3 -- n1 n1+n2+n3 n2 ) + swap dup >r + over + r> ; + +: leonardo-print ( n1 n2 n3 u -- ) + 0 do + dup . + leonardo-next + loop + drop 2drop ; + +: main ( -- ) + ." First 25 Leonardo numbers:" cr + 1 1 1 25 leonardo-print cr + ." First 25 Fibonacci numbers:" cr + 0 1 0 25 leonardo-print cr ; + +main +bye diff --git a/Task/Leonardo-numbers/Free-Pascal-Lazarus/leonardo-numbers.pas b/Task/Leonardo-numbers/Free-Pascal-Lazarus/leonardo-numbers.pas new file mode 100644 index 0000000000..2e6ff3a2e9 --- /dev/null +++ b/Task/Leonardo-numbers/Free-Pascal-Lazarus/leonardo-numbers.pas @@ -0,0 +1,28 @@ +program LeonardoNumbers; + + procedure WriteLeonardoNums(L0, L1: longint; Sum: integer; + Lmt: integer; What: string); + var + I: integer; + Tmp: longint; + begin + WriteLn(What, ' (', L0, ', ', L1, ', ', Sum, '):'); + if Lmt >= 1 then + Write(L0, ' '); + if Lmt >= 2 then + Write(L1, ' '); + for I := 3 to Lmt do + begin + Write(L0 + L1 + Sum, ' '); + Tmp := L0; + L0 := L1; + L1 := Tmp + L1 + Sum; + end; + WriteLn; + end; + +begin + WriteLeonardoNums(1, 1, 1, 25, 'Leonardo numbers'); + WriteLeonardoNums(0, 1, 0, 25, 'Fibonacci numbers'); + ReadLn; +end. diff --git a/Task/Leonardo-numbers/GW-BASIC/leonardo-numbers.basic b/Task/Leonardo-numbers/GW-BASIC/leonardo-numbers.basic new file mode 100644 index 0000000000..8ba8a56228 --- /dev/null +++ b/Task/Leonardo-numbers/GW-BASIC/leonardo-numbers.basic @@ -0,0 +1,17 @@ +10 REM Leonardo numbers +20 LIMIT = 25 +30 L0 = 1: L1 = 1: SUMA = 1 +40 PRINT "Numeros de Leonardo (";L0;",";L1;",";SUMA;"):" +50 GOSUB 100 +60 L0 = 0: L1 = 1: SUMA = 0 +70 PRINT "Numeros de Fibonacci (";L0;",";L1;",";SUMA;"):" +80 GOSUB 100 +90 END +100 IF LIMIT >= 1 THEN PRINT L0; +110 IF LIMIT >= 2 THEN PRINT L1; +120 FOR I = 3 TO LIMIT +130 PRINT L0 + L1 + SUMA; +140 TMP = L0: L0 = L1: L1 = TMP + L1 + SUMA +150 NEXT I +160 PRINT +170 RETURN diff --git a/Task/Leonardo-numbers/Julia/leonardo-numbers.jl b/Task/Leonardo-numbers/Julia/leonardo-numbers.jl index 6e51c6ec38..0960ca32bc 100644 --- a/Task/Leonardo-numbers/Julia/leonardo-numbers.jl +++ b/Task/Leonardo-numbers/Julia/leonardo-numbers.jl @@ -1,18 +1,12 @@ -function L(n, add::Int=1, firsts::Vector=[1, 1]) - l = max(maximum(n) .+ 1, length(firsts)) - r = Vector{Int}(l) - r[1:length(firsts)] = firsts - for i in 3:l - r[i] = r[i - 1] + r[i - 2] + add +function leonardo(first::Int, second::Int, add::Int, amount::Int) + nums = [first, second] + for i in 3:amount + append!(nums, nums[i-1] + nums[i-2] + add) end - return r[n .+ 1] + return nums end -# Task 1 -println("First 25 Leonardo numbers: ", join(L(0:24), ", ")) - -# Task 2 -@show L(0) L(1) - -# Task 4 -println("First 25 Leonardo numbers starting with [0, 1]: ", join(L(0:24, 0, [0, 1]), ", ")) +println("First 25 Leonardo numbers with L1 = 1 L2 = 1 and add number = 1 :") +println(leonardo(1,1,1,25)) +println("First 25 Leonardo numbers with L1 = 0 L2 = 1 and add number = 0 :") +println(leonardo(1,1,0,25)) diff --git a/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-1.m2000 b/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-1.m2000 new file mode 100644 index 0000000000..15c7e89c68 --- /dev/null +++ b/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-1.m2000 @@ -0,0 +1,28 @@ +Module Leonardo_Task { + base1=lambda (l0 as decimal,l1 as decimal,add as decimal)->{ + a=list:=0:=l0,1:=l1 + =lambda a, add (i as decimal) ->{ + i=int(i)-1 + if i<0 then =a(0) exit + if not exist(a, i) then + do + j=len(a) + Append a, j:=a(j-1)+a(j-2)+add + j++ + until j>i + end if + =a(i) + } + } + leonardo=base1(1,1,1) + for i=1 to 25 + ? leonardo(i)+" "; + next + print + fibonacci=base1(0,1,0) + for i=1 to 25 + ? fibonacci(i)+" "; + next + print +} +Leonardo_Task diff --git a/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-2.m2000 b/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-2.m2000 new file mode 100644 index 0000000000..4cab1f216d --- /dev/null +++ b/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-2.m2000 @@ -0,0 +1,20 @@ +base1=lambda (l0 as decimal=1, l1 as decimal=1, add as decimal=1)-> { + ret=stack:=l0, l1 + = lambda l0, l1, add, ret (x as long)->{ + z=x + x-=len(ret) + stack ret { + while x>0 + push l1: l1+=l0+add:read l0 + data l1 ' at the end + x-- + end while + } + ' stack up ret, z Return z members from ret + =array(stack up ret, z) + } +} +Leonardo=base1() +Print Leonardo(25)#str$(" ") +fibonacci=base1(0,1,0) +Print fibonacci(25)#str$(" ") diff --git a/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-3.m2000 b/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-3.m2000 new file mode 100644 index 0000000000..210650ff91 --- /dev/null +++ b/Task/Leonardo-numbers/M2000-Interpreter/leonardo-numbers-3.m2000 @@ -0,0 +1,74 @@ +class Leonardo { + events "export", "exportdone" + decimal l0=1, l1=1, add=1 + ret=stack + module take (x as long){ + while x>0 + if len(.ret)=0 then + push .l1: .l1+=.l0+.add:read .l0 + callevent(&.l1) + else + stack .ret { + read a + callevent(&a) + } + end if + x-- + end while + sub callevent(&v) + if x>1 then + call event "export", v + else + call event "exportdone", v + end if + end sub + } +class: + module Leonardo (.l0, .l1, .add) { + stack .ret {data .l0, .l1} + } +} +Module Solution1 { + group withevents Leonardo=Leonardo() + group withevents Fibonacci=Leonardo(0,1,0) + function leonardo_export { + Print number+" "; + } + function leonardo_exportdone { + Print number + } + function fibonacci_export { + Print number+" "; + } + function fibonacci_exportdone { + Print number + } + Leonardo.take 25 + Fibonacci.take 25 +} +Solution1 +Module Solution2 { + group withevents Leonardo=Leonardo() + group withevents Fibonacci=Leonardo(0,1,0) + ret=stack + function leonardo_export { + read new Value + stack ret {data value} + } + function leonardo_exportdone { + call local leonardo_export() + Print array(ret)#str$(" ") + } + function fibonacci_export { + call local leonardo_export() + } + function fibonacci_exportdone { + call local leonardo_exportdone() + } + module dosomething(&ThatObject as Leonardo){ + ThatObject.take 25 + } + dosomething &Leonardo + dosomething &Fibonacci +} +Solution2 diff --git a/Task/Leonardo-numbers/MSX-Basic/leonardo-numbers.basic b/Task/Leonardo-numbers/MSX-Basic/leonardo-numbers.basic index f5644d9dc6..b259dec2bf 100644 --- a/Task/Leonardo-numbers/MSX-Basic/leonardo-numbers.basic +++ b/Task/Leonardo-numbers/MSX-Basic/leonardo-numbers.basic @@ -1,17 +1,18 @@ -100 LIMIT = 25 -110 L0 = 1 -120 L1 = 1 -130 SUMA = 1 -140 PRINT "Numeros de Leonardo (";L0;",";L1;",";SUMA;"):" -150 GOSUB 220 -160 LET L0 = 0 -170 LET L1 = 1 -180 LET SUMA = 0 -190 PRINT "Numeros de Fibonacci (";L0;",";L1;",";SUMA;"):" -200 GOSUB 220 -210 END -220 FOR I = 1 TO LIMIT -230 IF I = 1 THEN PRINT L0; : ELSE IF I = 2 THEN PRINT L1; : ELSE PRINT L0+L1+SUMA; : TMP = L0 : L0 = L1 : L1 = TMP+L1+SUMA -240 NEXT I -250 PRINT CHR$(10) -260 RETURN +10 REM Leonardo numbers +20 LIMIT = 25 +30 L0 = 1: L1 = 1: SUMA = 1 +40 PRINT "Numeros de Leonardo (";L0;",";L1;",";SUMA;"):" +50 GOSUB 100 +60 L0 = 0: L1 = 1: SUMA = 0 +70 PRINT "Numeros de Fibonacci (";L0;",";L1;",";SUMA;"):" +80 GOSUB 100 +90 END +100 IF LIMIT >= 1 THEN PRINT L0; +110 IF LIMIT >= 2 THEN PRINT L1; +120 IF LIMIT < 3 THEN 170: REM In MSX, FOR works like REPEAT +130 FOR I = 3 TO LIMIT +140 PRINT L0 + L1 + SUMA; +150 TMP = L0: L0 = L1: L1 = TMP + L1 + SUMA +160 NEXT I +170 PRINT +180 RETURN diff --git a/Task/Leonardo-numbers/Miranda/leonardo-numbers.miranda b/Task/Leonardo-numbers/Miranda/leonardo-numbers.miranda new file mode 100644 index 0000000000..bb34711b03 --- /dev/null +++ b/Task/Leonardo-numbers/Miranda/leonardo-numbers.miranda @@ -0,0 +1,18 @@ +main :: [sys_message] +main = [Stdout "First 25 Leonardo numbers:\n", + Stdout (tab 5 10 (take 25 (leo 1 1 1))), + Stdout "\nFirst 25 Fibonacci numbers:\n", + Stdout (tab 5 10 (take 25 (leo 0 1 0)))] + +tab :: num->num->[num]->[char] +tab w cw = lay . map (concat . map (rjustify cw . shownum)) . group w + +group :: num->[*]->[[*]] +group n [] = [] +group n ls = take n ls:group n (drop n ls) + +leo :: num->num->num->[num] +leo s0 s1 add + = ks + where ks = s0 : s1 : map step (zip2 ks (tl ks)) + step (a,b) = a + b + add diff --git a/Task/Leonardo-numbers/PHP/leonardo-numbers.php b/Task/Leonardo-numbers/PHP/leonardo-numbers.php new file mode 100644 index 0000000000..8355af37a0 --- /dev/null +++ b/Task/Leonardo-numbers/PHP/leonardo-numbers.php @@ -0,0 +1,21 @@ += 1) + echo($l0.' '); + if ($lmt >= 2) + echo($l1.' '); + for ($i = 3; $i <= $lmt; $i++) { + echo(($l0 + $l1 + $sum).' '); + $tmp = $l0; + $l0 = $l1; + $l1 = $tmp + $l1 + $sum; + } + echo(PHP_EOL); +} + +echo_Leonardo_nums(1, 1, 1, 25, 'Leonardo numbers'); +echo_Leonardo_nums(0, 1, 0, 25, 'Fibonacci numbers'); +?> diff --git a/Task/Leonardo-numbers/PascalABC.NET/leonardo-numbers.pas b/Task/Leonardo-numbers/PascalABC.NET/leonardo-numbers.pas new file mode 100644 index 0000000000..f7a472e7bf --- /dev/null +++ b/Task/Leonardo-numbers/PascalABC.NET/leonardo-numbers.pas @@ -0,0 +1,12 @@ +## +function Leonardo(L0: integer; L1: integer; add: integer): sequence of integer; +begin + while (true) do + begin + yield L0; + (L0, L1) := (L1, L0 + L1 + add); + end; +end; + +Leonardo(1, 1, 1).Take(25).println; +Leonardo(0, 1, 0).Take(25).println; diff --git a/Task/Leonardo-numbers/QBasic/leonardo-numbers.basic b/Task/Leonardo-numbers/QBasic/leonardo-numbers.basic index 7fa50be328..b6daa7ccfc 100644 --- a/Task/Leonardo-numbers/QBasic/leonardo-numbers.basic +++ b/Task/Leonardo-numbers/QBasic/leonardo-numbers.basic @@ -1,25 +1,20 @@ +REM Leonardo numbers DECLARE SUB leonardo (L0!, L1!, suma!, texto$) CONST limit = 25 -CALL leonardo(1, 1, 1, "Leonardo") -CALL leonardo(0, 1, 0, "Fibonacci") +CALL leonardo(1, 1, 1, "Numeros de Leonardo") +CALL leonardo(0, 1, 0, "Numeros de Fibonacci") END SUB leonardo (L0, L1, suma, texto$) - PRINT "Numeros de "; texto$; " ("; L0; ","; L1; ","; suma; "):" - FOR i = 1 TO limit - IF i = 1 THEN - PRINT L0; - ELSE - IF i = 2 THEN - PRINT L1; - ELSE - PRINT L0 + L1 + suma; - LET tmp = L0 - LET L0 = L1 - LET L1 = tmp + L1 + suma - END IF - END IF + PRINT texto$; " ("; L0; ","; L1; ","; suma; "):" + IF limit >= 1 THEN PRINT L0; + IF limit >= 2 THEN PRINT L1; + FOR i = 3 TO limit + PRINT L0 + L1 + suma; + LET tmp = L0 + LET L0 = L1 + LET L1 = tmp + L1 + suma NEXT i - PRINT CHR$(10) + PRINT END SUB diff --git a/Task/Leonardo-numbers/Tiny-BASIC/leonardo-numbers.basic b/Task/Leonardo-numbers/Tiny-BASIC/leonardo-numbers.basic new file mode 100644 index 0000000000..5b7e034c1b --- /dev/null +++ b/Task/Leonardo-numbers/Tiny-BASIC/leonardo-numbers.basic @@ -0,0 +1,27 @@ +10 REM Leonardo numbers +20 N=21 +30 K=1 +40 L=1 +50 S=1 +60 PRINT "Leonardo numbers (";K;", ";L;", ";S;"):" +70 GOSUB 140 +80 K=0 +90 L=1 +100 S=0 +110 PRINT "Fibonacci numbers (";K;", ";L;", ";S;"):" +120 GOSUB 140 +130 END +140 IF N<1 GOTO 260 +150 PRINT K;" "; +160 IF N<2 GOTO 260 +170 PRINT L;" "; +180 I=3 +190 IF I>N GOTO 260 +200 PRINT K+L+S;" "; +210 T=K +220 K=L +230 L=T+L+S +240 I=I+1 +250 GOTO 190 +260 PRINT +270 RETURN diff --git a/Task/Leonardo-numbers/True-BASIC/leonardo-numbers.basic b/Task/Leonardo-numbers/True-BASIC/leonardo-numbers.basic index f5c382a85a..b3de9ef13d 100644 --- a/Task/Leonardo-numbers/True-BASIC/leonardo-numbers.basic +++ b/Task/Leonardo-numbers/True-BASIC/leonardo-numbers.basic @@ -1,23 +1,17 @@ SUB leonardo (L0, L1, suma, texto$) - PRINT "Numeros de "; texto$; " ("; L0; ","; L1; ","; suma; "):" - FOR i = 1 TO limit - IF i = 1 THEN - PRINT L0; - ELSE - IF i = 2 THEN - PRINT L1; - ELSE - PRINT L0 + L1 + suma; - LET tmp = L0 - LET L0 = L1 - LET L1 = tmp + L1 + suma - END IF - END IF + PRINT texto$; " ("; L0; ","; L1; ","; suma; "):" + IF limit >= 1 THEN PRINT L0; + IF limit >= 2 THEN PRINT L1; + FOR i = 3 TO LIMIT + PRINT L0 + L1 + suma; + LET tmp = L0 + LET L0 = L1 + LET L1 = tmp + L1 + suma NEXT i - PRINT CHR$(10) + PRINT END SUB LET limit = 25 -CALL leonardo(1, 1, 1, "Leonardo") -CALL leonardo(0, 1, 0, "Fibonacci") +CALL leonardo(1, 1, 1, "Numeros de Leonardo") +CALL leonardo(0, 1, 0, "Numeros de Fibonacci") END diff --git a/Task/Leonardo-numbers/TypeScript/leonardo-numbers.ts b/Task/Leonardo-numbers/TypeScript/leonardo-numbers.ts new file mode 100644 index 0000000000..f427eabcad --- /dev/null +++ b/Task/Leonardo-numbers/TypeScript/leonardo-numbers.ts @@ -0,0 +1,15 @@ +function leoNums( + n: number, + L0: number = 1, + L1: number = 1, + add: number = 1 +): number[] { + const lNums: number[] = [L0, L1]; + while (lNums.length < n) { + lNums.push(lNums[lNums.length - 1] + lNums[lNums.length - 2] + add); + } + return lNums +} + +console.log(leoNums(25)) +console.log(leoNums(25, 0, 1, 0)) diff --git a/Task/Letter-frequency/Crystal/letter-frequency.cr b/Task/Letter-frequency/Crystal/letter-frequency.cr new file mode 100644 index 0000000000..85fa5f979d --- /dev/null +++ b/Task/Letter-frequency/Crystal/letter-frequency.cr @@ -0,0 +1,3 @@ +File.open("les_miserables.txt") do |f| + pp f.each_char.select(&.letter?).tally.to_a.sort_by {|k,v| -v} +end diff --git a/Task/Letter-frequency/Langur/letter-frequency.langur b/Task/Letter-frequency/Langur/letter-frequency.langur index c21156b15c..c33f892e23 100644 --- a/Task/Letter-frequency/Langur/letter-frequency.langur +++ b/Task/Letter-frequency/Langur/letter-frequency.langur @@ -1,8 +1,8 @@ val countLetters = fn(s) { - for[={:}] s2 in split(replace(s, RE/\P{L}/)) { + for[={:}] s2 in split(replace(s, by=RE/\P{L}/)) { _for[s2; 0] += 1 } } val counts = countLetters(readfile("./fuzz.txt")) -writeln join("\n", map(fn(k) { "{{k}}: {{counts[k]}}" }, keys(counts))) +writeln join(map(keys(counts), by=fn(k) { "{{k}}: {{counts[k]}}" }), by="\n") diff --git a/Task/Levenshtein-distance/PascalABC.NET/levenshtein-distance.pas b/Task/Levenshtein-distance/PascalABC.NET/levenshtein-distance.pas new file mode 100644 index 0000000000..7a638fe782 --- /dev/null +++ b/Task/Levenshtein-distance/PascalABC.NET/levenshtein-distance.pas @@ -0,0 +1,23 @@ +## +function levenshteinDistance(s1, s2: string): integer; +begin + if s1.Length > s2.Length then swap(s1, s2); + + var distances := Range(0, s1.Length).ToList; + + foreach var c2 in s2 index i2 do + begin + var newDistances := Lst(i2 + 1); + foreach var c1 in s1 index i1 do + if c1 = c2 then + newDistances.Add(distances[i1]) + else + newDistances.Add(1 + Min(distances[i1], distances[i1 + 1], newDistances[^1])); + + distances := newDistances; + end; + result := distances[^1]; +end; + +levenshteinDistance('kitten', 'sitting').println; +levenshteinDistance('rosettacode', 'raisethysword').println; diff --git a/Task/Linear-congruential-generator/EDSAC-order-code/linear-congruential-generator.edsac b/Task/Linear-congruential-generator/EDSAC-order-code/linear-congruential-generator.edsac index f905a3c8bf..7677c8f4b3 100644 --- a/Task/Linear-congruential-generator/EDSAC-order-code/linear-congruential-generator.edsac +++ b/Task/Linear-congruential-generator/EDSAC-order-code/linear-congruential-generator.edsac @@ -12,12 +12,13 @@ 55 locations, load at even address. Set up to be called with 'G N', so that caller needn't know its address. See Wilkes, Wheeler & Gill, 1951 edition, page 18.] + [2024-12-22 Fixed bug in print subroutine. Did not affect Rosetta Code output.] T 46 K [location corresponding to N parameter] P 72 F [load subroutine at 72] E 25 K TN - GKA3FT42@A47@T31@ADE10@T31@A48@T31@SDTDH44#@NDYFLDT4DS43@TF - H17@S17@A43@G23@UFS43@T1FV4DAFG50@SFLDUFXFOFFFSFL4FT4DA49@T31@ - A1FA43@G20@XFP1024FP610D@524D!FO46@O26@XFO46@SFL8FT4DE39@ + GKA3FT42@A47@T31@ADE10@T31@A48@T31@SDTDH44#@NDYFLDT4DS43@TFH17@ + S17@A43@G23@UFS43@T1FV4DAFG50@SFLDUFXFOFFFSFL4FT4DA49@T31@A1FA43@ + G20@XFT44#ZPFT43ZP1024FP610D@524D!FO46@O26@XFO46@SFL8FT4DE39@ [BSD linear congruential generator. Call with 'G B' to initialize, passing seed in 0D. diff --git a/Task/Linear-congruential-generator/PascalABC.NET/linear-congruential-generator-2.pas b/Task/Linear-congruential-generator/PascalABC.NET/linear-congruential-generator-2.pas index ca4342fc87..050110505e 100644 --- a/Task/Linear-congruential-generator/PascalABC.NET/linear-congruential-generator-2.pas +++ b/Task/Linear-congruential-generator/PascalABC.NET/linear-congruential-generator-2.pas @@ -18,22 +18,12 @@ end; begin 'BSD with seed = 1'.println; - var count := 0; var iter1 := bsdRand(1); - foreach var val in iter1 do - begin + foreach var val in iter1.Take(10) do println(val); - count += 1; - if count = 10 then break; - end; println; 'Microsoft with seed = 0'.Println; - count := 0; var iter2 := msvcrtRand(0); - foreach var val in iter2 do - begin + foreach var val in iter2.Take(10) do println(val); - count += 1; - if count = 10 then break; - end; end. diff --git a/Task/Literals-Floating-point/68000-Assembly/literals-floating-point.68000 b/Task/Literals-Floating-point/68000-Assembly/literals-floating-point.68000 index 646ae7abc4..05c33c6daf 100644 --- a/Task/Literals-Floating-point/68000-Assembly/literals-floating-point.68000 +++ b/Task/Literals-Floating-point/68000-Assembly/literals-floating-point.68000 @@ -1,2 +1,11 @@ -Pi: -DC.L $40490FDB + fmovecr.x #0,fp0 ; now fp0 contains pi + fmovecr.x #$0c,fp1 ; now fp1 contains e + + ; you can also define constants in several formats +extended: dc.x 2.0 ; extended precision, 80-bits in the FPU but stored as 96-bits in memory +doublep: dc.d 2.0 ; 64-bit double precision +singlep: dc.s 2.0 ; 32-bit single precision +packedbcd: dc.p 2.0 ; a 96-bit packed BCD format + + ; they can be loaded with the corresponding instructions, e.g. + fmove.p packedbcd,fp2 diff --git a/Task/Literals-Floating-point/Uiua/literals-floating-point.uiua b/Task/Literals-Floating-point/Uiua/literals-floating-point.uiua new file mode 100644 index 0000000000..236d7824cb --- /dev/null +++ b/Task/Literals-Floating-point/Uiua/literals-floating-point.uiua @@ -0,0 +1,5 @@ +2.3 # Standard floating-point literal +0.3e34 # Short floating-point +1/3 # Uiua can work with repeating decimals +1/24 # Another example of the above +2 # Uiua only has 4 types - all non-complex numbers are floats diff --git a/Task/Literals-Integer/PascalABC.NET/literals-integer.pas b/Task/Literals-Integer/PascalABC.NET/literals-integer.pas new file mode 100644 index 0000000000..6bc28e8439 --- /dev/null +++ b/Task/Literals-Integer/PascalABC.NET/literals-integer.pas @@ -0,0 +1,5 @@ +const + dec = 16; + hex = $ff; + sep = 1_000_000; + big = 123456789bi; // big integer, unrestricted diff --git a/Task/Logical-operations/Langur/logical-operations.langur b/Task/Logical-operations/Langur/logical-operations.langur index ef567db8c9..3d876cab21 100644 --- a/Task/Logical-operations/Langur/logical-operations.langur +++ b/Task/Logical-operations/Langur/logical-operations.langur @@ -1,5 +1,5 @@ val test = fn(a, b) { - join("\n", [ + join([ "not {{a}}: {{not a}}", "{{a}} and {{b}}: {{a and b}}", "{{a}} nand {{b}}: {{a nand b}}", @@ -17,7 +17,8 @@ val test = fn(a, b) { "{{a}} xor? {{b}}: {{a xor? b}}", "{{a}} nxor? {{b}}: {{a nxor? b}}", "\n", - ]) + ], + by="\n") } val tests = [ diff --git a/Task/Logistic-curve-fitting-in-epidemiology/PascalABC.NET/logistic-curve-fitting-in-epidemiology.pas b/Task/Logistic-curve-fitting-in-epidemiology/PascalABC.NET/logistic-curve-fitting-in-epidemiology.pas new file mode 100644 index 0000000000..45552e0964 --- /dev/null +++ b/Task/Logistic-curve-fitting-in-epidemiology/PascalABC.NET/logistic-curve-fitting-in-epidemiology.pas @@ -0,0 +1,63 @@ +const + K = 7.8e9; + N0 = 27; + Actual = + |27.0, 27.0, 27.0, 44.0, 44.0, 59.0, 59.0, + 59.0, 59.0, 59.0, 59.0, 59.0, 59.0, 60.0, + 60.0, 61.0, 61.0, 66.0, 83.0, 219.0, 239.0, + 392.0, 534.0, 631.0, 897.0, 1350.0, 2023.0, 2820.0, + 4587.0, 6067.0, 7823.0, 9826.0, 11946.0, 14554.0, 17372.0, + 20615.0, 24522.0, 28273.0, 31491.0, 34933.0, 37552.0, 40540.0, + 43105.0, 45177.0, 60328.0, 64543.0, 67103.0, 69265.0, 71332.0, + 73327.0, 75191.0, 75723.0, 76719.0, 77804.0, 78812.0, 79339.0, + 80132.0, 80995.0, 82101.0, 83365.0, 85203.0, 87024.0, 89068.0, + 90664.0, 93077.0, 95316.0, 98172.0, 102133.0, 105824.0, 109695.0, + 114232.0, 118610.0, 125497.0, 133852.0, 143227.0, 151367.0, 167418.0, + 180096.0, 194836.0, 213150.0, 242364.0, 271106.0, 305117.0, 338133.0, + 377918.0, 416845.0, 468049.0, 527767.0, 591704.0, 656866.0, 715353.0, + 777796.0, 851308.0, 928436.0, 1000249.0, 1082054.0, 1174652.0|; + +function f(r: real): real; +begin + foreach var i in (0..Actual.length - 1) do + begin + var eri := exp(r * i); + var guess := (N0 * eri) / (1 + N0 * (eri - 1) / K); + var diff := guess - Actual[i]; + result += diff * diff; + end; +end; + +function solve(fn: (real) -> real; guess: real := 0.5; epsilon: real := 0.0): real; +begin + result := guess; + var delta := if result <> 0 then result else 1.0; + var f0 := fn(result); + var factor := 2.0; + + while (delta > epsilon) and (result <> result - delta) do + begin + var nf := fn(result - delta); + if nf < f0 then + begin + f0 := nf; + result -= delta; + end + else + nf := fn(result + delta); + if nf < f0 then + begin + f0 := nf; + result += delta; + end + else + factor := 0.5; + delta *= factor; + end; +end; + +begin + var r := solve(f); + var r0 := exp(12 * r); + writeln('r = ', r, ', R0 = ', r0); +end. diff --git a/Task/Long-literals-with-continuations/PascalABC.NET/long-literals-with-continuations.pas b/Task/Long-literals-with-continuations/PascalABC.NET/long-literals-with-continuations.pas new file mode 100644 index 0000000000..399260f878 --- /dev/null +++ b/Task/Long-literals-with-continuations/PascalABC.NET/long-literals-with-continuations.pas @@ -0,0 +1,33 @@ +const + RevDate = '2024-12-28'; + + elementStr = ''' + 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 +'''; + + elements = elementstr.towords(|#10, #13, ' '|); + +begin + println('Last revision date: ', RevDate); + println('Number of elements: ', Elements.count); + println('Last element in list: ', Elements[^1]); +end. diff --git a/Task/Long-multiplication/M2000-Interpreter/long-multiplication.m2000 b/Task/Long-multiplication/M2000-Interpreter/long-multiplication.m2000 new file mode 100644 index 0000000000..d2a0f992bd --- /dev/null +++ b/Task/Long-multiplication/M2000-Interpreter/long-multiplication.m2000 @@ -0,0 +1,18 @@ +function placecoma(a as string) { + if len(a)<4 then =a :exit + k=StrRev$(a) + a="" + for i=4 to len(k) step 3 + a+=mid$(k,i-3, 3)+"," + next + a+=mid$(k, i-3) + a=strrev$(a) + if left$(a,1)="," then =mid$(a,2) else =a +} + +a=bigInteger("2") +'method a, "intpower", biginteger("128") as a +method a, "intpower", biginteger("64") as a +method a, "multiply", a as a +with a,"tostring" as a.tostring +Print placecoma(a.tostring) diff --git a/Task/Long-multiplication/PascalABC.NET/long-multiplication.pas b/Task/Long-multiplication/PascalABC.NET/long-multiplication.pas new file mode 100644 index 0000000000..2356f7c57f --- /dev/null +++ b/Task/Long-multiplication/PascalABC.NET/long-multiplication.pas @@ -0,0 +1,56 @@ +function longmulti(a, b: string): string; +begin + var i := 0; + var j := 0; + var k := false; + + // either is zero, return "0" + if (a = '0') or (b = '0') then + begin + result := '0'; + exit; + end; + + // see if either a or b is negative + if a[1] = '-' then + begin + i := 2; + k := not k; + end; + if b[1] = '-' then + begin + j := 2; + k := not k; + end; + + // if yes, prepend minus sign if needed and skip the sign + if (i > 1) or (j > 1) then + begin + result := if k then '-' else ''; + result += longmulti(a[i:a.Length + 1], b[j:b.Length + 1]); + exit; + end; + + result := '0' * (a.length + b.length); + + for var ii := a.length downto 1 do + begin + var carry := 0; + var kk := ii + b.length; + for var jj := b.length downto 1 do + begin + var n := a[ii].todigit * b[jj].todigit + result[kk].todigit + carry; + carry := n div 10; + result[kk] := chr(n mod 10 + ord('0')); + dec(kk); + end; + result[kk] := chr(ord(result[kk]) + carry); + end; + + if result[1] = '0' then + result[1:result.length] := result[2:result.length + 1]; +end; + +begin + longmulti('-18446744073709551616', '-18446744073709551616').println; +end. diff --git a/Task/Long-primes/PascalABC.NET/long-primes.pas b/Task/Long-primes/PascalABC.NET/long-primes.pas new file mode 100644 index 0000000000..53de556a3d --- /dev/null +++ b/Task/Long-primes/PascalABC.NET/long-primes.pas @@ -0,0 +1,34 @@ +function gen_primes_upto(n: integer): sequence of integer; +begin + if n < 3 then exit; + var table := |True| * n; + var sqrtn := n.sqrt.Floor; + for var i := 2 to sqrtn do + if table[i] then + for var j := i * i to n - 1 step i do + table[j] := False; + + yield 2; + for var i := 3 to n step 2 do + if table[i] then yield i +end; + +function period(n: integer): integer; +begin + var r := 1; + repeat + r := r * 10 mod n; + result += 1; + until r <= 1; +end; + +begin + writeln('The long primes up to 500 are:'); + var primes := Gen_primes_upto(64000).Skip(1); + primes.Where(x -> (x < 500) and (period(x) = x - 1)).Println; + writeln; + + writeln('The number of long primes up to:'); + foreach var n in |500, 1000, 2000, 4000, 8000, 16000, 32000, 64000| do + writeln(n:6, ' is ', primes.Where(x -> (x < n) and (period(x) = x - 1)).Count); +end. diff --git a/Task/Long-year/PascalABC.NET/long-year.pas b/Task/Long-year/PascalABC.NET/long-year.pas new file mode 100644 index 0000000000..58d177492f --- /dev/null +++ b/Task/Long-year/PascalABC.NET/long-year.pas @@ -0,0 +1,11 @@ +## +uses System; + +function islongyear(year: integer): boolean; +begin + var startdate := new DateTime(year, 1, 1); + var enddate := new DateTime(year, 12, 31); + result := (startdate.DayOfWeek = DayOfWeek.Thursday) or (enddate.DayOfWeek = DayOfWeek.Thursday) +end; + +(2000..2100).Where(y -> islongyear(y)).Println; diff --git a/Task/Longest-common-subsequence/Jq/longest-common-subsequence-4.jq b/Task/Longest-common-subsequence/Jq/longest-common-subsequence-4.jq new file mode 100644 index 0000000000..39f6e8f6d9 --- /dev/null +++ b/Task/Longest-common-subsequence/Jq/longest-common-subsequence-4.jq @@ -0,0 +1,42 @@ +# Create an m x n matrix +def matrix(m; n; init): + if m == 0 then [] + elif m == 1 + then [[range(0;n) | init]] + elif m > 0 + then [range(0;n) | init] as $row + | [range(0;m) | $row ] + else error("matrix\(m);_;_) invalid") + end; + +def lcs($a; $b): + {lengths: matrix(1+($a|length); 1+($b|length); 0)} + # row 0 and column 0 are initialized to 0 already + | reduce range(0; $a|length) as $i (.; + $a[$i:$i+1] as $x + | reduce range(0; $b|length) as $j (.; + $b[$j:$j+1] as $y + | if $x == $y + then .lengths[$i+1][$j+1] = .lengths[$i][$j] + 1 + else .lengths[$i+1][$j+1] = ([.lengths[$i+1][$j], .lengths[$i][$j+1]] | max) + end )) + # read out the substring from the matrix + |.result = "" + | .x = ($a|length) + | .y = ($b|length) + | until( .x <= 0 or .y <= 0; + if .lengths[.x][.y] == .lengths[.x-1][.y] + then .x -= 1 + elif .lengths[.x][.y] == .lengths[.x][.y-1] + then .y -= 1 + else + # debug(".x is \(.x) => \($a[.x-1:.x])") + .result = $a[.x-1:.x] + .result + | .x -= 1 + | .y -= 1 + end ) + | .result ; + +lcs("1234"; "1224533324"), +lcs("thisisatest"; "testing123testing"), +lcs("thisisatest" * 4; "testing123testing" * 4) diff --git a/Task/Longest-common-substring/Langur/longest-common-substring.langur b/Task/Longest-common-substring/Langur/longest-common-substring.langur index 951978e86f..368bb54b25 100644 --- a/Task/Longest-common-substring/Langur/longest-common-substring.langur +++ b/Task/Longest-common-substring/Langur/longest-common-substring.langur @@ -2,7 +2,7 @@ val lcs = fn(s1, s2) { var l, r, sublen = 1, 0, 0 for i of s1 { for j in i .. len(s1) { - if not matching(s2s(s1, i .. j), s2): break + if not matching(s2, by=s2s(s1, of=i .. j)): break if sublen <= j - i { l, r = i, j sublen = j - i @@ -10,7 +10,7 @@ val lcs = fn(s1, s2) { } } if r == 0: return "" - s2s s1, l .. r + s2s s1, of=l .. r } writeln lcs("thisisatest", "testing123testing") diff --git a/Task/Longest-common-substring/PascalABC.NET/longest-common-substring.pas b/Task/Longest-common-substring/PascalABC.NET/longest-common-substring.pas new file mode 100644 index 0000000000..44f677a397 --- /dev/null +++ b/Task/Longest-common-substring/PascalABC.NET/longest-common-substring.pas @@ -0,0 +1,21 @@ +## +function lcs(s1, s2: string): String; +begin + var l := 1; + var r := 0; + var sub_len := 0; + for var i := 1 to s1.length do + foreach var j in (i..s1.length) do + begin + if s2.contains(s1[i:j + 1]) then + if sub_len <= j - i then + begin + (l, r) := (i, j); + sub_len := j - i; + end + else break + end; + result := s1[l:r + 1]; +end; + +lcs('thisisatest', 'testing123testing').println; diff --git a/Task/Longest-increasing-subsequence/ALGOL-68/longest-increasing-subsequence.alg b/Task/Longest-increasing-subsequence/ALGOL-68/longest-increasing-subsequence.alg new file mode 100644 index 0000000000..625db03760 --- /dev/null +++ b/Task/Longest-increasing-subsequence/ALGOL-68/longest-increasing-subsequence.alg @@ -0,0 +1,47 @@ +BEGIN # find the longest increasing subsequence of a list # + # - translated from the Kotlin sample # + + PR read "rows.incl.a68" PR # include array utilities including SHOW # + + PROC longest increasing subsequence = ( []INT x in )[]INT: + IF []INT x = x in[ AT 0 ]; # normalise array bounds to 0 : n - 1 # + INT n = ( UPB x - LWB x ) + 1; + n = 0 + THEN []INT() # empty list # + ELIF n = 1 + THEN x # one element # + ELSE [ 0 : n - 1 ]INT p; + [ 0 : n ]INT m; FOR i FROM LWB m TO UPB m DO m[ i ] := 0 OD; + INT len := 0; + FOR i FROM 0 TO n - 1 DO + INT lo := 1; + INT hi := len; + WHILE lo <= hi DO + REAL midr = ( lo + hi ) / 2; + INT midi = ENTIER midr; + INT mid = IF midi = midr THEN midi ELSE midi + 1 FI; + IF x[ m[ mid ] ] < x[ i ] THEN lo := mid + 1 ELSE hi := mid - 1 FI + OD; + INT new len = lo; + p[ i ] := m[ new len - 1 ]; + m[ new len ] := i; + IF new len > len THEN len := new len FI + OD; + [ 0 : len - 1 ]INT s; + INT k := m[ len ]; + FOR i FROM len - 1 BY -1 TO 0 DO + s[ i ] := x[ k ]; + k := p[ k ] + OD; + s + FI # longest increasing subsequence # ; + + PROC show longest increasing subsequence = ( []INT x )VOID: + BEGIN + print( ( "[" ) ); SHOW longest increasing subsequence( x ); print( ( " ]", newline ) ) + END # show longest increasing subsequence # ; + + show longest increasing subsequence( ( 3, 2, 6, 4, 5, 1 ) ); + show longest increasing subsequence( ( 0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15 ) ) + +END diff --git a/Task/Longest-increasing-subsequence/PascalABC.NET/longest-increasing-subsequence.pas b/Task/Longest-increasing-subsequence/PascalABC.NET/longest-increasing-subsequence.pas new file mode 100644 index 0000000000..8af2191ff2 --- /dev/null +++ b/Task/Longest-increasing-subsequence/PascalABC.NET/longest-increasing-subsequence.pas @@ -0,0 +1,30 @@ +function lis(list: array of integer): sequence of array of integer; +begin + for var len := list.Count downto 1 do + begin + var res := new integer[len]; + foreach var sub in (0..list.Count - 1).Combinations(len) do + begin + var temp := list[sub[0]]; + for var ind := 1 to len - 1 do + if list[sub[ind]] > temp then + begin + temp := list[sub[ind]]; + if ind = len - 1 then + begin + foreach var n in sub index i do + res[i] := (list[n]); + yield res; + end; + end + else break; + end; + end; +end; + +begin +var a := |3, 2, 6, 4, 5, 1|; +lis(a).First.Println; +a := |0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15|; +lis(a).First.Println; +end. diff --git a/Task/Look-and-say-sequence/PascalABC.NET/look-and-say-sequence.pas b/Task/Look-and-say-sequence/PascalABC.NET/look-and-say-sequence.pas new file mode 100644 index 0000000000..ddfac7124c --- /dev/null +++ b/Task/Look-and-say-sequence/PascalABC.NET/look-and-say-sequence.pas @@ -0,0 +1,26 @@ +## +function lookAndSay(): sequence of string; +begin + var current: string := '1'; + yield current; + + while true do + begin + var ch := current[1]; + var count := 1; + var next := ''; + foreach var i in 2..current.Length do + if current[i] = ch then + inc(count) + else begin + next += count.ToString + ch; + ch := current[i]; + count := 1; + end; + current := next + count.ToString + ch; + yield current; + end; +end; + +foreach var s in lookandsay.Take(12) do + s.Println; diff --git a/Task/Loops-Do-while/Nim/loops-do-while-2.nim b/Task/Loops-Do-while/Nim/loops-do-while-2.nim index 4cdcc90d5d..57db76fb79 100644 --- a/Task/Loops-Do-while/Nim/loops-do-while-2.nim +++ b/Task/Loops-Do-while/Nim/loops-do-while-2.nim @@ -1,9 +1,3 @@ -template doWhile(a, b: untyped): untyped = - b - while a: - b - var val = 0 -doWhile val mod 6 != 0: - inc val - echo val +while (inc val; echo val; val mod 6 != 0): + discard diff --git a/Task/Loops-Do-while/Nim/loops-do-while-3.nim b/Task/Loops-Do-while/Nim/loops-do-while-3.nim new file mode 100644 index 0000000000..4cdcc90d5d --- /dev/null +++ b/Task/Loops-Do-while/Nim/loops-do-while-3.nim @@ -0,0 +1,9 @@ +template doWhile(a, b: untyped): untyped = + b + while a: + b + +var val = 0 +doWhile val mod 6 != 0: + inc val + echo val diff --git a/Task/Loops-For/Dart/loops-for.dart b/Task/Loops-For/Dart/loops-for.dart index bf5831ccbd..4bdf131750 100644 --- a/Task/Loops-For/Dart/loops-for.dart +++ b/Task/Loops-For/Dart/loops-for.dart @@ -1,6 +1,8 @@ +import 'dart:io'; main() { - for (var i = 0; i < 5; i++) + for (var i = 0; i < 5; i++) { for (var j = 0; j < i + 1; j++) - print("*"); - print("\n"); + stdout.write("*"); + print(""); + } } diff --git a/Task/Loops-Foreach/PascalABC.NET/loops-foreach.pas b/Task/Loops-Foreach/PascalABC.NET/loops-foreach.pas index 754dbfc90b..58dc9f1308 100644 --- a/Task/Loops-Foreach/PascalABC.NET/loops-foreach.pas +++ b/Task/Loops-Foreach/PascalABC.NET/loops-foreach.pas @@ -1,3 +1,3 @@ ## -foreach var s in |'Pascal','ABC','.NET'| do +foreach var s in ['Pascal','ABC','.NET'] do Print(s); diff --git a/Task/Loops-While/Dart/loops-while-1.dart b/Task/Loops-While/Dart/loops-while-1.dart index 1f512078a9..ff9fb8dcc1 100644 --- a/Task/Loops-While/Dart/loops-while-1.dart +++ b/Task/Loops-While/Dart/loops-while-1.dart @@ -2,6 +2,6 @@ void main() { var val = 1024; while (val > 0) { print(val); - val >>= 2; + val >>= 1; } } diff --git a/Task/Loops-While/Dart/loops-while-2.dart b/Task/Loops-While/Dart/loops-while-2.dart index d345f90995..bd057fc674 100644 --- a/Task/Loops-While/Dart/loops-while-2.dart +++ b/Task/Loops-While/Dart/loops-while-2.dart @@ -1,7 +1,7 @@ void main() { - num val = 1024; + var val = 1024; while (val > 0) { print(val); - val /= 2; + val ~/= 2; } } diff --git a/Task/Loops-While/J/loops-while-2.j b/Task/Loops-While/J/loops-while-2.j index d9e2d1ee8f..bd00c5eedb 100644 --- a/Task/Loops-While/J/loops-while-2.j +++ b/Task/Loops-While/J/loops-while-2.j @@ -1,7 +1 @@ -monad define 1024 - while. 0 < y do. - smoutput y - y =. <. -: y - end. - i.0 0 -) +0 0$([ echo)@<.@-:^:*^:_. ]1024 diff --git a/Task/Loops-While/J/loops-while-3.j b/Task/Loops-While/J/loops-while-3.j new file mode 100644 index 0000000000..c4a37b6181 --- /dev/null +++ b/Task/Loops-While/J/loops-while-3.j @@ -0,0 +1,7 @@ +monad define 1024 + while. 0 < y do. + echo y + y =. <. -: y + end. + i.0 0 +) diff --git a/Task/Loops-While/M2000-Interpreter/loops-while-1.m2000 b/Task/Loops-While/M2000-Interpreter/loops-while-1.m2000 deleted file mode 100644 index d0a72a45e0..0000000000 --- a/Task/Loops-While/M2000-Interpreter/loops-while-1.m2000 +++ /dev/null @@ -1,8 +0,0 @@ -Module Checkit { - Def long A=1024 - While A>0 { - Print A - A/=2 - } -} -Checkit diff --git a/Task/Loops-While/M2000-Interpreter/loops-while-2.m2000 b/Task/Loops-While/M2000-Interpreter/loops-while-2.m2000 deleted file mode 100644 index 0ebb2d8d4d..0000000000 --- a/Task/Loops-While/M2000-Interpreter/loops-while-2.m2000 +++ /dev/null @@ -1 +0,0 @@ -Module Online { A=1024&: While A>0 {Print A: A/=2}} : OnLine diff --git a/Task/Loops-While/M2000-Interpreter/loops-while.m2000 b/Task/Loops-While/M2000-Interpreter/loops-while.m2000 new file mode 100644 index 0000000000..bdb4621b6d --- /dev/null +++ b/Task/Loops-While/M2000-Interpreter/loops-while.m2000 @@ -0,0 +1,31 @@ +Module Checkit { + Long A=1024 + While A>0 { + Print A + A/=2 + if a<500 then goto alfa + } + Print "not that" +alfa: + Print "ok" +} +Checkit +Module Checkit2 { + Long A=1024 + While A>0 + Print A + A/=2 + if a<500 then 10 + End While + Print "not that" +10 Print "ok" +} +Checkit2 +Module Checkit3 { + A=(1,2,3,4,5) + B=Each(A, -1, 1) + While B + Print Array(B), B^ + End While +} +Checkit3 diff --git a/Task/Loops-Wrong-ranges/Langur/loops-wrong-ranges.langur b/Task/Loops-Wrong-ranges/Langur/loops-wrong-ranges.langur index 211984fe9b..a5e20e4e49 100644 --- a/Task/Loops-Wrong-ranges/Langur/loops-wrong-ranges.langur +++ b/Task/Loops-Wrong-ranges/Langur/loops-wrong-ranges.langur @@ -13,16 +13,16 @@ END # Process data string into table. # We could have just started with a list of lists, of course. -var table = submatches(RE/([^ ]+) +([^ ]+) +([^ ]+) +(.+)\n?/, data) +var table = submatches(data, by=RE/([^ ]+) +([^ ]+) +([^ ]+) +(.+)\n?/) for i in 2..len(table) { - table[i] = map([number, number, number, _], table[i]) + table[i] = map(table[i], by=[number, number, number, _]) } -for test in rest(table) { +for test in less(table, of=1) { val start, stop, inc, comment = test { - val s = series(start .. stop, inc) + val s = series(start .. stop, inc=inc) catch { writeln "{{comment}}\nERROR: {{_err'msg:L200(...)}}\n" } else { diff --git a/Task/Lucas-Lehmer-test/Langur/lucas-lehmer-test.langur b/Task/Lucas-Lehmer-test/Langur/lucas-lehmer-test.langur index f7a86123a0..d23abfe4c5 100644 --- a/Task/Lucas-Lehmer-test/Langur/lucas-lehmer-test.langur +++ b/Task/Lucas-Lehmer-test/Langur/lucas-lehmer-test.langur @@ -1,6 +1,6 @@ val isPrime = fn(i) { i == 2 or i > 2 and - not any(fn x:i div x, pseries(2 .. i ^/ 2)) + not any(series(2 .. i ^/ 2, asconly=true), by=fn x:i div x) } val isMersennePrime = fn(p) { @@ -13,4 +13,4 @@ val isMersennePrime = fn(p) { } == 0 } -writeln join(" ", map(fn x:"M{{x}}", filter(isMersennePrime, series(2300)))) +writeln join(map(filter(series(2300), by=isMersennePrime), by=fn x:"M{{x}}"), by=" ") diff --git a/Task/Lucas-Lehmer-test/PascalABC.NET/lucas-lehmer-test.pas b/Task/Lucas-Lehmer-test/PascalABC.NET/lucas-lehmer-test.pas new file mode 100644 index 0000000000..61401fd11e --- /dev/null +++ b/Task/Lucas-Lehmer-test/PascalABC.NET/lucas-lehmer-test.pas @@ -0,0 +1,33 @@ +function isMersennePrime(p: integer): boolean; +begin + if (p mod 2 = 0) then result := p = 2 + else begin + for var i := 3 to p.Sqrt.Floor step 2 do + if (p mod i = 0) then + begin + result := false; //not prime + exit + end; + var m_p := Power(2bi, p) - 1bi; + var s := 4bi; + for var i := 3 to p do + s := (s * s - 2bi) mod m_p; + result := s = 0bi; + end; +end; + +function GetMersennePrimeNumbers(upTo: integer): sequence of integer; +begin + var response := new List; + {$omp parallel for} + for var i := 2 to upTo do + if isMersennePrime(i) then response.Add(i); + response.Sort; + result := response; +end; + +begin + foreach var mp in GetMersennePrimeNumbers(11213) do + Write('M', mp, ' '); + println(#10, milliseconds / 1000, 's'); +end. diff --git a/Task/Ludic-numbers/PascalABC.NET/ludic-numbers.pas b/Task/Ludic-numbers/PascalABC.NET/ludic-numbers.pas new file mode 100644 index 0000000000..d33d9fd017 --- /dev/null +++ b/Task/Ludic-numbers/PascalABC.NET/ludic-numbers.pas @@ -0,0 +1,38 @@ +function ludic(): sequence of integer; +begin + yield 1; + var ludics := new List; + while True do + begin + var k := 0; + foreach var j in ludics[::-1] do + k := (k * j) div (j - 1) + 1; + ludics.Add(k + 2); + yield k + 2 + end; +end; + +function triplets(): sequence of (integer, integer, integer); +begin + var (a, b, c, d) := (0, 0, 0, 0); + foreach var k in ludic do + begin + if (k - 4 in [b, c, d]) and (k - 6 in [a, b, c]) then + yield (k - 6, k - 4, k); + (a, b, c, d) := (b, c, d, k); + end; +end; + +begin + writeln('First 25 ludic numbers:'); + ludic.Take(25).Println; + + write(#10, 'Ludic numbers below 1000: '); + ludic.TakeWhile(x -> x <= 1000).Count.Println; + + writeln(#10, 'Ludic numbers 2000 to 2005: '); + ludic.Skip(2000 - 1).Take(6).Println; + + writeln(#10, 'all triplets of ludic numbers < 250: '); + triplets.TakeWhile(x -> x[2] < 250).Println; +end. diff --git a/Task/Luhn-test-of-credit-card-numbers/ANSI-BASIC/luhn-test-of-credit-card-numbers.basic b/Task/Luhn-test-of-credit-card-numbers/ANSI-BASIC/luhn-test-of-credit-card-numbers.basic new file mode 100644 index 0000000000..a361c757fe --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/ANSI-BASIC/luhn-test-of-credit-card-numbers.basic @@ -0,0 +1,22 @@ +100 REM Luhn test of credit card numbers +110 DATA "49927398716", "49927398717", "1234567812345678", "1234567812345670" +120 DECLARE EXTERNAL FUNCTION LuhnTest +130 FOR J = 1 TO 4 +140 READ C$ +150 PRINT C$; +160 IF LuhnTest(C$) = 1 THEN PRINT " is valid." ELSE PRINT " is invalid." +170 NEXT J +180 END +190 REM +200 EXTERNAL FUNCTION LuhnTest(C$) +210 LET S = 0 +220 FOR I = LEN(C$) TO 1 STEP -2 +230 LET S = S + VAL(C$(I:I)) +240 NEXT I +250 FOR I = LEN(C$) - 1 TO 1 STEP -2 +260 LET B = VAL(C$(I:I)) * 2 +270 IF B >= 10 THEN LET B = B - 9 +280 LET S = S + B +290 NEXT I +300 IF MOD(S, 10) = 0 THEN LET LuhnTest = 1 ELSE LET LuhnTest = 0 +310 END FUNCTION diff --git a/Task/Luhn-test-of-credit-card-numbers/ASIC/luhn-test-of-credit-card-numbers.asic b/Task/Luhn-test-of-credit-card-numbers/ASIC/luhn-test-of-credit-card-numbers.asic new file mode 100644 index 0000000000..5416e3933f --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/ASIC/luhn-test-of-credit-card-numbers.asic @@ -0,0 +1,42 @@ +REM Luhn test of credit card numbers +DATA "49927398716", "49927398717", "1234567812345678", "1234567812345670" +FOR J = 1 TO 4 + READ C$ + GOSUB DoLuhnTest: + PRINT C$; + IF RetVal = 1 THEN + PRINT " is valid." + ELSE + PRINT " is invalid." + ENDIF +NEXT J +END + +DoLuhnTest: +LenC = LEN(C$) +S = 0 +I = LenC +WHILE I >= 1 + CI$ = MID$(C$, I, 1) + Num = VAL(CI$) + S = S + Num + I = I - 2 +WEND +I = LenC - 1 +WHILE I >= 1 + CI$ = MID$(C$, I, 1) + Num = VAL(CI$) + B = Num * 2 + IF B >= 10 THEN + B = B - 9 + ENDIF + S = S + B + I = I - 2 +WEND +SMod10 = S MOD 10 +IF SMod10 = 0 THEN + RetVal = 1 +ELSE + RetVal = 0 +ENDIF +RETURN diff --git a/Task/Luhn-test-of-credit-card-numbers/FutureBasic/luhn-test-of-credit-card-numbers.basic b/Task/Luhn-test-of-credit-card-numbers/FutureBasic/luhn-test-of-credit-card-numbers.basic index 577e9f7824..8453461734 100644 --- a/Task/Luhn-test-of-credit-card-numbers/FutureBasic/luhn-test-of-credit-card-numbers.basic +++ b/Task/Luhn-test-of-credit-card-numbers/FutureBasic/luhn-test-of-credit-card-numbers.basic @@ -1,43 +1,18 @@ include "NSLog.incl" -local fn LuhnCheck( cardStr as CFStringRef ) as BOOL - NSInteger i, j, count, s1 = 0, s2 = 0 - BOOL result = NO +local fn luhn( n as long ) + int r = 0, nx2(9) = {0,2,4,6,8,1,3,5,7,9} + nslog(@"%20ld \b", n) + while n + r += n % 10 + nx2(n / 10 % 10) + n /= 100 + wend + if r % 10 then nslog( @"fail") else nslog( @"pass") +end fn - // Build array of individual numbers in credit card string - NSUInteger strLength = len(cardStr) - CFMUtableArrayRef mutArr = fn MutableArrayWithCapacity(strLength) - for i = 0 to strLength - 1 - CFStringRef tempStr = fn StringWithFormat( @"%C", fn StringCharacterAtIndex( cardStr, i ) ) - MutableArrayInsertObjectAtIndex( mutArr, tempStr, i ) - next +fn luhn(49927398716) +fn luhn(49927398717) +fn luhn(1234567812345678) +fn luhn(1234567812345670) - // Reverse the number array - CFArrayRef reversedArray = fn EnumeratorAllObjects( fn ArrayReverseObjectEnumerator( mutArr ) ) - - // Get number of array elements - count = len(reversedArray) - - // Handle odd numbers - for i = 0 to count - 1 step 2 - s1 = s1 + fn StringIntegerValue( reversedArray[i] ) - next - - // Hnadle even numbers - for i = 1 to count - 1 step 2 - j = fn StringIntegerValue( reversedArray[i] ) - j = j * 2 - if j > 9 then j = j mod 10 + 1 - s2 = s2 + j - next - - if (s1 + s2) mod 10 = 0 then result = YES else result = NO -end fn = result - -NSLogClear -if fn LuhnCheck( @"49927398716" ) then NSLog (@"%@ is valid.", @"49927398716" ) else NSLog (@"%@ is not valid.", @"49927398716" ) -if fn LuhnCheck( @"49927398717" ) then NSLog (@"%@ is valid.", @"49927398717" ) else NSLog (@"%@ is not valid.", @"49927398717" ) -if fn LuhnCheck( @"1234567812345678" ) then NSLog (@"%@ is valid.", @"1234567812345678" ) else NSLog (@"%@ is not valid.", @"1234567812345678" ) -if fn LuhnCheck( @"1234567812345670" ) then NSLog (@"%@ is valid.", @"1234567812345670" ) else NSLog (@"%@ is not valid.", @"1234567812345670" ) - -HandleEvents +handleevents diff --git a/Task/Luhn-test-of-credit-card-numbers/GW-BASIC/luhn-test-of-credit-card-numbers.basic b/Task/Luhn-test-of-credit-card-numbers/GW-BASIC/luhn-test-of-credit-card-numbers.basic new file mode 100644 index 0000000000..4e5104142d --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/GW-BASIC/luhn-test-of-credit-card-numbers.basic @@ -0,0 +1,20 @@ +10 REM Luhn test of credit card numbers +20 DATA "49927398716", "49927398717", "1234567812345678", "1234567812345670" +30 FOR J = 1 TO 4 +40 READ C$: GOSUB 1000 +50 PRINT C$; +60 IF RETVAL THEN PRINT " is valid." ELSE PRINT " is invalid." +70 NEXT J +80 END +1000 REM ** Luhn test +1010 S = 0 +1020 FOR I = LEN(C$) TO 1 STEP -2 +1030 S = S + VAL(MID$(C$, I, 1)) +1040 NEXT I +1050 FOR I = LEN(C$) - 1 TO 1 STEP -2 +1060 B = VAL(MID$(C$, I, 1)) * 2 +1070 IF B >= 10 THEN B = B - 9 +1080 S = S + B +1090 NEXT I +1100 RETVAL = (S MOD 10 = 0) +1110 RETURN diff --git a/Task/Luhn-test-of-credit-card-numbers/Modula-2/luhn-test-of-credit-card-numbers.mod2 b/Task/Luhn-test-of-credit-card-numbers/Modula-2/luhn-test-of-credit-card-numbers.mod2 new file mode 100644 index 0000000000..6ff97b5f25 --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/Modula-2/luhn-test-of-credit-card-numbers.mod2 @@ -0,0 +1,49 @@ +MODULE LuhnTestCreditCard; +(* Luhn test of credit card numbers *) + +FROM STextIO IMPORT + WriteString, WriteLn; + +CONST + MaxLen = 16; + +TYPE + TCardNum = ARRAY[0 .. MaxLen] OF CHAR; + TCards = ARRAY[0 .. 3] OF TCardNum; + +CONST + Cards = TCards{"49927398716", "49927398717", + "1234567812345678", "1234567812345670"}; +VAR + J: CARDINAL; + +PROCEDURE LuhnTest(C: ARRAY OF CHAR): BOOLEAN; +VAR + S, I, B, LastIndex: CARDINAL; +BEGIN + S := 0; + LastIndex := LENGTH(C) - 1; + FOR I := LastIndex TO 0 BY -2 DO + S := S + (ORD(C[I]) - ORD("0")) + END; + FOR I := LastIndex - 1 TO 0 BY -2 DO + B := (ORD(C[I]) - ORD("0")) * 2; + IF B >= 10 THEN + B := B - 9 + END; + S := S + B + END; + RETURN S MOD 10 = 0 +END LuhnTest; + +BEGIN + FOR J := 0 TO 3 DO + WriteString(Cards[J]); + IF LuhnTest(Cards[J]) THEN + WriteString(" is valid.") + ELSE + WriteString(" is invalid.") + END; + WriteLn; + END; +END LuhnTestCreditCard. diff --git a/Task/Luhn-test-of-credit-card-numbers/Nascom-BASIC/luhn-test-of-credit-card-numbers.basic b/Task/Luhn-test-of-credit-card-numbers/Nascom-BASIC/luhn-test-of-credit-card-numbers.basic new file mode 100644 index 0000000000..12f480a536 --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/Nascom-BASIC/luhn-test-of-credit-card-numbers.basic @@ -0,0 +1,22 @@ +10 REM Luhn test of credit card numbers +20 DATA "49927398716","49927398717" +30 DATA "1234567812345678","1234567812345670" +40 FOR J=1 TO 4 +50 READ C$:GOSUB 1000 +60 PRINT C$; +70 IF RV THEN PRINT " is valid.":GOTO 90 +80 PRINT " is invalid." +90 NEXT J +100 END +1000 REM ** Luhn test +1010 S=0 +1020 FOR I=LEN(C$) TO 1 STEP -2 +1030 S=S+VAL(MID$(C$,I,1)) +1040 NEXT I +1050 FOR I=LEN(C$)-1 TO 1 STEP -2 +1060 B=VAL(MID$(C$,I,1))*2 +1070 IF B>=10 THEN B=B-9 +1080 S=S+B +1090 NEXT I +1100 RV=(INT(S/10)*10=S) +1110 RETURN diff --git a/Task/Luhn-test-of-credit-card-numbers/PascalABC.NET/luhn-test-of-credit-card-numbers.pas b/Task/Luhn-test-of-credit-card-numbers/PascalABC.NET/luhn-test-of-credit-card-numbers.pas new file mode 100644 index 0000000000..2a8fbbf6ae --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/PascalABC.NET/luhn-test-of-credit-card-numbers.pas @@ -0,0 +1,18 @@ +function doubleDigit(n: integer) := (n * 2).ToString.Select(c -> c.ToDigit).Sum; + +function LuhnCheck(creditCardNumber: string): boolean; +begin + var checkSum := creditCardNumber + .Select(c -> c.ToDigit) + .Reverse + .Select((digit, index) -> (if odd(index + 1) then digit else doubleDigit(digit))) + .Sum; + + result := checkSum mod 10 = 0; +end; + +begin + var testNumbers := |49927398716, 49927398717, 1234567812345678, 1234567812345670|; + foreach var testNumber in testNumbers do + Writeln(testnumber, ' is ', if LuhnCheck(testNumber.ToString) then '' else 'not ', 'valid'); +end. diff --git a/Task/Luhn-test-of-credit-card-numbers/QBasic/luhn-test-of-credit-card-numbers.basic b/Task/Luhn-test-of-credit-card-numbers/QBasic/luhn-test-of-credit-card-numbers.basic index 25e7b7cf33..eb9d93f266 100644 --- a/Task/Luhn-test-of-credit-card-numbers/QBasic/luhn-test-of-credit-card-numbers.basic +++ b/Task/Luhn-test-of-credit-card-numbers/QBasic/luhn-test-of-credit-card-numbers.basic @@ -19,7 +19,7 @@ FOR test = 1 TO 4 IF num <= 9 THEN sum = sum + num ELSE - sum = sum + VAL(LEFT$(STR$(num), 1)) + VAL(RIGHT$(STR$(num), 1)) + sum = sum + num - 9 END IF odd = True END IF diff --git a/Task/Luhn-test-of-credit-card-numbers/V-(Vlang)/luhn-test-of-credit-card-numbers.v b/Task/Luhn-test-of-credit-card-numbers/V-(Vlang)/luhn-test-of-credit-card-numbers.v index b9a29520f7..c95eec833e 100644 --- a/Task/Luhn-test-of-credit-card-numbers/V-(Vlang)/luhn-test-of-credit-card-numbers.v +++ b/Task/Luhn-test-of-credit-card-numbers/V-(Vlang)/luhn-test-of-credit-card-numbers.v @@ -1,8 +1,9 @@ const ( - input = '49927398716 -49927398717 -1234567812345678 -1234567812345670' + input = " + 49927398716 + 49927398717 + 1234567812345678 + 1234567812345670" t = [0, 2, 4, 6, 8, 1, 3, 5, 7, 9] ) @@ -10,21 +11,16 @@ const ( fn luhn(s string) bool { odd := s.len & 1 mut sum := 0 - for i, c in s.split('') { - if c < '0' || c > '9' { - return false - } - if i&1 == odd { - sum += t[c.int()-'0'.int()] - } else { - sum += c.int() - '0'.int() - } + for i, c in s.split("") { + if c < '0' || c > '9' {return false} + if i&1 == odd {sum += t[c.int()-'0'.int()]} + else {sum += c.int() - '0'.int()} } - return sum%10 == 0 + return sum % 10 == 0 } fn main() { - for s in input.split("\n") { - println('$s ${luhn(s)}') + for s in input.trim_indent().split_into_lines() { + println("${s} ${luhn(s)}") } } diff --git a/Task/Lychrel-numbers/PascalABC.NET/lychrel-numbers.pas b/Task/Lychrel-numbers/PascalABC.NET/lychrel-numbers.pas new file mode 100644 index 0000000000..dfacb06e29 --- /dev/null +++ b/Task/Lychrel-numbers/PascalABC.NET/lychrel-numbers.pas @@ -0,0 +1,55 @@ +const + iterations = 1000; + limit = 10_000; + +var + cache := new Dictionary; + +function rev(n: biginteger) := n.ToString[::-1].ToBigInteger; + +function lychrel(n: biginteger): (boolean, biginteger); +begin + if n in cache then result := cache[n] + else begin + var r := rev(n); + var res := (True, n); + var seen := new List; + loop iterations do + begin + n += r; + r := rev(n); + if n = r then + begin + res := (False, 0bi); + break + end; + if n in cache then + begin + res := cache[n]; + break + end; + seen.Add(n) + end; + + foreach var x in seen do cache[x] := res; + result := res; + end; +end; + +begin + var seeds := new List; + var related := new List; + var palin := new List; + + foreach var i in (1..limit) do + begin + var (tf, s) := lychrel(i); + if not tf then continue; + if i = s then seeds.Add(i) else related.Add(i); + if i = rev(i) then palin.Add(i); + end; + + println('There are', seeds.count, 'Lychrel seeds, namely:', seeds); + println('Lychrel related numbers:', related.count); + println('There are', palin.count, 'Lychrel palindromes, namely:', palin); +end. diff --git a/Task/Lychrel-numbers/Wren/lychrel-numbers.wren b/Task/Lychrel-numbers/Wren/lychrel-numbers.wren index c3a10d72e0..1b6eb6b704 100644 --- a/Task/Lychrel-numbers/Wren/lychrel-numbers.wren +++ b/Task/Lychrel-numbers/Wren/lychrel-numbers.wren @@ -1,5 +1,5 @@ import "./big" for BigInt -import "./set" for Set +import "./hash" for HashSet var iterations = 500 var limit = 10000 @@ -8,7 +8,7 @@ var bigLimit = BigInt.new(limit) // In the sieve, 0 = not Lychrel, 1 = Seed Lychrel, 2 = Related Lychrel var lychrelSieve = List.filled(limit + 1, 0) var seedLychrels = [] -var relatedLychrels = Set.new() +var relatedLychrels = HashSet.new() var isPalindrome = Fn.new { |bi| var s = bi.toString @@ -32,12 +32,12 @@ var lychrelTest = Fn.new { |i, seq| } var sizeBefore = relatedLychrels.count // if all of these can be added 'i' must be a seed Lychrel - relatedLychrels.addAll(seq.map { |i| i.toString }) // can't add BigInts directly to a Set + relatedLychrels.addAll(seq) if (relatedLychrels.count - sizeBefore == seq.count) { seedLychrels.add(i) lychrelSieve[i] = 1 } else { - relatedLychrels.add(i.toString) + relatedLychrels.add(i) lychrelSieve[i] = 2 } } diff --git a/Task/M-bius-function/Forth/m-bius-function.fth b/Task/M-bius-function/Forth/m-bius-function.fth new file mode 100644 index 0000000000..16d5292cfb --- /dev/null +++ b/Task/M-bius-function/Forth/m-bius-function.fth @@ -0,0 +1,36 @@ +\ Moebius function +: mu ( u -- n ) + \ multiple of 4 so return 0 + dup 3 and 0= if drop 0 exit then + \ even numbers have 2 as a prime factor + dup 1 and 0= if 2/ 1 else 0 then >r + \ look for odd prime factors up to the square root + 3 begin + 2dup dup * >= + while + 2dup mod 0= if + tuck / swap + 2dup mod 0= if + \ repeated prime factor so return 0 + 2drop rdrop 0 exit + then + \ we have another prime factor + r> 1+ >r + then + 2 + + repeat + drop + \ prime factor > square root? + r> swap 1 > if 1+ then + 1 and 0= if 1 else -1 then ; + +: main ( -- ) + ." The first 199 Moebius numbers are:" cr + ." " + 200 1 do + i mu 3 .r + i 1+ 20 mod 0= if cr else then + loop ; + +main +bye diff --git a/Task/M-bius-function/PascalABC.NET/m-bius-function.pas b/Task/M-bius-function/PascalABC.NET/m-bius-function.pas new file mode 100644 index 0000000000..4760b377f0 --- /dev/null +++ b/Task/M-bius-function/PascalABC.NET/m-bius-function.pas @@ -0,0 +1,15 @@ +uses school; + +function mobius(n: integer): integer; +begin + var factors := n.Factorize; + if factors.Count = factors.ToSet.Count then + result := if factors.Count.IsEven then 1 else -1 + else result := 0 +end; + +begin + println('Mobius numbers from 1..99:'); + for var n := 1 to 99 do + write(mobius(n):3, if n mod 20 = 0 then #10 else ''); +end. diff --git a/Task/M-bius-function/Swift/m-bius-function.swift b/Task/M-bius-function/Swift/m-bius-function.swift new file mode 100644 index 0000000000..5cdbe1c56e --- /dev/null +++ b/Task/M-bius-function/Swift/m-bius-function.swift @@ -0,0 +1,36 @@ +import Foundation + +// Moebius function +func mu(number: Int) -> Int { + var n = number + if n % 4 == 0 { + return 0 + } + var primeFactors = 0 + if n % 2 == 0 { + primeFactors += 1 + n /= 2 + } + var p = 3 + while p * p <= n { + if n % p == 0 { + n /= p + if n % p == 0 { + return 0 + } + primeFactors += 1 + } + p += 2 + } + if (n > 1) { + primeFactors += 1 + } + return primeFactors % 2 == 0 ? 1 : -1 +} + +print("The first 199 Moebius numbers are:") +print(" ", terminator: "") +for i in 1..<200 { + print(String(format: "%3d", mu(number: i)), + terminator: (i + 1) % 20 == 0 ? "\n" : "") +} diff --git a/Task/MAC-vendor-lookup/FutureBasic/mac-vendor-lookup.basic b/Task/MAC-vendor-lookup/FutureBasic/mac-vendor-lookup.basic new file mode 100644 index 0000000000..b8cd701fb1 --- /dev/null +++ b/Task/MAC-vendor-lookup/FutureBasic/mac-vendor-lookup.basic @@ -0,0 +1,15 @@ +local fn MACVendorLookup( vendor as CFStringRef ) as CFStringRef +CFStringRef cmd = fn StringWithFormat( @"curl -s \"https://api.macvendors.com/%@\" && echo", vendor ) +return unix cmd +end fn = NULL + +CFStringRef MACaddr +CFArrayRef vendors +vendors = @[@"88:53:2E:67:07:BE", @"D4:F4:6F:C9:EF:8D", @"FC:FB:FB:01:FA:21", @"4c:72:b9:56:fe:bc", @"00-14-22-01-23-45"] + +for MACaddr in vendors +print fn StringByReplacingOccurrencesOfString( fn MACVendorLookup( MACaddr ), @"\n", @"" ) +delay 1000 // Delay a second between each request to prevent api.macvendors.com server from rejecting query +next + +HandleEvents diff --git a/Task/MAC-vendor-lookup/PascalABC.NET/mac-vendor-lookup.pas b/Task/MAC-vendor-lookup/PascalABC.NET/mac-vendor-lookup.pas new file mode 100644 index 0000000000..49fece1ba1 --- /dev/null +++ b/Task/MAC-vendor-lookup/PascalABC.NET/mac-vendor-lookup.pas @@ -0,0 +1,11 @@ +## +uses System.Net; + +ServicePointManager.SecurityProtocol := SecurityProtocolType(3072); +var wc := new WebClient; + +foreach var mac in |'FC-A1-3E', 'FC:FB:FB:01:FA:21', 'BC:5F:F4'| do +begin + println(mac, wc.DownloadString('https://api.macvendors.com/' + mac)); + Sleep(1500); +end; diff --git a/Task/MAC-vendor-lookup/Wren/mac-vendor-lookup-3.wren b/Task/MAC-vendor-lookup/Wren/mac-vendor-lookup-3.wren new file mode 100644 index 0000000000..238c3622b3 --- /dev/null +++ b/Task/MAC-vendor-lookup/Wren/mac-vendor-lookup-3.wren @@ -0,0 +1,10 @@ +import "os" for Process +import "timer" for Timer + +var macs = ["88:53:2E:67:07:BE", "FC:FB:FB:01:FA:21", "D4:F4:6F:C9:EF:8D", "23:45:67"] +for (mac in macs) { + var vendor = Process.read("curl -s " + "https://api.macvendors.com/" + mac) + if (vendor.contains("errors")) vendor = "Vendor not found" + System.print("%(mac) %(vendor)") + Timer.wait(2000) +} diff --git a/Task/MD5-Implementation/Guile/md5-implementation.guile b/Task/MD5-Implementation/Guile/md5-implementation.guile new file mode 100644 index 0000000000..fd52628d4f --- /dev/null +++ b/Task/MD5-Implementation/Guile/md5-implementation.guile @@ -0,0 +1,196 @@ +;;;This is intended to be run by Guile +;;;If you want to try it elsewhere, I think you might need to replace some module importing lines + +;;module-required (rnrs bytevectors) +;;usage -> {bytevector-u8-list bytevector-length bytevector->uint-list bytevector-u8-set! bytevector-copy! bytevector-u32-set!} {pad listify} +;; +(use-modules (rnrs bytevectors)) + +;;module-required (ice-9 receive) (ice-9 exceptions) +;;usage -> {receive make-exception-with-message} {md5sum test-suite} +;; +(use-modules (ice-9 receive)) +(use-modules (ice-9 exceptions)) + +;;syntax-name F +;;match -> (<$:self:F> B C D) +;; +(define-syntax F + (syntax-rules () + [(_ B C D) + (logior (logand B C) (logand (lognot B) D))])) + +;;syntax-name G +;;match -> (<$:self:G> B C D) +;; +(define-syntax G + (syntax-rules () + [(_ B C D) + (logior (logand B D) (logand C (lognot D)))])) + +;;syntax-name H +;;match -> (<$:self:H> B C D) +;; +(define-syntax H + (syntax-rules () + [(_ B C D) + (logxor B C D)])) + +;;syntax-name I +;;match -> (<$:self:I> B C D) +;; +(define-syntax I + (syntax-rules () + [(_ B C D) + (logxor C (logior B (lognot D)))])) + +;;syntax-name leftrotate +;;match -> (<$:self:leftrotate> num s) +;; +(define-syntax leftrotate + (syntax-rules () + [(_ num s) + (let ([num (logand num #xFFFFFFFF)]) + (logior (ash num (- s 32)) (ash num s)))])) + +;;procedure-name pad +;;input -> bv (bytevector) +;;output -> output-bv (bytevector) [(zero? (floor-remainder (bytevector-length output-bv) 64)) => #t] +;; +(define pad + (lambda (bv) + (let* ([bv-length (bytevector-length bv)] + [original-length (* 8 bv-length)] + + [remainder (floor-remainder bv-length 64)] + [pad-total (if (>= remainder 56) (- 128 remainder) (- 64 remainder))] + [total-length (+ bv-length pad-total)] + [output-bv (make-bytevector total-length 0)] + + [original-length-cooked (logand original-length #xFFFFFFFFFFFFFFFF)] + [original-length-bv (uint-list->bytevector (list original-length-cooked) (endianness little) 8)]) + + (bytevector-copy! bv 0 output-bv 0 bv-length) + (bytevector-u8-set! output-bv bv-length #x80) + (bytevector-copy! original-length-bv 0 output-bv (- total-length 8) 8) + + output-bv))) + +;;procedure-name listify +;;input -> bv (bytevector) [(zero? (floor-remainder (bytevector-length output-bv) 64)) => #t] +;;output -> _ (list:list:u32[16]) +;; +(define listify + (lambda (bv) + (let ([bv-as-u32-list (bytevector->uint-list bv (endianness little) 4)]) + (let ([total-num (/ (length bv-as-u32-list) 16)]) + (let loop ([n 0] [lst bv-as-u32-list]) + (if (>= n (- total-num 1)) + (list lst) + (cons (list-head lst 16) (loop (+ 1 n) (list-tail lst 16))))))))) + +;;procedure-name process-512bits +;;input -> X (list;u32[16]) A B C D K s +;;output -> _ (u32[4]) +;;note -> "This function is intended to do the real 64 rounds calculation and return the A B C D in the end but it doesn't need to loop at all" +;; +(define process-512bits + (lambda (X A B C D K s) + (let ([AA A][BB B][CC C][DD D]) + (let ([F1 #f][g #f][i 0]) + (while (<= i 63) + (when (and (>= i 0) (<= i 15)) + (set! F1 (F BB CC DD)) + (set! g i)) + (when (and (>= i 16) (<= i 31)) + (set! F1 (G BB CC DD)) + (set! g (modulo (1+ (* 5 i)) 16))) + (when (and (>= i 32) (<= i 47)) + (set! F1 (H BB CC DD)) + (set! g (modulo (+ 5 (* 3 i)) 16))) + (when (and (>= i 48) (<= i 63)) + (set! F1 (I BB CC DD)) + (set! g (modulo (* 7 i) 16))) + + (set! F1 (modulo (+ F1 AA (list-ref K i) (list-ref X g)) (expt 2 32))) + (set! AA DD) + (set! DD CC) + (set! CC BB) + (set! BB (modulo (+ BB (leftrotate F1 (list-ref s i))) (expt 2 32))) + + (set! i (1+ i))) + + (values (modulo (+ A AA) (expt 2 32)) + (modulo (+ B BB) (expt 2 32)) + (modulo (+ C CC) (expt 2 32)) + (modulo (+ D DD) (expt 2 32))))))) + +#! uncomment this block if guile complains about the unbound variable: format +;;module-required (ice-9 format) +;;usage -> format (procedure) md5sum (procedure) +;; +(use-modules (ice-9 format)) +!# + +;;procedure-name md5sum +;;input -> bv (bytevector) +;;output -> _ (string) +;; +(define md5sum + (lambda (bv) + (let ([A #x67452301] + [B #xEFCDAB89] + [C #x98BADCFE] + [D #x10325476] + [K '(#xd76aa478 #xe8c7b756 #x242070db #xc1bdceee #xf57c0faf #x4787c62a #xa8304613 #xfd469501 #x698098d8 #x8b44f7af #xffff5bb1 #x895cd7be #x6b901122 #xfd987193 #xa679438e #x49b40821 #xf61e2562 #xc040b340 #x265e5a51 #xe9b6c7aa #xd62f105d #x02441453 #xd8a1e681 #xe7d3fbc8 #x21e1cde6 #xc33707d6 #xf4d50d87 #x455a14ed #xa9e3e905 #xfcefa3f8 #x676f02d9 #x8d2a4c8a #xfffa3942 #x8771f681 #x6d9d6122 #xfde5380c #xa4beea44 #x4bdecfa9 #xf6bb4b60 #xbebfbc70 #x289b7ec6 #xeaa127fa #xd4ef3085 #x04881d05 #xd9d4d039 #xe6db99e5 #x1fa27cf8 #xc4ac5665 #xf4292244 #x432aff97 #xab9423a7 #xfc93a039 #x655b59c3 #x8f0ccc92 #xffeff47d #x85845dd1 #x6fa87e4f #xfe2ce6e0 #xa3014314 #x4e0811a1 #xf7537e82 #xbd3af235 #x2ad7d2bb #xeb86d391)] + [s '(7 12 17 22 7 12 17 22 7 12 17 22 7 12 17 22 5 9 14 20 5 9 14 20 5 9 14 20 5 9 14 20 4 11 16 23 4 11 16 23 4 11 16 23 4 11 16 23 6 10 15 21 6 10 15 21 6 10 15 21 6 10 15 21)]) + (let* ([padded-bv (pad bv)] + [512bits-word-lists (listify padded-bv)] + [words-list-length (length 512bits-word-lists)]) + + (do ((index 0 (1+ index))) + ((>= index words-list-length)) + + (receive (A1 B1 C1 D1) (process-512bits (list-ref 512bits-word-lists index) A B C D K s) + (set! A A1) + (set! B B1) + (set! C C1) + (set! D D1))) + + (let ([bvA (uint-list->bytevector (list A) (endianness little) 4)] + [bvB (uint-list->bytevector (list B) (endianness little) 4)] + [bvC (uint-list->bytevector (list C) (endianness little) 4)] + [bvD (uint-list->bytevector (list D) (endianness little) 4)]) + (set! A (car (bytevector->uint-list bvA (endianness big) 4))) + (set! B (car (bytevector->uint-list bvB (endianness big) 4))) + (set! C (car (bytevector->uint-list bvC (endianness big) 4))) + (set! D (car (bytevector->uint-list bvD (endianness big) 4)))) + + (format #f "~8,'0x~8,'0x~8,'0x~8,'0x" A B C D))))) + +;;procedure-name test-suite +;;input -> <$:nil> +;;output -> _ (string) +;;note -> "this is the test function for the overall output" +;; +(define test-suite + (lambda () + (let ([standard '(("" . "d41d8cd98f00b204e9800998ecf8427e") + ("a" . "0cc175b9c0f1b6a831c399e269772661") + ("abc" . "900150983cd24fb0d6963f7d28e17f72") + ("message digest" . "f96b697d7cb7938d525a2f31aaf161d0") + ("abcdefghijklmnopqrstuvwxyz" . "c3fcd3d76192e4007dfb496cca67e13b") + ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" . "d174ab98d277d9f5a5611c2c9f419d9f") + ("12345678901234567890123456789012345678901234567890123456789012345678901234567890" . "57edf4a22be3c955ac49da2e2107b67a"))]) + (for-each (lambda (some-pair) + (display "Now checking: ") + (write some-pair) + (newline) + (let ([my-ans (md5sum (string->utf8 (car some-pair)))]) + (display "my answer is: ") + (display my-ans) + (newline) + (if (string=? my-ans (cdr some-pair)) + (begin (display "Pass! Next!") (newline)) + (raise-exception (make-exception-with-message "Failed!"))))) + standard)))) diff --git a/Task/MD5/PascalABC.NET/md5.pas b/Task/MD5/PascalABC.NET/md5.pas new file mode 100644 index 0000000000..97d933d8b3 --- /dev/null +++ b/Task/MD5/PascalABC.NET/md5.pas @@ -0,0 +1,6 @@ +## +uses System.Security.Cryptography; + +var data := Encoding.ASCII.GetBytes('The quick brown fox jumped over the lazy dog''s back'); +foreach var h in MD5.Create().ComputeHash(data) do + h.ToString('X2').print; diff --git a/Task/Magic-constant/PascalABC.NET/magic-constant.pas b/Task/Magic-constant/PascalABC.NET/magic-constant.pas new file mode 100644 index 0000000000..6e33247fbb --- /dev/null +++ b/Task/Magic-constant/PascalABC.NET/magic-constant.pas @@ -0,0 +1,17 @@ +## +function magic(n: biginteger) := n * (n * n + 1) div 2; + +println('The first 20 magic constants:'); +(1 + 2..22).Select(x -> magic(x)).Println; +println; + +println('The 1,000th magic constant:',magic(1000 + 2),#10); + +for var n := 1 to 20 do +begin + write('10^', n, ': '); + (1..maxint).Select(x -> biginteger(x)) + .SkipWhile(x -> magic(x) < power(10bi, n)) + .First + .Println; +end; diff --git a/Task/Magic-squares-of-doubly-even-order/PascalABC.NET/magic-squares-of-doubly-even-order.pas b/Task/Magic-squares-of-doubly-even-order/PascalABC.NET/magic-squares-of-doubly-even-order.pas new file mode 100644 index 0000000000..8a599e6027 --- /dev/null +++ b/Task/Magic-squares-of-doubly-even-order/PascalABC.NET/magic-squares-of-doubly-even-order.pas @@ -0,0 +1,29 @@ +const + n = 8; + +function MagicSquareDoublyEven(n: integer): array [,] of integer; +begin + assert((n >= 4) and (n mod 4 = 0), 'base must be a positive multiple of 4'); + + // pattern of count-up vs count-down zones + var bits := Convert.ToInt32('1001011001101001', 2); + var size := n * n; + var mult := n div 4; // how many multiples of 4 + + result := new integer[n, n]; + + var i := 0; + for var r := 0 to n - 1 do + for var c := 0 to n - 1 do + begin + var bitPos := c div mult + (r div mult) * 4; + result[r, c] := if (bits and (1 shl bitPos)) <> 0 then i + 1 else size - i; + i += 1; + end; +end; + +begin + MagicSquareDoublyEven(n).Println; + + Writeln(#10, 'Magic constant: ', (n * n + 1) * n div 2); +end. diff --git a/Task/Magic-squares-of-doubly-even-order/XPL0/magic-squares-of-doubly-even-order.xpl0 b/Task/Magic-squares-of-doubly-even-order/XPL0/magic-squares-of-doubly-even-order.xpl0 new file mode 100644 index 0000000000..faeeb5bfbc --- /dev/null +++ b/Task/Magic-squares-of-doubly-even-order/XPL0/magic-squares-of-doubly-even-order.xpl0 @@ -0,0 +1,26 @@ + \Magic squares of doubly even order - 11/30/2024; + integer Pattern(1+4,1+4); + integer N, R, C, S, M, I, B, T; +begin + N:=8; + for R:=1 to 4 do + for C:=1 to 4 do + Pattern(R,C):=if + ((C=1 or C=4) and (R=1 or R=4)) or + ((C=2 or C=3) and (R=2 or R=3)) then 1 else 0; + S:=N*N; M:=N/4; + Text(1,"magic square -- n = "); IntOut(1,N); Text(1,"^m^j"); + I:=0; + for R:=1 to N do begin + for C:=1 to N do begin + B:=Pattern((R-1)/M+1, (C-1)/M+1); + if B=1 then T:=I+1 else T:=S-I; + if T < 10 then Text(1," "); + Text(1," "); + IntOut(1,T); + I:=I+1 + end; + Text(1,"^m^j") + end; + Text(1,"magic constant = "); IntOut(1,(S+1)*N/2) +end diff --git a/Task/Magnanimous-numbers/PascalABC.NET/magnanimous-numbers.pas b/Task/Magnanimous-numbers/PascalABC.NET/magnanimous-numbers.pas new file mode 100644 index 0000000000..de6dee7581 --- /dev/null +++ b/Task/Magnanimous-numbers/PascalABC.NET/magnanimous-numbers.pas @@ -0,0 +1,50 @@ +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 isMagnanimous(n: int64): boolean; +begin + var p := 10; + result := True; + while True do + begin + var a := n div p; + var b := n mod p; + if a = 0 then exit; + if not isPrime(a + b) then break; + p *= 10; + end; + result := false; +end; + +function magnanimous(): sequence of int64; +begin + var n: int64 := 0; + while true do + begin + if isMagnanimous(n) then yield n; + n += 1; + end; +end; + +begin + writeln('First 45 magnanimous numbers:'); + magnanimous.Take(45).Println; + writeln(#10, '241st through 250th magnanimous numbers:'); + magnanimous.Skip(240).Take(10).Println; + writeln(#10, '391st through 400th magnanimous numbers:'); + magnanimous.Skip(390).Take(10).Println; +end. diff --git a/Task/Mandelbrot-set/Aquarius-BASIC/mandelbrot-set-1.basic b/Task/Mandelbrot-set/Aquarius-BASIC/mandelbrot-set-1.basic new file mode 100644 index 0000000000..fbe45621fe --- /dev/null +++ b/Task/Mandelbrot-set/Aquarius-BASIC/mandelbrot-set-1.basic @@ -0,0 +1,19 @@ +10 PRINT CHR$(11); +20 CS=12288+1024 +30 FOR Y=0 TO 24 +40 FOR X=0 TO 39 +50 GOSUB 100:POKE CS,COL +60 CS=CS+1 +70 NEXT +80 NEXT +90 END +100 XP=X/39*2.7-2 +110 YP=Y/24*2-1 +120 IT=0:XX=0:YY=0 +130 XTEMP=XX*XX - YY*YY + XP +140 YY=2*XX*YY + YP +150 XX=XTEMP +160 IT=IT+1 +170 IF XX*XX+YY*YY<4 AND IT<20 THEN 130 +180 COL=IT AND 15:IF IT=20 THEN COL=0 +190 RETURN diff --git a/Task/Mandelbrot-set/Aquarius-BASIC/mandelbrot-set-2.basic b/Task/Mandelbrot-set/Aquarius-BASIC/mandelbrot-set-2.basic new file mode 100644 index 0000000000..a185c3d6a6 --- /dev/null +++ b/Task/Mandelbrot-set/Aquarius-BASIC/mandelbrot-set-2.basic @@ -0,0 +1,15 @@ +10 PRINT CHR$(11); +20 FOR Y=0 TO 71 +30 FOR X=0 TO 79 +40 GOSUB 100 +50 NEXT:NEXT:END +100 XP=X/79*2.7-2 +110 YP=Y/71*2-1 +120 IT=0:XX=0:YY=0 +130 XTEMP=XX*XX - YY*YY + XP +140 YY=2*XX*YY + YP +150 XX=XTEMP +160 IT=IT+1 +170 IF XX*XX+YY*YY<4 AND IT<20 THEN 130 +180 IF IT=20 THEN PSET(X,Y) +190 RETURN diff --git a/Task/Mandelbrot-set/Atari-BASIC/mandelbrot-set.basic b/Task/Mandelbrot-set/Atari-BASIC/mandelbrot-set.basic new file mode 100644 index 0000000000..f2b1fc6ac0 --- /dev/null +++ b/Task/Mandelbrot-set/Atari-BASIC/mandelbrot-set.basic @@ -0,0 +1,18 @@ +10 GRAPHICS 7+16 +20 FOR Y=0 TO 95 +30 FOR X=0 TO 159 +40 GOSUB 100 +50 NEXT X +60 NEXT Y +70 GOTO 70 +100 XP=X/159*2.7-2 +110 YP=Y/95*2-1 +120 IT=0:XX=0:YY=0 +130 XTEMP=XX*XX-YY*YY+XP +140 YY=2*XX*YY+YP +150 XX=XTEMP +160 IT=IT+1 +170 IF XX*XX+YY*YY<4 AND IT<20 THEN 130 +180 COLOR 1:IF IT=20 THEN COLOR 3 +190 PLOT X,Y +200 RETURN diff --git a/Task/Mandelbrot-set/FreeBASIC/mandelbrot-set.basic b/Task/Mandelbrot-set/FreeBASIC/mandelbrot-set.basic index 9abceba9b2..8dd4df4dd8 100644 --- a/Task/Mandelbrot-set/FreeBASIC/mandelbrot-set.basic +++ b/Task/Mandelbrot-set/FreeBASIC/mandelbrot-set.basic @@ -51,6 +51,8 @@ for x=0 to 639 next y next x +bsave "mandel.bmp",0 + while inkey="" wend end diff --git a/Task/Map-range/PascalABC.NET/map-range.pas b/Task/Map-range/PascalABC.NET/map-range.pas new file mode 100644 index 0000000000..1c7eb439af --- /dev/null +++ b/Task/Map-range/PascalABC.NET/map-range.pas @@ -0,0 +1,5 @@ +## +function maprange(a, b: (real, real); s: real) := b[0] + (s - a[0]) * (b[1] - b[0]) / (a[1] - a[0]); + +for var i := 0 to 10 do + Writeln(i, ' maps to ', maprange((0, 10), (-1, 0), i)); diff --git a/Task/Mastermind/FutureBasic/mastermind.basic b/Task/Mastermind/FutureBasic/mastermind.basic new file mode 100644 index 0000000000..f7a202c696 --- /dev/null +++ b/Task/Mastermind/FutureBasic/mastermind.basic @@ -0,0 +1,452 @@ +_window = 1 +_Check = 250 +_NewGame = 251 + +_view = 2000 + +_PrefWnd = 2 +begin enum 1 + _NoOfColours + _Label + _CodeLgth + _Label1 + _Guesses + _Repeats + _Label2 + _Exit + _info +end enum + +begin enum 1000 + _blue + _Red + _Yellow + _Magenta + _Orange + _Green + _Brown + _Cyan + _Purple + _DarkGray +end enum + +_mApplication = 0 +begin enum 0 + _iAbout + _iSeparator + _PreferencesItem + _iSeparator1 + _iHide +end enum + +_EditMenu = 1 + +begin enum + _iUndo + _iRedo + _ + _iCut + _iCopy + _iPaste + _iDelete + _iSelectAll +end enum + + +begin globals +CFStringRef gColours, gCodeLgth, gGuesses +BOOL gRepeats = NO, gWon = NO +ColorRef gNewColour +int gNextFld = 1, gRestriction = 1 +CFMutableArrayRef gArray +CFMutableArrayRef gTargetArray +CFMutableArrayRef gTargetColours +CFMutableArrayRef gGuessArray +int gLine = 1, gLastGuess, gLength +int gColor(12) +CFMutableArrayRef gRestrict +end globals + +// Colours 2 - 12 +// Code Lgth 4 - 10 +// Guesses 7 - 20 total fields 10*20 = 200 + +gArray = fn MutableArrayWithCapacity(0) +gTargetArray = fn MutableArrayWithCapacity(0) +gGuessArray = fn MutableArrayWithCapacity(0) +gRestrict = fn MutableArrayWithCapacity(0) +gTargetColours = fn MutableArrayWithCapacity(0) + +// Master Mind game + +void local fn SetBackgroundColor( col as ColorRef ) + TextFieldRef fld = fn ViewWithTag(gNextFld) + UndoManagerRef um = fn ResponderUndoManager( fld ) + UndoManagerRegisterUndo( um, @fn SetBackgroundColor, fn TextFieldBackgroundColor(fld)) + UndoManagerSetActionName( um, @"Set Background Color" ) + TextFieldSetBackgroundColor( fld, col ) +end fn + +LOCAL FN Max(Big as int,Little AS int) as int + int MaxNo + IF Big > Little THEN MaxNo = Big ELSE MaxNo = Little +END FN = MaxNo + +void local fn SetColor + for int x = 0 to 11 + gColor(x) = x + next +end fn + +local fn RandomChoice( count as int) as int + int x,i + Bool check = NO + DO + x = rnd( count + 1 ) - 1 + if gColor(x) > -1 + i = gColor(x ) + if gColor(x) == 0 + gColor(x) = -1 + else + gColor(x) = -gColor(x) + end if + check = YES + end if + until check == YES +end fn = i + +void local fn Winning + alert -1,, @"Message", @"You Won This Game", @"OK;Continue", YES + AlertButtonSetKeyEquivalent( 1, 1, @"\e" ) + alert 1 + gWon = YES +end fn + +void local fn SetTarget + int count = fn StringIntValue( gColours ) + int x, y + CFStringRef key + ColorRef col + MutableArrayRemoveAllObjects( gTargetArray ) + MutableArrayRemoveAllObjects( gTargetColours ) + + for x = 0 to count - 1 + if gRepeats == NO + y = fn RandomChoice( count ) + else + y = rnd( count + 1 ) - 1 + end if + key = fn StringWithFormat( @"%d", y) + col = fn ArrayObjectAtIndex( gArray, y ) + MutableArrayInsertObjectAtIndex( gTargetColours,col, x ) + MutableArrayInsertObjectAtIndex( gTargetArray,key, x ) + next +end fn + +void local fn SetFields + Int x,y,z = 1,xx,yy,zz = 299 + int CodeLgth = fn StringIntValue( gCodeLgth ) + int Guesses = fn StringIntValue( gGuesses ) + CGRect r, lr + gLastGuess = Guesses + xx = 20:yy = 40 + r = fn CGRectMake( xx, yy, 25, 25 ) + lr = fn CGRectMake( xx+CodeLgth*25 + 50, yy + 6, 12,12 ) + for x = 1 to Guesses + for y = 1 to CodeLgth + textfield z,,@"", r + ControlSetFontWithName(z,@"Times",12) + ControlSetAlignment( z, NSTextAlignmentCenter ) + TextFieldSetBackgroundColor( z, fn ColorWhite ) + r = fn CGRectOffset( r, 25, 0) + textfield z+zz,,@"",lr + TextFieldSetBackgroundColor( z+zz, fn ColorLightGray ) + z++ + lr = fn CGRectOffset( lr, 12,0) + next + lr = fn CGRectOffset( lr, -12*CodeLgth, 25 ) + r = fn CGRectOffset( r,-CodeLgth*25, 25) + next +end fn + +local fn FindColourAtPixel( tag as long ) as ColorRef +End Fn = fn ViewColorAtPoint( tag, fn EventLocationInView( tag )) + +local fn ClearTarget + int x, z = 3000 + int CodeLgth = fn StringIntValue( gCodeLgth ) + + for x = 0 to CodeLgth-1 + TextFieldSetBackgroundColor( z, fn ColorClear ) + z++ + next + textlabel 3100, @"" +end fn + +local fn ShowTarget + int x, z = 3000 + int CodeLgth = fn StringIntValue( gCodeLgth ) + int Guesses = fn StringIntValue( gGuesses ) + CGRect rr = fn CGRectMake( 20, Guesses*30 + 30, 25,25 ) + + for x = 0 to CodeLgth-1 + textfield z,,, rr + TextFieldSetBackgroundColor( z, fn ArrayObjectAtIndex( gTargetColours, x ) ) + rr = fn CGRectOffset( rr, 25, 0 ) + z++ + next + textlabel 3100, @"Target Array", ( 20, Guesses*30 + 60, 100, 26 ) +end fn + +void local fn BuildWnd + ColorRef col + Int x,z = 1,offset = 200 + CGRect r, rr + int lgth, wide + int CodeLgth = fn StringIntValue( gCodeLgth ) + int Guesses = fn StringIntValue( gGuesses ) + int Colour = fn StringIntValue( gColours ) + if Colour <= CodeLgth + select CodeLgth + case 4,5,6,7 + Colour += 3 + case 8,9,10 + Colour = 12 + end select + end if + if Guesses < 9 && Colour > 9 then offset += (Colour-Guesses) * 25 + CFArrayRef array = @[fn ColorBlue,fn ColorRed,fn ColorYellow,fn ColorMagenta,fn ColorOrange,fn ColorGreen,fn ColorBrown,fn ColorCyan,fn ColorPurple,fn ColorDarkGray,fn ColorSystemPink,fn ColorSystemTeal] + MutableArrayAddObjectsFromArray( gArray, array ) + wide = CodeLgth*37 + 180 + lgth = fn Max(Guesses*27 + offset, Colour*30 + 50 ) + gLength = lgth + window _window, @"Master Mind", ( 210,310,wide, lgth ) + ViewSetFlipped(_windowContentViewTag, YES) + fn SetFields + subclass view _view, ( wide - 65, 20,50, lgth - 60) + ViewSetFlipped( _view, YES ) + rr = fn CGRectMake( wide - 65, 20,50, lgth - 60) + rect rr,,8 + r = fn CGRectMake( 15, 15, 25,25) + z = 1000 + for x = 0 to Colour - 1 + col = fn ArrayObjectAtIndex( array, x) + subclass view z, r + ViewSetWantsLayer( z, YES ) + CALayerSetBackgroundColor( fn ViewLayer(z), col ) + ViewInitTrackingArea( z ) + ViewAddSubView( _view, z ) + r = fn CGRectOffset( r,0,30 ) + z++ + next + + button _Check, , , @"Check", ( 30, lgth - 65, 100, 26) + button _NewGame, , ,@"New Game", (150, lgth - 65, 100, 26 ) + +end fn + +void local fn Capture( wnd as long ) + int y, z + CFStringRef txt = @"" + + select Wnd + case _PrefWnd + gColours = fn PopUpButtonTitleOfSelectedItem(_NoOfColours) + gCodeLgth = fn PopUpButtonTitleOfSelectedItem(_CodeLgth) + gGuesses = fn PopUpButtonTitleOfSelectedItem(_Guesses) + if fn ButtonState( _Repeats ) == NSControlStateValueOn then gRepeats = YES else gRepeats = NO + fn SetColor + case _window + //if fn ButtonState( _Repeats ) == NSControlStateValueOn then gRepeats = YES else gRepeats = NO + z = fn StringIntValue( gCodeLgth ) + y = gLine*z - z + 1 + MutableArrayRemoveAllObjects( gGuessArray ) + for int x = y to (y + z - 1) + txt = fn ControlStringValue( x) + MutableArrayAddObject(gGuessArray, txt ) + next + gLine++ + if gLine > gLastGuess + fn ShowTarget + alert -1,, @"Message", @"You Fail to win this Game", @"OK;Continue", YES + AlertButtonSetKeyEquivalent( 1, 1, @"\e" ) + alert 1 + gWon = NO + end if + end select +end fn + +void local fn Compare + int x,y,count = fn StringIntValue( gCodeLgth ) + CFTypeRef target,guess,target1 + bool won = YES + + fn Capture( _window ) + gRestriction = 1 + //Check for location and colour + for x = 0 to count - 1 + target = fn ArrayObjectAtIndex( gTargetArray, x) + guess = fn ArrayObjectAtIndex( gGuessArray, x) + if target == guess + TextFieldSetBackgroundColor( (gLine-2)*count + 300 + x, fn ColorBlack ) + else + for y = 0 to count - 1 + won = NO + target1 = fn ArrayObjectAtIndex( gTargetArray, y) + if target1 == guess + TextFieldSetBackgroundColor( (gLine-2)*count + 300 + x, fn ColorWhite ) + end if + next + end if + next + ControlSetEnabled( _Check, NO ) + MutableArrayRemoveAllObjects( gRestrict ) + if won == YES then fn Winning +end fn + +void local fn NewGame + fn SetColor + fn SetFields + if gWon == NO + fn ClearTarget + end if + fn SetTarget + gLine = 1 + gNextFld = 1 +end fn + +void local fn Preferences + CGRect rr, lr + window _PrefWnd, @"Preferences", ( 0,0,250,350) + + rr = fn CGRectMake( 20,220,160,26) + lr = fn CGRectMake( 20,200, 60, 26 ) + textlabel _label, @"No Of Colours", rr + popupbutton _NoOfColours,,19, @"2;3;4;5;6;7;8;9;10;11;12", lr + rr = fn CGRectOffset( rr, 0, -50) + lr = fn CGRectOffset( lr, 0, -50) + textlabel _label1, @"No Of Items", rr + popupbutton _CodeLgth,,7,@"4;5;6;7;8;9;10", lr + rr = fn CGRectOffset( rr, 0, -50) + lr = fn CGRectOffset( lr, 0, -50) + textlabel _label2, @"No Of Guesses", rr + popupbutton _Guesses,,14,@"4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20", lr + rr = fn CGRectMake( 100,150,100,26) + button _Exit,,,@"Begin Game", rr + checkbox _Repeats,,,@"Repeats Allowed", ( 20, 70 , 160, 26 ) + rr = fn CGRectMake( 10,250, 230, 100) + textfield _info,,@"Move mouse over coloured square to choose\nThen move away from window\nRepeat for all fields\nThen click Check",rr + gNextFld = 1 + gRestriction = 1 + UserDefaultsRestoreWindowViewValues( _PrefWnd, NULL ) +end fn + +void Local Fn BuildMenu //build menu & get handle + menu _mApplication, _iAbout + menu _mApplication, _iSeparator + menu _mApplication, _PreferencesItem,, @"Settings…", @"," + menu _mApplication, _iSeparator1 + menu _mApplication, _iHide,, @"Hide Master Mind", @"h" + MenuItemSetAction( _mApplication, _iHide, @"hide:") + + EditMenu _EditMenu + /* + menu _EditMenu,_iUndo,YES + MenuItemSetActionCallBack( _EditMenu, _iUndo, @fn SetBackGroundColor, NULL ) + menu _EditMenu,_iRedo + + menu _EditMenu,_iCut + menu _EditMenu,_iCopy + menu _EditMenu,_iPaste + menu _EditMenu,_iDelete + menu _EditMenu,_iSelectAll + */ +end fn + +void local fn doMenu(act as long, ref as long ) + select act + case _mApplication + select ref + case _PreferencesItem + windowClose( _window) + fn Preferences + case else + end select + case _EditMenu + /* + select ref + case _iUndo + gNextFld-- + case _iRedo + gNextFld++ + case _iCut + case _iCopy + case _iPaste + case _iDelete + case _iSelectAll + end select + */ + end select +end fn + +void local fn doDialog( act as long, ref as long, wnd as long) + select Wnd + case _window + select act + case _BtnClick + select ref + case _Check : fn Compare + case _NewGame : fn NewGame + + end select + case _viewMouseEntered,_viewMouseDown + select ref + if gRepeats == NO && fn ArrayDoesContain( gRestrict, (ObjectRef)fn StringWithFormat( @"%d", ref )) == YES + else + if gRestriction < fn StringIntValue( gCodeLgth) + 1 + gNewColour = fn FindColourAtPixel( ref ) + ControlSetStringValue( gNextFld, fn StringWithFormat(@"%d",ref-1000)) + fn SetBackgroundColor( gNewColour ) + if gRepeats == NO + MutableArrayAddObject( gRestrict,fn StringWithFormat( @"%d", ref )) + end if + gNextFld++ + gRestriction++ + else + ControlSetEnabled( _Check, YES ) + end if + end if + end select + end select + case _PrefWnd + select act + case _btnClick + select ref + case _NoOfColours + gColours = fn PopUpButtonTitleOfSelectedItem(ref) + case _CodeLgth + gCodeLgth = fn PopUpButtonTitleOfSelectedItem(ref) + case _Guesses + gGuesses = fn PopUpButtonTitleOfSelectedItem(ref) + Case _Repeats + if fn ButtonState( _Repeats ) == NSControlStateValueOn then gRepeats = YES else gRepeats = NO + case _Exit + UserDefaultsStoreWindowViewValues( wnd, NULL ) + fn Capture (wnd ) + WindowClose( wnd) + fn BuildWnd + fn SetTarget + end select + end select + end select +end fn + + +fn Preferences +fn BuildMenu + + +on Dialog fn doDialog +on Menu fn doMenu + +HandleEvents diff --git a/Task/Mastermind/M2000-Interpreter/mastermind.m2000 b/Task/Mastermind/M2000-Interpreter/mastermind.m2000 new file mode 100644 index 0000000000..d5146cf1d7 --- /dev/null +++ b/Task/Mastermind/M2000-Interpreter/mastermind.m2000 @@ -0,0 +1,88 @@ +Module MasterMind { + cls #225522, 0 + GetInput=lambda (s as string, min as integer, max as integer) -> { + do + print s+"("+min+" - "+max+")"; + Input ":",v% + until v%>=min and v%<=max + =v% + } + GetInputGuess=lambda (moves as integer, length as integer, max as integer, once as boolean) -> { + string k, s + integer j, oldi + boolean check[max]=false + pen 15 {print str$(moves,"00")+". ";} + for i=1 to length + do + do + if oldi=i then beep + k=ucase$(key$) + j = asc(k)-64 + oldi=i + when j<1 or j>max + when once and check[j] + pen #99ffbb {print k;} + if once then check[j]=true + s+=k + next + =s + } + DisplayFinal=lambda (a) -> { + string s + for i=1 to len(a)-1 + s+=chr$(64+a[i]) + next + =s + } + pen 15 + integer C=GetInput("number of colors", 2, 20) + integer CL=GetInput("code length", 4, 10) + integer mn=GetInput("maximum number of guesses", 7, 20) + if c>=CL then + boolean rc=GetInput("colors may be repeated in the code", 0, 1) + else + boolean rc=true + end if + pen #00ff00 + Cls ,0 + integer acc[CL], i + do + if rc then + for i=1 to cl: acc[i]=random(1, C): next + else + boolean color[C] + for i=1 to cl + do + acc[i]=random(1, C) + when color[acc[i]] + color[acc[i]]=true + next + end if + string target=DisplayFinal(acc), z, mark + integer moves=1 + pen 15 {Print "Guess", @(20),"Mark"} + for i=1 to mn + z=GetInputGuess(i, CL, C, Not RC) + if target=z then exit for + mark="" + for j=1 to CL + if acc[j]=asc(mid$(z, j, 1))-64 then + mark+="X" + else.if instr(target, mid$(z, j, 1))>0 then + mark+="O" + else + mark+="-" + end if + next + Print @(20), mark + next + print + if target=z then + pen 15 {print "Guess Done"} + else + print "You loose, secret code was:"+target + end if + print "Play again ? (Y - N)" + Until ucase$(key$)<>"Y" +} +MasterMind diff --git a/Task/Matrix-digital-rain/Aquarius-BASIC/matrix-digital-rain.basic b/Task/Matrix-digital-rain/Aquarius-BASIC/matrix-digital-rain.basic new file mode 100644 index 0000000000..f9c961c005 --- /dev/null +++ b/Task/Matrix-digital-rain/Aquarius-BASIC/matrix-digital-rain.basic @@ -0,0 +1,22 @@ +10 DIM P(40),ACT(40),S(40) +20 FOR I=0 TO 1000:POKE 13312+I,0:NEXT + +100 CA=0 +110 FOR X=0 TO 39:IF ACT(X)=0 THEN 180 +120 CA=CA+1 +130 IF S(X)=0 THEN Y=P(X)-1:COL=0:GOSUB 1000:GOTO 160 +140 Y=P(X):COL=112:IF Y<24 THEN GOSUB 1000 +150 Y=P(X)-1:COL=32:GOSUB 1000 +160 P(X)=P(X)+1 +170 IF P(X)=25 THEN ACT(X)=0 +180 NEXT X +190 IF CA<6 AND RND(1)<.1 THEN GOSUB 2000 +200 GOTO 100 + +1000 POKE 13312+40*Y+X,COL +1010 POKE 12288+40*Y+X,INT(255*RND(1)) +1020 RETURN + +2000 NX=38*RND(1)+1:ACT(NX)=1:P(NX)=1:OLD=S(NX) +2010 S(NX)=0:IF OLD=0 THEN S(NX)=1 +2020 RETURN diff --git a/Task/Matrix-digital-rain/M2000-Interpreter/matrix-digital-rain.m2000 b/Task/Matrix-digital-rain/M2000-Interpreter/matrix-digital-rain.m2000 new file mode 100644 index 0000000000..c471dde51f --- /dev/null +++ b/Task/Matrix-digital-rain/M2000-Interpreter/matrix-digital-rain.m2000 @@ -0,0 +1,56 @@ +module MatrixRain { + a$="寿司历史可追溯至2000年前日本开始发展水稻种植的时期。寿司的雏形出现于弥生时代，当时的人发明了将食用鱼加盐在米饭中发酵的做法，即今日的熟寿司，此时米饭为发酵所用材料，并不食用。到了室町时代，其中发酵过的米饭变得也可以食用。在江户时代，醋逐渐取代了发酵米饭的地位。而到了近现代，寿司则成为了一种与日本文化紧密相关的快餐食品。" + r=random(!4324234) + + p3=pi*3/2 + double m[120] + single x[120], y[120] + long t[120], k[120], s[120], z[120], q[120], p[120] + hide + background { + for i=1 to 120 + t[i]=random(1, 10) + x[i]=random(0, scale.x) + y[i]=random(-1000, scale.y/2) + k[i]=random(20, 50) + s[i]=random(30, 60) + z[i]=random(8, 22) + q[i]=random(1, len(a$)-20) + p[i]=10 + m[i]=1+rnd/100 + next + refresh 1000 + do + pen 0, 50 + gradient 0, #002200 + for i=1 to 120 + if k[i]<20 then + y[i]+=twipsY*s[i] + move @f(x[i]), y[i] :m[i]*=1.006 + pen #00aa00, t[i]*(22-p[i])/20+20 + legend mid$(a$, q[i],p[i]), fontname$, z[i], p3 + if p[i]>2 then q[i]++:p[i]-- + end if + k[i]-- + if k[i]=0 then + q[i]=random(1, len(a$)-20):p[i]=10 + y[i]=random(-1000, scAle.y/4): k[i]=random(15, 30):z[i]=random(8, 22) + m[i]=1+rnd/100:s[i]=random(30, 60) + end if + next + refresh 1000 + if inkey$=" " then exit + pen 14, 255 + always + } + background {cls} + show + function f(x) + if x0 then print #f, ", "; + print #f, "("; + if dimension(a(),2,1)>1 then + for j=0 to dimension(a(),2,1)-1 + print #f, a(i, j)+", "; + next + print #f, a(i, j)+")"; + else + print #f, a(i, 0)+",)"; + end if + next + if z then print #f, ",)" else print #f, ")" + end sub + sub showarray2(title$, a as *Long) + ' handle with one or zero sub arrays + print #f, title$+": ["; + for i=0 to len(a)-1 + if i>0 then print #f, ", "; + if valid(len(a[i])) then + print #f, "["; + if len(a[i])>1 then + for j=0 to len(a[i])-2 + print #f, a[i][j]+", "; + next + else + j=0 + end if + print #f, a[i][j]+"]"; + else + print #f, a[i]; + end if + next + print #f, "]" + end sub + function transposeLong(a as *long) + Local long R=Len(a)-1 ' upper bound dim 1 + Local long L=len(a[0])-1 ' upper bound dim 2 + local long b[L][R] + for i=0 to L + for j=0 to R + b[i][j]=a[j][i] + next + next + =b + End Function + function transposeAny(a) + if not valid(a[0][0]) then Error "Wrong Type" + Local long R=Len(a)-1 ' upper bound dim 1 + Local long L=len(a[0])-1 ' upper bound dim 2 + local Variant b[L][R] + for i=0 to L + for j=0 to R + b[i][j]=a[j][i] + next + next + =b + End Function + function transpose(a as array) + // we use a as pointer to array + // if we use transpose(a()) we get a copy on a() + // so we make one copy only + // copy a to a() + Local a() + a()=a + push &a + Read new &b() + Local long R=dimension(a(),1,1) ' upper bound dim 1 + Local long L=dimension(a(),2,1) ' upper bound dim 2 + ' this is a redim, and preserve the array type also + Dim a(L+1,R+1) + for i=0 to L + for j=0 to R + a(i,j)=b(j, i) + next + next + =a() + End Function +} +Matrix_Transpose diff --git a/Task/Maximum-triangle-path-sum/PascalABC.NET/maximum-triangle-path-sum.pas b/Task/Maximum-triangle-path-sum/PascalABC.NET/maximum-triangle-path-sum.pas new file mode 100644 index 0000000000..b17568558e --- /dev/null +++ b/Task/Maximum-triangle-path-sum/PascalABC.NET/maximum-triangle-path-sum.pas @@ -0,0 +1,35 @@ +var + data := arr( + |55|, + |94, 48|, + |95, 30, 96|, + |77, 71, 26, 67|, + |97, 13, 76, 38, 45|, + |07, 36, 79, 16, 37, 68|, + |48, 07, 09, 18, 70, 26, 06|, + |18, 72, 79, 46, 59, 79, 29, 90|, + |20, 76, 87, 11, 32, 07, 07, 49, 18|, + |27, 83, 58, 35, 71, 11, 25, 57, 29, 85|, + |14, 64, 36, 96, 27, 11, 58, 56, 92, 18, 55|, + |02, 90, 03, 60, 48, 49, 41, 46, 33, 36, 47, 23|, + |92, 50, 48, 02, 36, 59, 42, 79, 72, 20, 82, 77, 42|, + |56, 78, 38, 80, 39, 75, 02, 71, 66, 66, 01, 03, 55, 72|, + |44, 25, 67, 84, 71, 67, 11, 61, 40, 57, 58, 89, 40, 56, 36|, + |85, 32, 25, 85, 57, 48, 84, 35, 47, 62, 17, 01, 01, 99, 89, 52|, + |06, 71, 28, 75, 94, 48, 37, 10, 23, 51, 06, 48, 53, 18, 74, 98, 15|, + |27, 02, 92, 23, 08, 71, 76, 84, 15, 52, 92, 63, 81, 10, 44, 10, 69, 93|); + +function solve(triangle: array of array of integer): integer; +begin + var rows := triangle.Count; + var sumrow := triangle[rows - 1]; + for var row := rows - 1 downto 1 do + sumrow := sumrow.Pairwise((x, y) -> Max(x, y)) + .Zip(triangle[row - 1], (x, y) -> x + y).ToArray; + + result := sumrow[0]; +end; + +begin + solve(data).Println; +end. diff --git a/Task/Mayan-calendar/FutureBasic/mayan-calendar.basic b/Task/Mayan-calendar/FutureBasic/mayan-calendar.basic new file mode 100644 index 0000000000..46e164ebff --- /dev/null +++ b/Task/Mayan-calendar/FutureBasic/mayan-calendar.basic @@ -0,0 +1,107 @@ +//================================================================= +// Convert Gregorian to real Julian Date (not JDE) +// on entry Gregorian M = month, D = day, Y = YYYY +// on exit Long JD = Julian Date +//================================================================= + +local fn Greg2Julian (M as Int, D as Int, Y as Int) as Long + Long JD + JD= D-32075+1461*(Y+4800+(M-14)/12)/4+367*(M-2-(M-14)/12*12)/12-3*((Y+4900+(M-14)/12)/100)/4 +End fn = JD + +//================================================================== +// Convert Gregorian to Mayan Calendar +// on entry Gregorian M = month, D = day, Y = YYYY +// On exit CFStringRef of Mayan calendar +//================================================================== +local fn Greg2Mayan (M as Int, D as Int, Y as Int) as CFStringRef + + CFStringRef tM(19),hM(18) //Tzolkin and Haad Months + CFStringRef result + Long longParts(5) + Double remainder + Double JulianDays //Julian Date + Double LCD(4) //long count days + Double correlation //Day of creation GTM + correlation = 584283 //Julian date of Monday 3114 B.C. September 6, @noon + CFStringRef longDate, roundDate, HaabDay, tmp + Long tzolkinMonth, tzolkinDay + Long haabMonth, haabDayNum + Long lordNumber // Lord of the Nights, nine Deity, God 1 through God 9 (G1 - G9) + Int i + + // Sacred Tzolk'in Months, 20 days + + tM(0) = @"Imix'": tM(1) = @"Ik'": tM(2) = @"Ak'bal": tM(3) = @"K'an" + tM(4) = @"Chikchan": tM(5) = @"Kimi": tM(6) = @"Manik'": tM(7) = @"Lamat" + tM(8) = @"Muluk": tM(9) = @"Ok": tM(10) = @"Chuwen": tM(11) = @"Eb" + tM(12) = @"Ben": tM(13) = @"Hix": tM(14) = @"Men": tM(15) = @"K'ib'" + tM(16) = @"Kaban": tM(17) = @"Etz'nab'": tM(18) = @"Kawak": tM(19) = @"Ajaw" + + // Civil Haab Months 20 days + + hM(0) = @"Pop": hM(1) = @"Wo'": hM(2) = @"Sip": hM(3) = @"Sotz'" + hM(4) = @"Sek": hM(5) = @"Xul": hM(6) = @"Yaxk'in": hM(7) = @"Mol" + hM(8) = @"Ch'en": hM(9) = @"Yax": hM(10) = @"Sak'": hM(11) = @"Keh" + hM(12) = @"Mak": hM(13) = @"K'ank'in": hM(14) = @"Muwan": hM(15) = @"Pax" + hM(16) = @"K'ayab": hM(17) = @"Kumk'u": hM(18) = @"Wayeb'" + + // Long count days + + LCD(0) = 144000: LCD(1) = 7200: LCD(2) = 360: LCD(3) = 20: LCD(4) = 1 + + JulianDays = fn Greg2Julian (M, D, Y) + remainder = JulianDays - correlation + For i = 0 To 4 + longParts(i) = Fix(remainder / LCD(i)) + remainder = remainder - (longParts(i) * LCD(i)) + Next i + + longDate = @"" + For i = 0 To 4 + If i > 0 Then longDate = concat (longDate,@".") + tmp = mid(str(longParts(i)),1) + if len(tmp) < 2 then tmp = concat(@"0",tmp) + longDate = concat(longDate, tmp) + Next i + + tzolkinMonth = fix((julianDays + 16) Mod 20) + tzolkinDay = fix(((julianDays + 5) Mod 13)) + 1 + + haabMonth = fix(((julianDays + 65) Mod 365) / 20) + haabDayNum = fix(((julianDays + 65) Mod 365) Mod 20) + + If haabDayNum = 0 + haabDay = @"Chum" + Else + haabDay = mid(Str(haabDayNum),1) + End If + + lordNumber = Fix((julianDays - correlation) Mod 9) + If lordNumber = 0 Then lordNumber = 9 + + roundDate = @"" + roundDate = concat(roundDate, @" ", mid(str(tzolkinDay),1), @"\t", tM(tzolkinMonth), @" ", haabDay, @" ", hM(haabMonth), @" G", mid(str(lordNumber),1)) + result = concat(longDate, @" ", roundDate) +end fn = result + +Window 1 + +CFStringRef mayanDate, GregDate +CFArrayRef comps +Int i,mm,dd,yy +CFStringRef testDate(7) +testDate(1) = @"2004-06-19": testDate(2) = @"2012-12-18": testDate(3) = @"2012-12-21": testDate(4) = @"2019-01-19" +testDate(5) = @"2019-03-27": testDate(6) = @"2020-02-29": testDate(7) = @"2020-03-01" + +for i = 1 to 7 + GregDate = testDate(i) + comps = fn StringComponentsSeparatedByString(GregDate, @"-" ) + dd = IntVal(comps[2]) + mm = IntVal(comps[1]) + yy = IntVal(comps[0]) + mayanDate = fn Greg2Mayan (mm,dd,yy) + print GregDate;" - ";mayanDate +next i + +handleEvents diff --git a/Task/Maze-generation/M2000-Interpreter/maze-generation-1.m2000 b/Task/Maze-generation/M2000-Interpreter/maze-generation-1.m2000 index f0fd0485e1..b73c42a4b5 100644 --- a/Task/Maze-generation/M2000-Interpreter/maze-generation-1.m2000 +++ b/Task/Maze-generation/M2000-Interpreter/maze-generation-1.m2000 @@ -1,56 +1,52 @@ -Module Maze { - width% = 40 - height% = 20 - \\ we can use DIM maze$(0 to width%,0 to height%)="#" - \\ so we can delete the two For loops - DIM maze$(0 to width%,0 to height%) - FOR x% = 0 TO width% - FOR y% = 0 TO height% - maze$(x%, y%) = "#" - NEXT y% - NEXT x% +MODULE Maze { + INTEGER W = 40, H = 20, X, Y, CX, CY, OX, OY, I + BOOLEAN DONE + DIM MAZE(0 TO W, 0 TO H) AS STRING + FOR X = 0 TO W + FOR Y = 0 TO H + MAZE(X, Y) = "#" + NEXT Y + NEXT X - currentx% = INT(RND * (width% - 1)) - currenty% = INT(RND * (height% - 1)) + CX = RND * (W - 1) + CY = RND * (H - 1) - IF currentx% MOD 2 = 0 THEN currentx%++ - IF currenty% MOD 2 = 0 THEN currenty%++ - maze$(currentx%, currenty%) = " " + IF CX MOD 2 = 0 THEN CX++ + IF CY MOD 2 = 0 THEN CY++ + MAZE(CX, CY) = " " - done% = 0 - WHILE done% = 0 { - FOR i% = 0 TO 99 - oldx% = currentx% - oldy% = currenty% - SELECT CASE INT(RND * 4) + WHILE NOT DONE + FOR I = 0 TO 99 + OX = CX + OY = CY + SELECT CASE RANDOM(0, 3) CASE 0 - IF currentx% + 2 < width% THEN currentx%+=2 + IF CX + 2 < W THEN CX+=2 CASE 1 - IF currenty% + 2 < height% THEN currenty%+=2 + IF CY + 2 < H THEN CY+=2 CASE 2 - IF currentx% - 2 > 0 THEN currentx%-=2 + IF CX - 2 > 0 THEN CX-=2 CASE 3 - IF currenty% - 2 > 0 THEN currenty%-=2 + IF CY - 2 > 0 THEN CY-=2 END SELECT - IF maze$(currentx%, currenty%) = "#" Then { - maze$(currentx%, currenty%) = " " - maze$(INT((currentx% + oldx%) / 2), ((currenty% + oldy%) / 2)) = " " - } - NEXT i% - done% = 1 - FOR x% = 1 TO width% - 1 STEP 2 - FOR y% = 1 TO height% - 1 STEP 2 - IF maze$(x%, y%) = "#" THEN done% = 0 - NEXT y% - NEXT x% - } + IF MAZE(CX, CY) = "#" THEN + MAZE(CX, CY) = " " + MAZE((CX + OX) DIV 2, (CY + OY) DIV 2) = " " + END IF + NEXT I + DONE = TRUE + FOR X = 1 TO W - 1 STEP 2 + FOR Y = 1 TO H - 1 STEP 2 + IF MAZE(X, Y) = "#" THEN DONE = FALSE + NEXT Y + NEXT X + END WHILE - - FOR y% = 0 TO height% - FOR x% = 0 TO width% - PRINT maze$(x%, y%); - NEXT x% + FOR Y = 0 TO H + FOR X = 0 TO W + PRINT MAZE(X, Y); + NEXT X PRINT - NEXT y% + NEXT Y } Maze diff --git a/Task/Maze-generation/M2000-Interpreter/maze-generation-2.m2000 b/Task/Maze-generation/M2000-Interpreter/maze-generation-2.m2000 index 9f5c8762a4..1e0759ec34 100644 --- a/Task/Maze-generation/M2000-Interpreter/maze-generation-2.m2000 +++ b/Task/Maze-generation/M2000-Interpreter/maze-generation-2.m2000 @@ -1,43 +1,67 @@ Module Maze2 { \\ depth-first search - Profiler + While Inkey$<>"" {} ' drop keys + Const View as boolean=True + Double tcc + Form 80,50 - let w=60, h=40 +again: + Gradient 5,6 + Cursor 0,0 + let w=random(2,6)*10, h=random(1,4)*10, slice=w*h div 30 + let slice=if(slice=0->1, slice) : counter =1 Double \\center proportional text double size Report 2, Format$("Maze {0}x{1}",w,h) Normal + Hold Refresh Set Fast ! - Dim maze$(1 to w+1, 1 to h+1)="#" - Include=Lambda w,h (a,b) ->a>=1 and a<=w and b>=1 and b<=h - Flush ' empty stack - if random(1,2)=1 then { - entry=(if(random(1,2)=1->2, w),Random(1, h/2)*2) - } else { - entry=(random(1,w/2)*2,If(Random(1,2)=1->2,h)) + stack new { + Profiler + Dim maze$(1 to w+1, 1 to h+1)="#" + Include=Lambda w,h (a,b) ->a>=1 and a<=w and b>=1 and b<=h + Flush ' empty stack + if random(1,2)=1 then + entry=(if(random(1,2)=1->2, w),Random(1, h/2)*2) + else + entry=(random(1,w/2)*2,If(Random(1,2)=1->2,h)) + end if + maze$(entry#val(0), entry#val(1))=" " + forchoose=(,) + Push Entry + do + do + NewForChoose(!entry) + status=len(forchoose) + if status>0 then + status-- + forchoose=forchoose#val(random(0,status)) + Push forchoose + OpenDoor(!Entry, !forchoose) + if view then counter=if(counter=0->slice, counter-1) : if counter=0 then ShowMaze() + else + exit + end if + entry=forchoose + Always + if empty then exit + Read entry + Always + tc= timecount/1000 } - maze$(entry#val(0), entry#val(1))=" " - forchoose=(,) - Push Entry - do { - do { - NewForChoose(!entry) - status=len(forchoose) - if status>0 then { - status-- - forchoose=forchoose#val(random(0,status)) - Push forchoose - OpenDoor(!Entry, !forchoose) - Rem : ShowMaze() - } else exit - entry=forchoose - } Always - if empty then exit - Read entry - } Always ShowMaze() - Print timecount/1000 + Cursor 0,Height-1 + Print Part $(6,width), ~(15,0,0),"Press a key or mouse button after any drawing of the maze to exit - "+format$("{0:3}",tc) + Refresh + counter=10 + every 200 { + counter-- + if inkey$<>"" or mouse<>0 then counter=-1 : exit + if counter<1 then exit + } + if counter=0 then Release : goto again + End Sub NewForChoose(x,y) Local x1=x-2, x2=x+2, y1=y-2, y2=y+2, arr=(,) Stack New { @@ -50,19 +74,21 @@ Module Maze2 { End Sub Sub OpenDoor(x1,y1, x2,y2) Local i - if x1=x2 then { + if x1=x2 then y1+=y2<=>y1 - for i=y1 to y2 {maze$(x1, i)=" " } - } Else { + for i=y1 to y2 step sgn(y2-y1) {maze$(x1, i)=" " } + Else x1+=x2<=>x1 - for i=x1 to x2 {maze$(i, y1)=" "} - } + for i=x1 to x2 step sgn(x2-x1) {maze$(i, y1)=" "} + End if End Sub Sub ShowMaze() Refresh 5000 - cls ,4 ' split screen - preserve lines form 0 to 3 - Local i, j - For j=1 to h+1 { Print @(10) : for i=1 to w+1 {Print maze$(i,j);}:Print} +Rem cls ,4 ' split screen - preserve lines form 0 to 3 + Release + cursor 0,(height-h) div 2 + Local i, j, t=40-w div 2 + For j=1 to h+1 { Print @(t) : for i=1 to w+1 {Print maze$(i,j);}:Print} Print Refresh 100 End Sub diff --git a/Task/Maze-generation/PascalABC.NET/maze-generation.pas b/Task/Maze-generation/PascalABC.NET/maze-generation.pas new file mode 100644 index 0000000000..5291470844 --- /dev/null +++ b/Task/Maze-generation/PascalABC.NET/maze-generation.pas @@ -0,0 +1,29 @@ +const + w = 14; + h = 10; + +var + vis := (0..h - 1).Select(x -> [false] * w).ToArray; + hor := (0..h).select(x -> ['+---'] * w + [string('+')]).ToArray; + ver := (0..h - 1).select(x -> ['| '] * w + [string('|')]).ToArray; + +procedure walk(x, y: integer); +begin + vis[y][x] := true; + foreach var p in ||x - 1, y|, |x, y + 1|, |x + 1, y|, |x, y - 1||.Shuffle do + begin + if (p[0] not in (0..w - 1)) or (p[1] not in (0..h - 1)) or vis[p[1]][p[0]] then continue; + if p[0] = x then hor[max(y, p[1])][x] := '+ '; + if p[1] = y then ver[y][max(x, p[0])] := ' '; + walk(p[0], p[1]); + end; +end; + +begin + walk(random(w), random(h)); + foreach var (a, b) in hor.zip(ver + [''], (x, y) -> (x, y)) do + begin + a.println(''); + b.println(''); + end; +end. diff --git a/Task/McNuggets-problem/ALGOL-W/mcnuggets-problem.alg b/Task/McNuggets-problem/ALGOL-W/mcnuggets-problem.alg new file mode 100644 index 0000000000..0db3731f01 --- /dev/null +++ b/Task/McNuggets-problem/ALGOL-W/mcnuggets-problem.alg @@ -0,0 +1,25 @@ +begin % Solve the McNuggets problem: find the largest n <= 100 for which there % + % are no non-negative integers x, y, z such that 6x + 9y + 20z = n % + integer maxNuggets; + maxNuggets := 100; + begin + logical array isSum ( 0 :: maxNuggets ); + integer largest; + % find the numbers that can be formed % + for x := 0 step 6 until maxNuggets do begin + for y := x step 9 until maxNuggets do begin + for z := y step 20 until maxNuggets do isSum( z ) := true + end for_y + end for_x ; + % show the highest number that cannot be formed % + largest := -1; + for i := maxNuggets step -1 until 0 do begin + if not isSum( i ) then begin + largest := i; + goto foundLargest + end if_not_isSum_i + end for_i; +foundLargest: + write( i_w := 1, s_w := 0, "The largest non-McNugget number is: ", largest ) + end +end. diff --git a/Task/McNuggets-problem/PascalABC.NET/mcnuggets-problem.pas b/Task/McNuggets-problem/PascalABC.NET/mcnuggets-problem.pas new file mode 100644 index 0000000000..649f9066ea --- /dev/null +++ b/Task/McNuggets-problem/PascalABC.NET/mcnuggets-problem.pas @@ -0,0 +1,6 @@ +## +var nuggets := [0..100]; +foreach var (x, y, z) in Cartesian(Range(0, 100 div 6), Range(0, 100 div 9), Range(0, 100 div 20)) do + Exclude(nuggets, 6 * x + 9 * y + 20 * z); + +nuggets.Max.println; diff --git a/Task/Median-filter/FreeBASIC/median-filter.basic b/Task/Median-filter/FreeBASIC/median-filter.basic new file mode 100644 index 0000000000..1e23743325 --- /dev/null +++ b/Task/Median-filter/FreeBASIC/median-filter.basic @@ -0,0 +1,64 @@ +' Set up dimensions +Const ancho = 400 +Const alto = 400 + +' Create arrays +Dim As Integer salida(ancho-1, alto-1) +Dim As Integer pix(24) +Dim As Integer x, y, p, i, j, col + +' Set up graphics +Screenres ancho, alto, 32 +Windowtitle "Median Filter" + +' Create image buffer +'Dim imagen As Any Ptr = Imagecreate(ancho, alto, Rgb(0,0,0)) +Dim imagen As Any Ptr = Imagecreate(ancho, alto) +' Load image +Bload "i:\plasma.bmp", imagen +Put (0, 0), imagen, Pset + +' Create buffer for filtered image +Dim imagenFiltrada As Any Ptr = Imagecreate(ancho, alto) + +' Median filtering +For y = 2 To alto-3 + For x = 2 To ancho-3 + p = 0 + For i = -2 To 2 + For j = -2 To 2 + ' Get pixel value from source image + pix(p) = Point(((x+i)), ((y+j))) And &hFF + p += 1 + Next j + Next i + + ' Sort the pixels (bubble sort) + For i = 0 To 23 + For j = 0 To 23-i + If pix(j) > pix(j+1) Then Swap pix(j), pix(j+1) + Next j + Next i + + ' Store median value + salida(x, y) = pix(12) + Next x +Next y + +' Display filtered result and store in buffer +For y = 0 To alto-1 + For x = 0 To ancho-1 + col = salida(x, y) + Pset(x, y), Rgb(col, col, col) + Pset imagenFiltrada, (x, y), Rgb(col, col, col) + Next x +Next y + +' Save filtered image +Bsave "i:\plasmamedian.bmp", imagenFiltrada + +' Free image memory +Imagedestroy imagen +Imagedestroy imagenFiltrada + +Sleep diff --git a/Task/Meissel-Mertens-constant/PascalABC.NET/meissel-mertens-constant.pas b/Task/Meissel-Mertens-constant/PascalABC.NET/meissel-mertens-constant.pas new file mode 100644 index 0000000000..7391f06912 --- /dev/null +++ b/Task/Meissel-Mertens-constant/PascalABC.NET/meissel-mertens-constant.pas @@ -0,0 +1,27 @@ +function gen_primes_upto(n: integer): sequence of integer; +begin + if n < 3 then exit; + var table := |True| * n; + var sqrtn := n.sqrt.Floor; + for var i := 2 to sqrtn do + if table[i] then + for var j := i * i to n - 1 step i do + table[j] := False; + + yield 2; + for var i := 3 to n step 2 do + if table[i] then yield i +end; + +begin + var γ := 0.57721566490153286; + var sum := 0.0; + foreach var p in gen_primes_upto(10_000_000_000) index i do + begin + var rp := 1 / p; + sum += ln(1 - rp) + rp; + // inc count + if (i+1) mod 10_000_000 = 0 then + writeln(i+1, sum + γ:20); + end; +end. diff --git a/Task/Memory-allocation/68000-Assembly/memory-allocation-1.68000 b/Task/Memory-allocation/68000-Assembly/memory-allocation-1.68000 index 4e3854c474..26705bfaec 100644 --- a/Task/Memory-allocation/68000-Assembly/memory-allocation-1.68000 +++ b/Task/Memory-allocation/68000-Assembly/memory-allocation-1.68000 @@ -1,5 +1,5 @@ MyFunction: -LINK A6,#-16 ;create a stack frame of 16 bytes. Now you can safely write to (SP+0) thru (SP+15). +LINK A6,#-16 ;create a stack frame of 16 bytes. Now you can safely write to anywhere from (SP+0) to (SP+15) inclusive. ;;;; your code goes here. diff --git a/Task/Menu/AArch64-Assembly/menu.aarch64 b/Task/Menu/AArch64-Assembly/menu.aarch64 index 790529acbc..acfe5994fc 100644 --- a/Task/Menu/AArch64-Assembly/menu.aarch64 +++ b/Task/Menu/AArch64-Assembly/menu.aarch64 @@ -23,7 +23,7 @@ szCarriageReturn: .asciz "\n" szMessFinOK: .asciz "Program normal end. \n" szMessError: .asciz "\nError Buffer too small!!!\n" -szChoose: .asciz "\nMake your choise: " +szChoose: .asciz "\nMake your choice: " szMessErrorNum: .asciz "Error : number do not exists!!\n" szMesschoose: .asciz "\nYou have chosen: " szLigne1: .asciz "fee fie" diff --git a/Task/Menu/ARM-Assembly/menu.arm b/Task/Menu/ARM-Assembly/menu.arm index c7571f5766..79834fbae1 100644 --- a/Task/Menu/ARM-Assembly/menu.arm +++ b/Task/Menu/ARM-Assembly/menu.arm @@ -28,7 +28,7 @@ szCarriageReturn: .asciz "\n" szMessFinOK: .asciz "Program normal end. \n" szMessError: .asciz "\nError Buffer too small!!!\n" -szChoose: .asciz "\nMake your choise: " +szChoose: .asciz "\nMake your choice: " szMessErrorNum: .asciz "Error : number do not exists!!\n" szMesschoose: .asciz "\nYou have chosen: " szLigne1: .asciz "fee fie" diff --git a/Task/Menu/Action-/menu.action b/Task/Menu/Action-/menu.action index 49a3b9c616..6ebf118abd 100644 --- a/Task/Menu/Action-/menu.action +++ b/Task/Menu/Action-/menu.action @@ -21,7 +21,7 @@ BYTE FUNC GetMenuItem(PTR ARRAY items BYTE count) DO ShowMenu(items,count) PutE() - Print("Make your choise: ") + Print("Make your choice: ") res=InputB() UNTIL res>=1 AND res<=count OD diff --git a/Task/Menu/Langur/menu.langur b/Task/Menu/Langur/menu.langur index 44a20d9a8e..fd8a49e707 100644 --- a/Task/Menu/Langur/menu.langur +++ b/Task/Menu/Langur/menu.langur @@ -1,18 +1,19 @@ -val choose = impure fn(entries) { +val choose = fn*(entries) { if entries is not list: throw "invalid args" if not entries: return "" # print the menu - writeln join("\n", map(fn e, i: "{{i:2}}: {{e}}", entries, 1..len(entries))) + writeln join(map(entries, 1..len(entries), by=fn e, i:"{{i:2}}: {{e}}"), by="\n") val idx = read( - "Select entry #: ", - fn(x) { + prompt="Select entry #: ", + validation=fn(x) { if not x -> RE/^[0-9]+$/: return false val y = x -> number y > 0 and y <= len(entries) }, - "invalid selection\n", -1, + errmsg="invalid selection\n", + maxattempts=-1, ) -> number entries[idx] diff --git a/Task/Menu/Quackery/menu.quackery b/Task/Menu/Quackery/menu.quackery new file mode 100644 index 0000000000..d43ff51b32 --- /dev/null +++ b/Task/Menu/Quackery/menu.quackery @@ -0,0 +1,17 @@ + [ swap dup [] = iff nip done + [ dup witheach + [ i^ 1+ echo say ") " + echo$ cr ] + over input + $->n not iff drop again + dup 1 < iff drop again + over size + over < iff drop again ] + rot drop 1 - peek ] is menu ( [ $ --> $ ) + + ' [ $ "fee fie" $ "huff and puff" + $ "mirror mirror" $ "tick tock" ] + [] swap witheach [ do nested join ] + + $ "What does a clock say? " menu + say "Your answer: " echo$ diff --git a/Task/Mertens-function/PascalABC.NET/mertens-function.pas b/Task/Mertens-function/PascalABC.NET/mertens-function.pas new file mode 100644 index 0000000000..0f6b50e7d3 --- /dev/null +++ b/Task/Mertens-function/PascalABC.NET/mertens-function.pas @@ -0,0 +1,21 @@ +function mertens(max: integer): list; +begin + result := (0..max).select( x -> 1).ToList; + foreach var n in 2..max do + foreach var k in 2..n do + result[n] -= result[n div k]; +end; + +begin + println('The first 99 Mertens numbers are:'); + foreach var m in mertens(99) index i do + if i = 0 then write(' ') + else write(m:3, if i mod 10 = 9 then #10 else ''); + + var zeroes := mertens(1000).Where(x -> x = 0).Count; + println('M(N) equals zero', zeroes, 'times.'); + + var crosses := mertens(1000).Zip(mertens(1000).Skip(1), (x, y) -> (x <> 0) and (y = 0)) + .Where(x -> x).Count; + println('M(N) crosses zero', crosses, 'times.'); +end. diff --git a/Task/Metallic-ratios/PascalABC.NET/metallic-ratios.pas b/Task/Metallic-ratios/PascalABC.NET/metallic-ratios.pas new file mode 100644 index 0000000000..e320bdb1ed --- /dev/null +++ b/Task/Metallic-ratios/PascalABC.NET/metallic-ratios.pas @@ -0,0 +1,63 @@ +type + Metal = (platinum, golden, silver, bronze, copper, nickel, aluminium, iron, tin, lead); + +function seq(b: integer): sequence of biginteger; +begin + // Yield the successive terms if a “Lucas” sequence. + // The first two terms are ignored. + var x := 1bi; + var y := 1bi; + while true do + begin + x += b * y; + Swap(x, y); + yield y; + end; +end; + +function plural(n: integer) := if n >= 2 then 's' else ''; + +procedure computeRatio(b: integer; digits: integer); +begin + // Compute the ratio for the given "n" with the required number of digits. + + var M := Power(10bi, digits); + + var niter := 0; // Number of iterations. + var prevN := 1bi; // Previous value of "n". + var ratio := M ; // Current value of ratio. + + foreach var n in seq(b) do + begin + inc(niter); + var nextRatio := n * M div prevN; + if nextRatio = ratio then break; + prevN := n; + ratio := nextRatio; + end; + + var str := ratio.ToString; + insert('.', str, 2); + Writeln('Value to ', digits, ' decimal places after ', niter, ' iteration', plural(niter), ': ',str); +end; + +begin + foreach var b in 0..9 do + begin + Writeln('“Lucas” sequence for ', Metal(b), ' ratio where b = ', b, ':'); + Write('First 15 elements: 1 1 '); + var count := 2; + foreach var n in seq(b) do + begin + Write(' ', n); + Inc(count); + if count = 15 then break + end; + println; + computeRatio(b, 32); + Println; + end; + + Println('Golden ratio where b = 1:'); + computeRatio(1, 256); +end. diff --git a/Task/Metered-concurrency/PascalABC.NET/metered-concurrency.pas b/Task/Metered-concurrency/PascalABC.NET/metered-concurrency.pas new file mode 100644 index 0000000000..28eea66021 --- /dev/null +++ b/Task/Metered-concurrency/PascalABC.NET/metered-concurrency.pas @@ -0,0 +1,20 @@ +uses System, System.Threading, System.Threading.Tasks; + +procedure Worker(arg: SemaphoreSlim; id: integer); +begin + var sem: SemaphoreSlim := arg; + sem.Wait(); + Writeln('Thread ', id, ' has a semaphore & is now working.'); + Thread.Sleep(2 * 1000); + Writeln('#', id, 'done.'); + sem.Release(); +end; + +begin + var semaphore := new SemaphoreSlim(Environment.ProcessorCount * 2, MaxInt); + + Writeln('You have ', Environment.ProcessorCount, ' processors availiabe'); + Writeln('This program will use ', semaphore.CurrentCount, ' semaphores.'); + + Parallel.For(0, Environment.ProcessorCount * 3, y -> Worker(semaphore, y)); +end. diff --git a/Task/Mian-Chowla-sequence/PascalABC.NET/mian-chowla-sequence.pas b/Task/Mian-Chowla-sequence/PascalABC.NET/mian-chowla-sequence.pas new file mode 100644 index 0000000000..6d9a76aa64 --- /dev/null +++ b/Task/Mian-Chowla-sequence/PascalABC.NET/mian-chowla-sequence.pas @@ -0,0 +1,29 @@ +function mian_chowla(): sequence of integer; +label 1; +begin + var mc := Lst(1); + yield 1; + var psums: set of integer := [2]; + var newsums: set of integer := []; + foreach var trial in 2.Step do + begin + foreach var n in (mc + [trial]) do + begin + var sum := n + trial; + if sum in psums then goto 1; + newsums.add(sum) + end; + psums += newsums; + mc.add(trial); + yield trial; + 1: newsums := []; + end; +end; + +begin + println('The first 30 terms of the Mian-Chowla sequence are:'); + mian_chowla.Take(30).Println; + println; + println('Terms 91 to 100 of the Mian-Chowla sequence are:'); + mian_chowla.Skip(90).Take(10).Println; +end. diff --git a/Task/Middle-three-digits/PascalABC.NET/middle-three-digits.pas b/Task/Middle-three-digits/PascalABC.NET/middle-three-digits.pas new file mode 100644 index 0000000000..4763087818 --- /dev/null +++ b/Task/Middle-three-digits/PascalABC.NET/middle-three-digits.pas @@ -0,0 +1,28 @@ +type + ErrOdd = class (Exception) end; + ErrLen = class (Exception) end; + +function middle_three_digits(i: integer): string; +begin + var s := abs(i).ToString; + if s.Length < 3 then raise new ErrLen; + if s.Length mod 2 = 0 then raise new ErrOdd; + var mid := s.Length div 2; + result := s[mid:mid + 3]; +end; + +begin + var passing := |123, 12345, 1234567, 987654321, 10001, -10001, -123, -100, 100, -12345|; + var failing := |1, 2, -1, -10, 2002, -2002, 0|; + + foreach var x in passing + failing do + try + var answer := middle_three_digits(x); + writeln(x:10, ' -> ', answer); + except + on ErrOdd do + writeln(x:10, ' -> must have an odd number of digits'); + on ErrLen do + writeln(x:10, ' -> must have 3 digits or more'); + end; +end. diff --git a/Task/Miller-Rabin-primality-test/M2000-Interpreter/miller-rabin-primality-test.m2000 b/Task/Miller-Rabin-primality-test/M2000-Interpreter/miller-rabin-primality-test.m2000 new file mode 100644 index 0000000000..8e7350d03b --- /dev/null +++ b/Task/Miller-Rabin-primality-test/M2000-Interpreter/miller-rabin-primality-test.m2000 @@ -0,0 +1,59 @@ +function isProbablyPrime(n as *BigInteger, k as long) { + boolean T=true, F=false + =F + Zero=BigInteger("0") + One=BigInteger("1") + Two=BigInteger("2") + Method n, "compare", Two as c1 + Method n, "modulus", Two as m2 + method m2,"compare", zero as C2 + if c1=0 or c2=0 then exit + with n, "toString" as ns$ + s=0 + Method n, "subtract", one as nn + d=nn + + with d, "tostring" as dstr$ + do + method d,"modulus", two as m2 + method m2,"compare", zero as C + if c else exit + s++ + method d, "divide", two as d + Always + z=len(ns$) + a=one + with a, "toString" as astr$ + x=a + =T + for i=1 to k { + do + zs="" + for j=1 to len(ns$) + zs+=chr$(47+random(1,10)) + next + a=bigInteger(zs) + method nn,"compare", a as C + method a,"compare", one as c1 + until c=1 and c1>-1 + method a, "modpow", d, n as x + method x,"compare", one as c1 + if c1 else continue + method x,"compare", nn as c1 + if c1 else continue + for r=1 to s { + method x, "modpow", two, n as x + method x,"compare", one as c1 + if c1 else =F : break + method x,"compare", nn as c1 + if c1 else exit + } + if c1 then =F: break + } +} +profiler +Print isProbablyPrime(BigInteger("5400349"), 5)=True +print timecount +profiler +a=BigInteger("5400349"): Method a, "isProbablyPrime", 5 as ret:Print ret +print timecount diff --git a/Task/Miller-Rabin-primality-test/PascalABC.NET/miller-rabin-primality-test.pas b/Task/Miller-Rabin-primality-test/PascalABC.NET/miller-rabin-primality-test.pas new file mode 100644 index 0000000000..5f8a56581b --- /dev/null +++ b/Task/Miller-Rabin-primality-test/PascalABC.NET/miller-rabin-primality-test.pas @@ -0,0 +1,57 @@ +uses System.Security.Cryptography; + +function IsProbablePrime(source: biginteger; certainty: integer): boolean; +begin + if (source = 2) or (source = 3) then + begin result := true; exit end; + + if (source < 2) or (source mod 2 = 0) then + begin result := false; exit end; + + var d := source - 1; + var s := 0; + + while d mod 2 = 0 do + begin + d := d div 2; + s += 1; + end; + + var rng := RandomNumberGenerator.Create(); + var bytes := new byte[source.ToByteArray.LongLength]; + var a: biginteger; + loop certainty do + begin + repeat + rng.GetBytes(bytes); + a := new BigInteger(bytes); + until (a >= 2) and (a < source - 2); + + var x := BigInteger.ModPow(a, d, source); + if (x = 1) or (x = source - 1) then continue; + + for var r := 1 to s - 1 do + begin + x := BigInteger.ModPow(x, 2, source); + if x = 1 then + begin result := false; exit end; + if x = source - 1 then break; + end; + + if x <> source - 1 then + begin result := false; exit end; + end; + + result := true; +end; + +begin + var data := |'4547337172376300111955330758342147474062293202868155909489', + '4547337172376300111955330758342147474062293202868155909393'|; + + foreach var candidate in data do + isprobableprime(candidate.tobiginteger, 10).Println; + + foreach var x in (900..1000) do + if isprobableprime(x, 10) then print(x); +end. diff --git a/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test-1.rexx b/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test-1.rexx deleted file mode 100644 index 0c977f54e7..0000000000 --- a/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test-1.rexx +++ /dev/null @@ -1,48 +0,0 @@ -/*REXX program puts the Miller─Rabin primality test through its paces. */ -parse arg limit times seed . /*obtain optional arguments from the CL*/ -if limit=='' | limit=="," then limit= 1000 /*Not specified? Then use the default.*/ -if times=='' | times=="," then times= 10 /* " " " " " " */ -if datatype(seed, 'W') then call random ,,seed /*If seed specified, use it for RANDOM.*/ -numeric digits max(200, 2*limit) /*we're dealing with some ginormous #s.*/ -tell= times<0 /*display primes only if times is neg.*/ -times= abs(times); w= length(times) /*use absolute value of TIMES; get len.*/ -call genP limit /*suspenders now, use a belt later ··· */ -@MR= 'Miller─Rabin primality test' /*define a character literal for SAY. */ -say "There are" # 'primes ≤' limit /*might as well display some stuff. */ -say /* [↓] (skipping unity); show sep line*/ - do a=2 to times; say copies('─', 89) /*(skipping unity) do range of TIMEs.*/ - p= 0 /*the counter of primes for this pass. */ - do z=1 for limit /*now, let's get busy and crank primes.*/ - if \M_Rt(z, a) then iterate /*Not prime? Then try another number.*/ - p= p + 1 /*well, we found another one, by gum! */ - if tell then say z 'is prime according to' @MR "with K="a - if !.z then iterate - say '[K='a"] " z "isn't prime !" /*oopsy─doopsy and/or whoopsy─daisy !*/ - end /*z*/ - say ' for 1──►'limit", K="right(a,w)',' @MR "found" p 'primes {out of' #"}." - end /*a*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -genP: parse arg high; @.=0; @.1=2; @.2=3; !.=@.; !.2=1; !.3=1; #=2 - do j=@.#+2 by 2 to high /*just examine odd integers from here. */ - do k=2 while k*k<=j; if j//@.k==0 then iterate j; end /*k*/ - #= # + 1; @.#= j; !.j= 1 /*bump prime counter; add prime to the */ - end /*j*/; return /*@. array; define a prime in !. array.*/ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -M_Rt: procedure; parse arg n,k; d= n-1; nL=d /*Miller─Rabin: A.K.A. Rabin─Miller.*/ - if n==2 then return 1 /*special case of (the) even prime. */ - if n<2 | n//2==0 then return 0 /*check for too low, or an even number.*/ - - do s=-1 while d//2==0; d= d % 2 /*keep halving until a zero remainder.*/ - end /*while*/ - - do k; ?= random(2, nL) /* [↓] perform the DO loop K times.*/ - x= ?**d // n /*X can get real gihugeic really fast.*/ - if x==1 | x==nL then iterate /*First or penultimate? Try another pow*/ - do s; x= x**2 // n /*compute new X ≡ X² modulus N. */ - if x==1 then return 0 /*if unity, it's definitely not prime.*/ - if x==nL then leave /*if N-1, then it could be prime. */ - end /*r*/ /* [↑] // is REXX's division remainder*/ - if x\==nL then return 0 /*nope, it ain't prime nohows, noway. */ - end /*k*/ /*maybe it's prime, maybe it ain't ··· */ - return 1 /*coulda/woulda/shoulda be prime; yup.*/ diff --git a/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test-2.rexx b/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test-2.rexx deleted file mode 100644 index 6d47c35bbb..0000000000 --- a/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test-2.rexx +++ /dev/null @@ -1,90 +0,0 @@ -include Settings - -say version; say 'Miller-Rabin primality test'; say -numeric digits 1000 -say '25 numbers of the form 2^n-1, mostly Mersenne primes' -say 'Up to about 25 digits deterministic, above probabilistic' -say -mm = '2 3 5 7 11 13 17 19 23 31 61 89 97 107 113 127 131 521 ', -|| '607 1279 2203 2281 2293 3217 3221' -do nn = 1 to 25 - a = Word(mm,nn); b = 2**a-1; l = Length(b) - call Time('r'); p = IsPrime(b); e = Time('e') - if l > 20 then - b = Left(b,10)'...'Right(b,10) - select - when p = 0 then - p = 'not' - when l < 26 then - p = 'for sure' - otherwise - p = 'probable' - end - say '2^'a'-1' '=' b '('l' digits) is' p 'prime' '('Format(e,,3) 'seconds)' -end -return - -IsPrime: -/* Is a number prime? */ -procedure expose glob. -arg x -/* Low primes also used as deterministic witnesses */ -w1 = ' 2 3 5 7 11 13 17 19 23 29 31 37 41 ' -/* Fast values */ -w = x -if Pos(' 'w' ',w1) > 0 then - return 1 -if x//2 = 0 then - return 0 -if x//3 = 0 then - return 0 -if Right(x,1) = 5 then - return 0 -/* Miller-Rabin primality test */ -numeric digits 2*Length(x) -d = x-1; e = d -/* Reduce n-1 by factors of 2 */ -do s = -1 while d//2 = 0 - d = d%2 -end -/* Thresholds deterministic witnesses */ -w2 = '2047 1373653 25326001 3215031751 2152302898747 3474749660383 341550071728321 ', -|| '0 3825123056546413051 0 0 318665857834031151167461 3317044064679887385961981 ' -w = Words(w2) -/* Up to 13 deterministic trials */ -if x < Word(w2,w) then do - do k = 1 to w - if x < Word(w2,k) then - leave - end -end -/* or 3 probabilistic trials */ -else do - w1 = ' ' - do k = 1 to 3 - r = Rand(2,e)/1; w1 = w1||r||' ' - end - k = k-1 -end -/* Algorithm using generated witnesses */ -do k = 1 to k - a = Word(w1,k); y = Powermod(a,d,x) - if y = 1 then - iterate - if y = e then - iterate - do s - y = (y*y)//x - if y = 1 then - return 0 - if y = e then - leave - end - if y <> e then - return 0 -end -return 1 - -include Functions -include Numbers -include Abend diff --git a/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test.rexx b/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test.rexx new file mode 100644 index 0000000000..30799c4f3d --- /dev/null +++ b/Task/Miller-Rabin-primality-test/REXX/miller-rabin-primality-test.rexx @@ -0,0 +1,29 @@ +include Settings + +say version; say 'Miller-Rabin primality test'; say +numeric digits 1000 +say '25 numbers of the form 2^n-1, mostly Mersenne primes' +say 'Up to about 25 digits deterministic, above probabilistic' +say +mm = '2 3 5 7 11 13 17 19 23 31 61 89 97 107 113 127 131 521 ', +|| '607 1279 2203 2281 2293 3217 3221' +do nn = 1 to 25 + a = Word(mm,nn); b = 2**a-1; l = Length(b) + call Time('r'); p = Prime(b); e = Time('e') + if l > 20 then + b = Left(b,10)'...'Right(b,10) + select + when p = 0 then + p = 'not' + when l < 26 then + p = 'for sure' + otherwise + p = 'probable' + end + say '2^'a'-1' '=' b '('l' digits) is' p 'prime' '('Format(e,,3) 'seconds)' +end +return + +include Functions +include Numbers +include Abend diff --git a/Task/Minesweeper-game/FutureBasic/minesweeper-game.basic b/Task/Minesweeper-game/FutureBasic/minesweeper-game.basic new file mode 100644 index 0000000000..9c9c3bce2f --- /dev/null +++ b/Task/Minesweeper-game/FutureBasic/minesweeper-game.basic @@ -0,0 +1,148 @@ +_sizeX = 6 // SET BOARD WIDTH HERE +_sizey = 4 // SET BOARD HEIGHT HERE +_minePct = 20 // SET MINES PERCENT HERE + +begin enum + _mine = 0x10 + _flag = 0x20 + //miss < _safe + _safe = 0x30 + _show = 0x40 + //nums < 0x50 + //mine = 0x50 + //miss < 0x60 + _boom = 0x80 + + _mines = _sizeX * _sizeY * _minePct / 100 + _quit = 1001 // NSAlertSecondButtonReturn + _cmdOpt = 1572864 // NSEventModifierFlagOption+NSEventModifierFlagCommand +end enum + +begin globals + uint8 flags, count, miss, board( _sizeX+1, _sizeY+1 ) + bool start = YES +end globals + +void local fn show + int x, y, cell + cls + text @"Helvetica",15,_zGray + print @"\t Click to Clear\r \U00002318-Click to flag" + text @"Menlo bold",14,,_zClear + for y = 20 to _sizeY * 20 step 20 : for x = 20 to _sizeX * 20 step 20 + cell = board( x/20, y/20 ) + rect fill (x, y+20, 19, 19),(cell & _show) ? _zGray : _zLightGray + select cell + case < _flag //ignore + case <= _safe : print %(x+6, y+17)@"\U0001F6A9" // 🚩︎ + case < _show+_mine : text,,(cell & 15) + print %(x+5, y+18) mid(@" 12345678", (cell & 15), 1)// num + case _show+_mine :rect fill (x,y+20,19,19),_zRed + print %(x-1, y+19)@"\U0001F4A3" // 💣 + case < _show+_safe : print %(x+1, y+19)@"\U0000274C" // ❌ + case _show+_boom : text ,24 + print %(x-5, y+10)@"\U0001F4A5" : text ,14 // 💥 + //case else : stop hex$(cell) + end select + next : next + text ,15,_zBlack,_zRed + printf %(20,_sizeY * 20 + 50)@" MINES: %d ",_mines - flags + text ,,,fn ColorClear +end fn + +void local fn newBoard // make edge cells inaccessible + fn blockfill(@board(0, 0), (_sizeX + 2) * (_sizey + 2), _show) + for int y = 1 to _sizeY : for int x = 1 to _sizeX + board(x, y) = 0 // set all clickable cells to 0 + next : next + count = _sizeX * _sizeY + flags = 0 : miss = 0 + fn show +end fn + +void local fn endGame + int x, y + for y = 1 to _sizeY : for x = 1 to _sizeX + select board(x, y) & _safe + case _safe : + case _mine : board(x, y) |= (miss) ? _show : _flag + case else : board(x, y) |= _show + end select + next : next + if !miss then flags = _mines + + fn show + + if miss + x = alert 1,,@"Yikes! Bad move!\nNew assignment, or R&R?",,@"New (again);R&R (quit)" + else + x = alert 1,,@"WHEW! SAFE!\nNew assignment, or R&R?",,@"New (again);R&R (quit)" + end if + if x == _quit then end + fn newBoard + start = YES +end fn + +void local fn click( x as int, y as int, cmd as bool ) + if (x < 1 || y < 1 || x > _sizeX || y > _sizeY) then exit fn + int c, r + if start + int m = _mines, xx, yy + start = NO + fn newBoard + while m + c = rnd(_sizeX) : r = rnd(_sizeY) + // REM NEXT LINE TO ALLOW MINE OR NUMBER UNDER FIRST CLICK + if abs( x-c ) < 2 & abs( y-r ) < 2 then continue //start on empty cell + if board(c,r) == _mine then continue + board(c,r) = _mine : m-- // place mine + for xx = c-1 to c+1 : for yy = r-1 to r+1 // mark proximity + if board(xx, yy) <> _mine then board(xx, yy)++ + next : next + wend + end if + + ^uint8 cell = @board(x, y) + select + case *cell & _show // ignore + case cmd + if *cell & _flag + flags-- : if *cell < _safe then miss-- + else + flags++ : if *cell < _mine then miss++ + end if + *cell ^^= _flag // toggle flag + case *cell & _mine : *cell = _boom // hit mine + miss ++ : fn endGame + case *cell < 9 : *cell |= _show : count-- // open cell + if *cell == _show // if no adjacent flags, + for c = x-1 to x+1 : for r = y-1 to y+1 // click adjacent cells + if board(c, r) < 9 then fn click(c, r, NO) + next : next + end if + end select +end fn + +void local fn MINESWEEPER + subclass window 1, @"Minesweeper", (0,0,_sizeX * 20 + 40, _sizeY * 20 + 80) + WindowMakeFirstResponder( 1, _WindowContentViewTag) + fn newBoard +end fn + +void local fn doDialog( evt as long ) + select evt + case _windowMouseUp + CGPoint pt = fn EventLocationInView( _WindowContentViewTag ) + bool cmd = sgn( fn EventModifierFlags & _cmdOpt ) + fn click( pt.x / 20, _sizeY -(pt.y / 20 ) +3, cmd ) + fn show //: NSLog(@"%d, %d, %d",flags, _mines, count ) + if flags == _mines || count == _mines then fn endgame + case _windowWillClose : end + end select + +end fn + +on dialog fn doDialog +fn MINESWEEPER + +handleevents diff --git a/Task/Minimum-multiple-of-m-where-digital-sum-equals-m/PascalABC.NET/minimum-multiple-of-m-where-digital-sum-equals-m.pas b/Task/Minimum-multiple-of-m-where-digital-sum-equals-m/PascalABC.NET/minimum-multiple-of-m-where-digital-sum-equals-m.pas new file mode 100644 index 0000000000..d60b5241bb --- /dev/null +++ b/Task/Minimum-multiple-of-m-where-digital-sum-equals-m/PascalABC.NET/minimum-multiple-of-m-where-digital-sum-equals-m.pas @@ -0,0 +1,16 @@ +function digitsum(n: integer) := n.ToString.Select(c -> c.ToDigit).Sum; + +function a131382(): sequence of integer; +begin + foreach var n in 1.step do + begin + var m := 1; + while digitsum(m * n) <> n do m += 1; + yield m; + end; +end; + +begin + foreach var n in a131382.take(70) index i do + write(n:9, if i mod 10 = 9 then #10 else ''); +end. diff --git a/Task/Modified-random-distribution/EasyLang/modified-random-distribution.easy b/Task/Modified-random-distribution/EasyLang/modified-random-distribution.easy new file mode 100644 index 0000000000..1e16044bef --- /dev/null +++ b/Task/Modified-random-distribution/EasyLang/modified-random-distribution.easy @@ -0,0 +1,32 @@ +func$ rep c$ n . + for i to n : r$ &= c$ + return r$ +. +func modifier x . + if x < 0.5 : return 2 * (0.5 - x) + return 2 * (x - 0.5) +. +func rand . + repeat + r1 = randomf + r2 = randomf + until r2 < modifier r1 + . + return r1 +. +n = 100000 +nbins = 20 +histsz = 200 +binsz = 1 / nbins +len bins[] nbins +arrbase bins[] 0 +# +for i to n + rn = rand + bn = floor (rn / binsz) + bins[bn] += 1 +. +numfmt 0 4 +for i range0 nbins + print bins[i] & " " & rep "*" (bins[i] / histsz) +. diff --git a/Task/Modified-random-distribution/M2000-Interpreter/modified-random-distribution.m2000 b/Task/Modified-random-distribution/M2000-Interpreter/modified-random-distribution.m2000 new file mode 100644 index 0000000000..1867306e6a --- /dev/null +++ b/Task/Modified-random-distribution/M2000-Interpreter/modified-random-distribution.m2000 @@ -0,0 +1,34 @@ +module Modified_random_distribution (f, m, bins){ + form 60, 32 + Cls 1, 0 + Report "Modified Random Distribution" + Cls 0, 1 + Cursor 0, 5 + T$="Range Istogram" + Print #f, T$ + Print T$ + double a[bins] + def modifier(x) = if(x < 0.5-> 1-2*x, 2*x -1) + for i=1 to m + while True: + random1 = rnd + random2 = rnd + if random2 < modifier(random1) then + answer = int(random1*bins) + a[answer]++ + exit + end if + end while + next + b=100 / bins + + for i=0 to bins-1 + L$=format$("{0:1:-4} - {1:1:-4} {2} {3}% ",i*b,(i+1)*b-.1, string$("*",a[i]/(m/bins)*20), round(a[i]/m*100,2)) + Print #f, L$ + Print L$ + next + } + // Ansi file / use for wide output for UTF16LE +Open "ModRandomDistr.txt" for output as #f +Modified_random_distribution f, 10000, 21 +close #f diff --git a/Task/Modified-random-distribution/PascalABC.NET/modified-random-distribution.pas b/Task/Modified-random-distribution/PascalABC.NET/modified-random-distribution.pas new file mode 100644 index 0000000000..b6242e5a36 --- /dev/null +++ b/Task/Modified-random-distribution/PascalABC.NET/modified-random-distribution.pas @@ -0,0 +1,21 @@ +function modifier(x: real) := if x < 0.5 then 2 * (0.5 - x) else 2 * (x - 0.5); + +function modrand(modifier: real-> real): sequence of real; +begin + repeat + var r := Random; + if Random < modifier(r) then yield r; + until false; +end; + +begin + var data := modrand(modifier).Take(100_000); + var bins := data.Select(x -> (20 * x).Floor) + .Sorted + .GroupBy(n -> n) + .Select(g -> g.Count); + + writeln('Bin Counts Histogram'); + foreach var counts in bins index i do + writeln(i / 20:2:2, counts:6, ': ', '■' * (counts div 125)); +end. diff --git a/Task/Modular-exponentiation/M2000-Interpreter/modular-exponentiation.m2000 b/Task/Modular-exponentiation/M2000-Interpreter/modular-exponentiation.m2000 new file mode 100644 index 0000000000..4ded66199d --- /dev/null +++ b/Task/Modular-exponentiation/M2000-Interpreter/modular-exponentiation.m2000 @@ -0,0 +1,15 @@ +function ToString(x as *BigInteger) { + with x,"toString" as ret + =ret +} +Function PowerTen(x as integer) { + a=Biginteger("10") + method a, "intPower", biginteger(str$(x,"")) as a + =a +} +a=bigInteger("2988348162058574136915891421498819466320163312926952423791023078876139") +b=biginteger("2351399303373464486466122544523690094744975233415544072992656881240319") +profiler + method a, "modpow", b, PowerTen(40) as result +print timecount +Print ToString(result) diff --git a/Task/Modular-exponentiation/PascalABC.NET/modular-exponentiation-1.pas b/Task/Modular-exponentiation/PascalABC.NET/modular-exponentiation-1.pas new file mode 100644 index 0000000000..2f85905dae --- /dev/null +++ b/Task/Modular-exponentiation/PascalABC.NET/modular-exponentiation-1.pas @@ -0,0 +1,5 @@ +## +var a := '2988348162058574136915891421498819466320163312926952423791023078876139'.ToBigInteger; +var b := '2351399303373464486466122544523690094744975233415544072992656881240319'.ToBigInteger; +var m := Power(10bi, 40); +Writeln(BigInteger.ModPow(a, b, m)); diff --git a/Task/Modular-exponentiation/PascalABC.NET/modular-exponentiation.pas b/Task/Modular-exponentiation/PascalABC.NET/modular-exponentiation-2.pas similarity index 100% rename from Task/Modular-exponentiation/PascalABC.NET/modular-exponentiation.pas rename to Task/Modular-exponentiation/PascalABC.NET/modular-exponentiation-2.pas diff --git a/Task/Modular-inverse/PascalABC.NET/modular-inverse.pas b/Task/Modular-inverse/PascalABC.NET/modular-inverse.pas new file mode 100644 index 0000000000..4f66c5bd88 --- /dev/null +++ b/Task/Modular-inverse/PascalABC.NET/modular-inverse.pas @@ -0,0 +1,18 @@ +function ModInverse(a, m: integer): integer; +begin + result := 1; + if m = 1 then exit; + var m0 := m; + var (x, y) := (1, 0); + while a > 1 do + begin + var q := a div m; + (a, m) := (m, a mod m); + (x, y) := (y, x - q * y); + end; + result := if x < 0 then x + m0 else x; +end; + +begin + ModInverse(42, 2017).Println; +end. diff --git a/Task/Monty-Hall-problem/PascalABC.NET/monty-hall-problem.pas b/Task/Monty-Hall-problem/PascalABC.NET/monty-hall-problem.pas new file mode 100644 index 0000000000..5f882e336d --- /dev/null +++ b/Task/Monty-Hall-problem/PascalABC.NET/monty-hall-problem.pas @@ -0,0 +1,37 @@ +function games(n: integer): (integer, integer); +begin + var stay := 0; + var switch := 0; + loop n do + begin + var lst := lst(1, 0, 0); // one car and two goats + lst.shuffle; // shuffles the list randomly + var ran := Random(3); // gets a random number for the random guess + var user := lst[ran]; // storing the random guess + lst.RemoveAt(ran); // deleting the random guess + + var huh := 0; + foreach var i in lst do + begin // getting a value 0 and deleting it + if i = 0 then + begin + lst.RemoveAt(huh); // deletes a goat when it finds it + break + end; + huh += 1; + end; + + if user = 1 then // if the original choice is 1 then stay adds 1 + stay += 1; + + if lst[0] = 1 then // if the switched value is 1 then switch adds 1 + switch += 1; + end; + result := (stay, switch); +end; + +begin + var (stay, switch) := games(1000); + println('Stay = ', stay); + println('Switch = ', switch); +end. diff --git a/Task/Morse-code/M2000-Interpreter/morse-code.m2000 b/Task/Morse-code/M2000-Interpreter/morse-code.m2000 new file mode 100644 index 0000000000..81a8c04401 --- /dev/null +++ b/Task/Morse-code/M2000-Interpreter/morse-code.m2000 @@ -0,0 +1,58 @@ +Module Morse_code { + declare Json JsonObject + json$={{ + "!": "---.", "\"": ".-..-.", "$": "...-..-", "'": ".----.", + "(": "-.--.", ")": "-.--.-", "+": ".-.-.", ",": "--..--", + "-": "-....-", ".": ".-.-.-", "/": "-..-.", + "0": "-----", "1": ".----", "2": "..---", "3": "...--", + "4": "....-", "5": ".....", "6": "-....", "7": "--...", + "8": "---..", "9": "----.", + ":": "---...", ";": "-.-.-.", "=": "-...-", "?": "..--..", + "@": ".--.-.", + "A": ".-", "B": "-...", "C": "-.-.", "D": "-..", + "E": ".", "F": "..-.", "G": "--.", "H": "....", + "I": "..", "J": ".---", "K": "-.-", "L": ".-..", + "M": "--", "N": "-.", "O": "---", "P": ".--.", + "Q": "--.-", "R": ".-.", "S": "...", "T": "-", + "U": "..-", "V": "...-", "W": ".--", "X": "-..-", + "Y": "-.--", "Z": "--..", + "[": "-.--.", "]": "-.--.-", "_": "..--.-", + }} + e = 50 ' Element time in ms. one dit is on for e then off for e + f = 1280 ' Tone freq. in hertz + chargap = 1*e ' Time between characters of a word + wordgap = 7*e ' Time between words + + method json, "parser", json$ as json + with json, "itempath" as json.path$() + + + Input "Send Message:";a$ + a$=trim$(a$) + if len(a$)=0 then exit + a$=ucase$(a$) + + for i=1 to len(a$) + L$=mid$(a$, i, 1) + Print L$; + Send(json.path$(L$)) + next + + sub Send(a$) + if len(a$)=0 then wait wordgap : exit sub + local i + for i=1 to len(a$) + select case mid$(a$, i, 1) + case "." + tone e, f + case "-" + tone 3*e, f + case else + tone 3*e, f mod 2 + end select + wait chargap + next + end sub +} +Keyboard "This is Morse_code", 13 +Morse_code diff --git a/Task/Morse-code/PascalABC.NET/morse-code.pas b/Task/Morse-code/PascalABC.NET/morse-code.pas new file mode 100644 index 0000000000..f1718d8cd5 --- /dev/null +++ b/Task/Morse-code/PascalABC.NET/morse-code.pas @@ -0,0 +1,27 @@ +const + Morse = dict(('A', '.-'), ('B', '-...'), ('C', '-.-.'), ('D', '-..'), ('E', string('.')), + ('F', '..-.'), ('G', '--.'), ('H', '....'), ('I', '..'), ('J', '.---'), + ('K', '-.-'), ('L', '.-..'), ('M', '--'), ('N', '-.'), ('O', '---'), + ('P', '.--.'), ('Q', '--.-'), ('R', '.-.'), ('S', '...'), ('T', string('-')), + ('U', '..-'), ('V', '...-'), ('W', '.--'), ('X', '-..-'), ('Y', '-.--'), + ('Z', '--..'), ('0', '-----'), ('1', '.----'), ('2', '..---'), ('3', '...--'), + ('4', '....-'), ('5', '.....'), ('6', '-....'), ('7', '--...'), ('8', '---..'), + ('9', '----.'), ('.', '.-.-.-'), (',', '--..--'), ('?', '..--..'), ('\', '.----.'), + ('!', '-.-.--'), ('/', '-..-.'), ('(', '-.--.'), (')', '-.--.-'), ('&', '.-...'), + (':', '---...'), (';', '-.-.-.'), ('=', '-...-'), ('+', '.-.-.'), ('-', '-....-'), + ('_', '..--.-'), ('''', '.-..-.'), ('$', '...-..-'), ('@', '.--.-.')); + +procedure SayMorse(s: string); +begin + foreach var c in s do + begin + foreach var c2 in Morse.get(c.ToUpper, '') do + if c2 = '.' then console.Beep(1000, 250) + else console.Beep(1000, 750); + sleep(1000); + end; +end; + +begin + SayMorse('SOS'); +end. diff --git a/Task/Motzkin-numbers/EMal/motzkin-numbers.emal b/Task/Motzkin-numbers/EMal/motzkin-numbers.emal index 93f3d08a50..416df0338f 100644 --- a/Task/Motzkin-numbers/EMal/motzkin-numbers.emal +++ b/Task/Motzkin-numbers/EMal/motzkin-numbers.emal @@ -1,6 +1,6 @@ fun isPrime = logic by int n if n <= 1 do return false end - for int i = 2; i <= int!sqrt(n); ++i + for int i = 2; i <= int!√n; ++i if n % i == 0 do return false end end return true diff --git a/Task/Motzkin-numbers/PascalABC.NET/motzkin-numbers.pas b/Task/Motzkin-numbers/PascalABC.NET/motzkin-numbers.pas new file mode 100644 index 0000000000..3d630274f4 --- /dev/null +++ b/Task/Motzkin-numbers/PascalABC.NET/motzkin-numbers.pas @@ -0,0 +1,31 @@ +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 mot(): sequence of biginteger; +begin + var (a, b, n) := (0bi, 1bi, 1bi); + repeat + yield b div n; + n += 1; + (a, b) := (b, (3 * (n - 1) * n * a + (2 * n - 1) * n * b) div ((n + 1) * (n - 1))) + until false; +end; + +begin + foreach var val in mot.Take(42) index i do + writeln(i:2, val:20, if isprime(int64(val)) then ' is prime' else ''); +end. diff --git a/Task/Mouse-position/Nim/mouse-position.nim b/Task/Mouse-position/Nim/mouse-position.nim index 1957662497..4e78571df3 100644 --- a/Task/Mouse-position/Nim/mouse-position.nim +++ b/Task/Mouse-position/Nim/mouse-position.nim @@ -1,27 +1,25 @@ -import gintro/[glib, gobject, gtk, gio] -import gintro/gdk except Window +import gtk2, glib2 +import gdk2 except PWindow -#--------------------------------------------------------------------------------------------------- -proc onButtonPress(window: ApplicationWindow; event: Event; data: pointer): bool = - echo event.getCoords() - result = true +proc onButtonPress(window: pointer; event: PEventButton; data: pointer): gboolean {.cdecl.} = + echo event.x, " ", event.y + result = false -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +proc onDestroyEvent(widget: PWidget; data: pointer): gboolean {.cdecl.} = + ## Quit the application. + mainQuit() - let window = app.newApplicationWindow() - window.setTitle("Mouse position") - window.setSizeRequest(640, 480) - discard window.connect("button-press-event", onButtonPress, pointer(nil)) +nimInit() - window.showAll() +let window = windowNew(WINDOW_TOPLEVEL) +window.setTitle("Mouse position") +window.setSizeRequest(640, 480) +window.setEvents(BUTTON_PRESS_MASK) +discard window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) +discard window.signalConnect("button-press-event", SIGNAL_FUNC(onButtonPress), nil) +window.showAll() -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.MousePosition") -discard app.connect("activate", activate) -discard app.run() +main() diff --git a/Task/Move-to-front-algorithm/PascalABC.NET/move-to-front-algorithm.pas b/Task/Move-to-front-algorithm/PascalABC.NET/move-to-front-algorithm.pas new file mode 100644 index 0000000000..bdc7f3445e --- /dev/null +++ b/Task/Move-to-front-algorithm/PascalABC.NET/move-to-front-algorithm.pas @@ -0,0 +1,37 @@ +const + SymbolTable = Lst('a'..'z'); + +function encode(s: string): list; +begin + result := new List; + var symtable := SymbolTable; + foreach var c in s do + begin + var idx := symtable.IndexOf(c); + result.add(idx); + symtable.RemoveAt(idx); + symtable.Insert(0, c); + end; +end; + +function decode(s: list): string; +begin + var symtable := SymbolTable; + foreach var idx in s do + begin + var c := symtable[idx]; + result += c; + symtable.RemoveAt(idx); + symtable.Insert(0, c); + end; +end; + +begin + foreach var word in ['broood', 'babanaaa', 'hiphophiphop'] do + begin + var encoded := encode(word); + var decoded := decode(encoded); + var status := if decoded = word then 'correctly' else 'incorrectly'; + println(word, 'encodes to', encoded, 'which', status, 'decodes to', decoded); + end; +end. diff --git a/Task/Multi-base-primes/Python/multi-base-primes.py b/Task/Multi-base-primes/Python/multi-base-primes.py new file mode 100644 index 0000000000..37fcfcfa1c --- /dev/null +++ b/Task/Multi-base-primes/Python/multi-base-primes.py @@ -0,0 +1,78 @@ +import timeit +from collections import deque + +from sympy import isprime + + +def digits(num: int): + digits = deque() + + while num > 0: + digits.appendleft(num % 10) + num //= 10 + + return digits + + +def all_digits_are_less(dig: list[int], b: int): + for d in dig: + if d >= b: + return False + + return True + + +def eval_poly(coeffs: list[int], x: int): + y = 0 + + for pv in coeffs: + y = y * x + pv + + return y + + +def max_prime_bases(ndig: int, maxbase: int): + maxprimebases = [[]] + nwithbases = [0] + maxprime = 10 ** (ndig) - 1 + + for p in range(int((maxprime + 1) / 10), maxprime + 1): + dig = digits(p) + bases = [ + b + for b in range(2, maxbase + 1) + if isprime(eval_poly(dig, b)) and all_digits_are_less(dig, b) + ] + + if len(bases) > len(maxprimebases[0]): + maxprimebases = [bases] + nwithbases = [p] + + elif len(bases) == len(maxprimebases[0]): + maxprimebases.append(bases) + nwithbases.append(p) + + alen, vlen = len(maxprimebases[0]), len(maxprimebases) + + print( + "\nThe maximum number of prime valued bases for base 10 numeric strings of length", + ndig, + "is", + f"{alen}.", + "The base 10 value list of", + "these" if vlen > 1 else "this", + "is: ", + ) + + for i in range(len(maxprimebases)): + print(nwithbases[i], "=>", maxprimebases[i]) + + +def main(): + for n in range(1, 7): + max_prime_bases(n, 36) + + +if __name__ == "__main__": + execution_time = timeit.timeit(main, number=1) + print(f"Execution time: {execution_time:.6f} seconds") diff --git a/Task/Multi-dimensional-array/C/multi-dimensional-array-1.c b/Task/Multi-dimensional-array/C/multi-dimensional-array-1.c deleted file mode 100644 index 7fcedea181..0000000000 --- a/Task/Multi-dimensional-array/C/multi-dimensional-array-1.c +++ /dev/null @@ -1,37 +0,0 @@ -/*Single dimensional array of integers*/ -int a[10]; - -/*2-dimensional array, also called matrix of floating point numbers. -This matrix has 3 rows and 2 columns.*/ - -float b[3][2]; - -/*3-dimensional array ( Cube ? Cuboid ? Lattice ?) of characters*/ - -char c[4][5][6]; - -/*4-dimensional array (Hypercube ?) of doubles*/ - -double d[6][7][8][9]; - -/*Note that the right most number in the [] is required, all the others may be omitted. -Thus this is ok : */ - -int e[][3]; - -/*But this is not*/ - -float f[5][4][]; - -/*But why bother with all those numbers ? You can also write :*/ -int *g; - -/*And for a matrix*/ -float **h; - -/*or if you want to show off*/ -double **i[]; - -/*you get the idea*/ - -char **j[][5]; diff --git a/Task/Multi-dimensional-array/C/multi-dimensional-array-2.c b/Task/Multi-dimensional-array/C/multi-dimensional-array-2.c deleted file mode 100644 index f1ea68cb31..0000000000 --- a/Task/Multi-dimensional-array/C/multi-dimensional-array-2.c +++ /dev/null @@ -1,27 +0,0 @@ -#include - -int main() -{ - int hyperCube[5][4][3][2]; - - /*An element is set*/ - - hyperCube[4][3][2][1] = 1; - - /*IMPORTANT : C ( and hence C++ and Java and everyone of the family ) arrays are zero based. - The above element is thus actually the last element of the hypercube.*/ - - /*Now we print out that element*/ - - printf("\n%d",hyperCube[4][3][2][1]); - - /*But that's not the only way to get at that element*/ - printf("\n%d",*(*(*(*(hyperCube + 4) + 3) + 2) + 1)); - - /*Yes, I know, it's beautiful*/ - *(*(*(*(hyperCube+3)+2)+1)) = 3; - - printf("\n%d",hyperCube[3][2][1][0]); - - return 0; -} diff --git a/Task/Multi-dimensional-array/C/multi-dimensional-array-3.c b/Task/Multi-dimensional-array/C/multi-dimensional-array-3.c deleted file mode 100644 index 8f3043efee..0000000000 --- a/Task/Multi-dimensional-array/C/multi-dimensional-array-3.c +++ /dev/null @@ -1,66 +0,0 @@ -#include -#include - -/*The stdlib header file is required for the malloc and free functions*/ - -int main() -{ - /*Declaring a four fold integer pointer, also called - a pointer to a pointer to a pointer to an integer pointer*/ - - int**** hyperCube, i,j,k; - - /*We will need i,j,k for the memory allocation*/ - - /*First the five lines*/ - - hyperCube = (int****)malloc(5*sizeof(int***)); - - /*Now the four planes*/ - - for(i=0;i<5;i++){ - hyperCube[i] = (int***)malloc(4*sizeof(int**)); - - /*Now the 3 cubes*/ - - for(j=0;j<4;j++){ - hyperCube[i][j] = (int**)malloc(3*sizeof(int*)); - - /*Now the 2 hypercubes (?)*/ - - for(k=0;k<3;k++){ - hyperCube[i][j][k] = (int*)malloc(2*sizeof(int)); - } - } - } - - /*All that looping and function calls may seem futile now, - but imagine real applications when the dimensions of the dataset are - not known beforehand*/ - - /*Yes, I just copied the rest from the first program*/ - - hyperCube[4][3][2][1] = 1; - - /*IMPORTANT : C ( and hence C++ and Java and everyone of the family ) arrays are zero based. - The above element is thus actually the last element of the hypercube.*/ - - /*Now we print out that element*/ - - printf("\n%d",hyperCube[4][3][2][1]); - - /*But that's not the only way to get at that element*/ - printf("\n%d",*(*(*(*(hyperCube + 4) + 3) + 2) + 1)); - - /*Yes, I know, it's beautiful*/ - *(*(*(*(hyperCube+3)+2)+1)) = 3; - - printf("\n%d",hyperCube[3][2][1][0]); - - /*Always nice to clean up after you, yes memory is cheap, but C is 45+ years old, - and anyways, imagine you are dealing with terabytes of data, or more...*/ - - free(hyperCube); - - return 0; -} diff --git a/Task/Multi-dimensional-array/C/multi-dimensional-array.c b/Task/Multi-dimensional-array/C/multi-dimensional-array.c new file mode 100644 index 0000000000..3b8edae5f7 --- /dev/null +++ b/Task/Multi-dimensional-array/C/multi-dimensional-array.c @@ -0,0 +1,31 @@ +/* an array of ten ints */ +int a[10]; + +/* a 2D-array of floats with three rows and two columns */ +float b[3][2]; +/* + these would be ordered in memory as + b[0][0] b[0][1] b[1][0] b[1][1] b[2][0] b[2][1] + + for example: +*/ +b[0][0] = 1.0; +b[0][1] = 2.0; +b[1][0] = 3.0; +b[1][1] = 4.0; +b[2][0] = 5.0; +b[2][1] = 6.0; +/* +now these would be stored in memory as: + ++----+----+----+----+----+----+ +| 1.0| 2.0| 3.0| 4.0| 5.0| 6.0| ++----+----+----+----+----+----+ + +*/ + + +/* a 3D-array of chars */ +char c[4][5][6]; + +/* etc. */ diff --git a/Task/Multi-dimensional-array/M2000-Interpreter/multi-dimensional-array.m2000 b/Task/Multi-dimensional-array/M2000-Interpreter/multi-dimensional-array.m2000 new file mode 100644 index 0000000000..ba3688a140 --- /dev/null +++ b/Task/Multi-dimensional-array/M2000-Interpreter/multi-dimensional-array.m2000 @@ -0,0 +1,100 @@ +// supports multi-dimensional arrays +// support row-major and column major order - we can use both on different arrays. +// this is variant type +Dim A(0 to 4, 0 to 3, 1 to 2, -1 to 1) = 1 +A(0,0,1,-1)++ +Print A(0,0,1,-1)=2 +// Arrays are values also +// here we pass a tuple (one dimension array 9 based) +A(4,3,2,1)=(1,2,3,4,5) +Print A(4,3,2,1)(2)=3 +Dim Z(10) +Z(3)=A() +Print Z(3)(4,3,2,1)(2)=3 + +// We can define type: BigInteger, Complex, Decimal, Currency, Double, Single, Long Long, Long, Byte, Date, Boolean, Object +Dim B(0 to 4, 0 to 3, 1 to 2, -1 to 1) as byte = 255 +B(0,0,1,-1)-- +Print B(0,0,1,-1)=254 +// redim - by default is row-major +Dim B(0 to 5, 0 to 3, 1 to 2, -1 to 1) +Print B(0,0,1,-1)=254 +// OLE type are column major +Dim OLE B(0 to 4, 0 to 3, 1 to 2, -1 to 1) as byte = 255 +B(0,0,1,-1)-- +// redim the last dimension only +Dim B(0 to 4, 0 to 3, 1 to 2, -1 to 5) +Print B(0,0,1,-1)=254 +B(4,3,2,5)=253 +Print Dimension(B())=4, Dimension(B(),4,1)=5 +Print B()#pos(253)=279 ' Zero position (trait like one dimension) +// we can redim free, but the items change positions.. +k=len(B()) +' one dimension +DIM B(K) +Print B(279)=253, type$(B(279))="Byte" +// we can get the actual address +Print Varptr(B(279))-Varptr(B(278))=1 +// another type of arrays +// there is no dim, we set index and we get resize +Byte z[10]=255 +d=lambda->{ + object d[number] + = d +} +object P[2]=d(0) +p[2]=d(10) +p[1]=d(3) +P[2][1]=z // we get the pointer +P[2][2]=z[] // we get the copy +P[1][1]=z // we get the pointer +P[1][2]=z[] // we get the copy +p[2][2][2]-=10 +? p[2][2][2]=245 +? p[1][2][2]=255 +DEF TypeVal(x)=type$(x) +// these are the Seven arrays (two of them are z): +Print len(p[0])=1, type$(p, 0)="RefArray" +Print len(p[1])=4, type$(p, 1)="RefArray" +Print len(p[2])=11, type$(p, 2)="RefArray" +Print TypeVal(p[1][1])="RefArray" +Print p[1][1] is z +Print TypeVal(p[1][2])="RefArray" +Print len(p[1][2])=11, TypeVal(p[1][2][0])="Byte" +Print TypeVal(p[2][1])="RefArray" +Print p[2][1] is z +Print p[1][1] is p[2][1] +Print TypeVal(p[2][2])="RefArray" +Print not p[1][1] is p[2][2] +z[6]-=100 +Print p[1][1][6]=z[6], p[2][1][6]=z[6] +Print len(p[2][2])=11, TypeVal(p[2][2][0])="Byte" +byte k[0] +// shallow copy +k=p[] +Print k[2][1] is z +// copy +k[2][1]=k[2][] +// so now array at k[2][1] is a copy, different pointer from z +Print not k[2][1] is z + +// Sparse Matrix using a list (has a hash table) +g=list:= 1:=100, 10:=300, 500:=40 +if exist(g, 10) then print eval(g)=300 +Print g(1)=100, g(10)=300, g(500)=40 +Print valid(g(20)) = false +Print valid(g(10)) = true +Append g, 400:=1000 +// this is a quicksort +Sort ascending g as number +// Sparse Matrix using a Queue (a list taking same keys) +t=queue:=2,3,4,4,5,10:="A",10:="C",10:="B", 3 +// this is a stable sort +sort t as number +// Access same keys using the hash table +if exist(t, 10) then +many=exist(t, 10, 0) +for i=1 to many + if exist(t, 10, i) then print eval$(t), eval(t!) ' value and position +next +end if diff --git a/Task/Multifactorial/PascalABC.NET/multifactorial.pas b/Task/Multifactorial/PascalABC.NET/multifactorial.pas new file mode 100644 index 0000000000..7592c4e50a --- /dev/null +++ b/Task/Multifactorial/PascalABC.NET/multifactorial.pas @@ -0,0 +1,11 @@ +## +function mfac(n, m: integer) := range(n, 1, -m).aggregate(1, (p, x) -> p * x); + +function mfac2(n, m: integer): integer := if n <= (m + 1) then n else n * mfac2(n - m, m); + +foreach var m in (1..5) do +begin + write(#10, m, ': '); + foreach var n in (1..10) do + mfac2(n, m).Print; +end; diff --git a/Task/Multiple-regression/M2000-Interpreter/multiple-regression.m2000 b/Task/Multiple-regression/M2000-Interpreter/multiple-regression.m2000 new file mode 100644 index 0000000000..2f3759c549 --- /dev/null +++ b/Task/Multiple-regression/M2000-Interpreter/multiple-regression.m2000 @@ -0,0 +1,67 @@ +Module Task_Multiple_regression{ + Function Multiple_regression(X(), Y()){ + Form 14*5, 32 + Print $(0, 14) + integer M=2, Q=3, n=len(x())-1 + Dim s(0 to 2*M), t(0 to 2*M) + For k = 0 To 2*M + S(k) = 0 : T(k) = 0 + For i = 0 To N + S(k) += X(i) ^ k + If k <= M Then T(k) += Y(i) * X(i) ^ k + Next i + Next k + dim a(0 to M, 0 to Q) + For r = 0 To M + For c = 0 To M + A(r, c) = S(r+c) + Next c + A(r, c) = T(r) + Next r + Print "Linear system coefficents:" + Print $("0.0") + For i = 0 To M + For j = 0 To M+1 + Print A(i,j), + Next j + Print + Next i + Print $(0) + For j = 0 To M + For i = j To M + If A(i,j) <> 0 Then Exit For + Next i + If i = M+1 Then + Print "SINGULAR MATRIX" + break + End If + For k = 0 To M+1 + Swap A(j,k), A(i,k) + Next k + z = 1 / A(j,j) + For k = 0 To M+1 + A(j,k) = z * A(j,k) + Next k + For i = 0 To M + If i <> j Then + z = -A(i,j) + For k = 0 To M+1 + A(i,k) += z * A(j,k) + Next k + End If + Next i + Next j + Flush + For i = 0 To M + data A(i,M+1) + Next i + =array([]) + } + Dim Solution() + DataX=(1.47,1.50,1.52,1.55,1.57, 1.60,1.63,1.65,1.68, 1.70,1.73,1.75,1.78,1.80,1.83) + DataY=(52.21,53.12,54.48,55.84,57.20,58.57,59.93,61.29,63.11,64.47, 66.28,68.10,69.92,72.19,74.46) + Solution()=Multiple_regression(DataX, DataY) + Print "Solutions:" + Print $("0.0000000"), Solution() +} +Task_Multiple_regression diff --git a/Task/Multiple-regression/PascalABC.NET/multiple-regression.pas b/Task/Multiple-regression/PascalABC.NET/multiple-regression.pas new file mode 100644 index 0000000000..a1fac0343c --- /dev/null +++ b/Task/Multiple-regression/PascalABC.NET/multiple-regression.pas @@ -0,0 +1,26 @@ +uses NumLibABC; + +function multipleRegression(y, x: Matrix): Matrix; +begin + var cy := y.Transpose; + var cx := x.Transpose; + result := ((x * cx).Inv * x * cy).Transpose; +end; + +begin + var y := new Matrix(1, 5, 1, 2, 3, 4, 5); + var x := new Matrix(1, 5, 2, 1, 3, 4, 5); + multipleRegression(y, x).println(18, 15); + + y := new Matrix(1, 3, 3, 4, 5); + x := new Matrix(2, 3, 1, 2, 1, 1, 1, 2); + multipleRegression(y, x).Println(4, 1); + + y := new Matrix(1, 15, 52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29, + 63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46); + var a := |1.47, 1.5, 1.52, 1.55, 1.57, 1.6, 1.63, 1.65, 1.68, 1.7, 1.73, 1.75, 1.78, 1.8, 1.83|; + var aa := a.Select(x -> x.Sqr).ToArray; + var c := |1.0| * a.Length + a + aa; + x := new Matrix(3, a.Length, c); + multipleRegression(y, x).Println(18, 12); +end. diff --git a/Task/Multiplicative-order/FreeBASIC/multiplicative-order.basic b/Task/Multiplicative-order/FreeBASIC/multiplicative-order.basic new file mode 100644 index 0000000000..5b66e8738d --- /dev/null +++ b/Task/Multiplicative-order/FreeBASIC/multiplicative-order.basic @@ -0,0 +1,177 @@ +#include "windows.bi" + +Type prime_factor + p As Ulong + e As Ulong +End Type + +' Arrays and their counters +Dim Shared primes(1 Shl 15) As Ulong +Dim Shared primeCount As Integer = 0 + +Function get_prime_factors(n As Ulong, factors() As prime_factor) As Integer + Static As Ulong e, p, i + Dim factorCount As Integer = 0 + + ' Handle even numbers specially + If (n And 1) = 0 Then + e = 0 + While (n And 1) = 0 + e += 1 + n Shr= 1 + Wend + factors(factorCount).p = 2 + factors(factorCount).e = e + factorCount += 1 + End If + + ' Now we only need to check odd numbers + For i = 1 To primeCount - 1 + p = primes(i) + If p * p > n Then Exit For + + If (n Mod p) = 0 Then + e = 0 + Do + e += 1 + n \= p + Loop While (n Mod p) = 0 + + factors(factorCount).p = p + factors(factorCount).e = e + factorCount += 1 + End If + Next + + If n > 1 Then + factors(factorCount).p = n + factors(factorCount).e = 1 + factorCount += 1 + End If + + Return factorCount +End Function + +Function get_factors(n As Ulong, factors() As Ulong) As Integer + Dim As Ulong i, k + Dim As Integer p, j, prevLen + Dim As prime_factor prime_factors(100) + Dim As Integer factorCount = get_prime_factors(n, prime_factors()) + + factors(0) = 1 + Dim As Integer len2 = 1 + Dim As Integer totalFactors = 1 + + For i = 0 To factorCount - 1 + p = prime_factors(i).p + prevLen = totalFactors + + For j = 0 To prime_factors(i).e - 1 + For k = 0 To prevLen - 1 + factors(totalFactors) = factors(k) * p + totalFactors += 1 + Next + p *= prime_factors(i).p + Next + Next + + ' Sort the factors + For i = 0 To totalFactors - 2 + For p = i + 1 To totalFactors - 1 + If factors(i) > factors(p) Then Swap factors(i), factors(p) + Next + Next + + Return totalFactors +End Function + +Function mpow(a As Ulongint, p As Ulongint, m As Ulongint) As Ulongint + Dim r As Ulongint = 1 + While p > 0 + If (p And 1) Then r = (r * a) Mod m + a = (a * a) Mod m + p Shr= 1 + Wend + Return r +End Function + +Function ipow(a As Ulongint, p As Ulongint) As Ulongint + Dim r As Ulongint = 1 + While p > 0 + If (p And 1) Then r *= a + a *= a + p Shr= 1 + Wend + Return r +End Function + +Function GCD(n As Ulongint, d As Ulongint) As Ulongint + Return Iif(d = 0, n, GCD(d, n Mod d)) +End Function + +Function lcm(r As Ulongint, s As Ulongint) As Ulongint + Return (r * s) / GCD(r, s) +End Function + +Function multi_order_p(a As Ulong, p As Ulong, e As Ulong) As Ulong + Dim As Ulong m = ipow(p, e) + Dim As Ulong t = (m \ p) * (p - 1) + Dim As Ulong fac(1000) + Dim As Integer facCount = get_factors(t, fac()) + + For i As Integer = 0 To facCount - 1 + If mpow(a, fac(i), m) = 1 Then Return fac(i) + Next + + Return 0 +End Function + +Function multi_order(a As Ulong, m As Ulong) As Ulong + Dim pf(100) As prime_factor + Dim pfCount As Integer = get_prime_factors(m, pf()) + Dim res As Ulong = 1 + + For i As Integer = 0 To pfCount - 1 + res = lcm(res, multi_order_p(a, pf(i).p, pf(i).e)) + Next + + Return res +End Function + +Sub sieve() + Dim As Integer i, j + Const SIZE = 1 Shl 15 + Static bits(0 To SIZE-1) As Boolean + + ' Fill with True's (faster than loop) + FillMemory(@bits(0), SIZE, True) + + bits(0) = False + bits(1) = False + + ' Only need to check up to sqrt(SIZE) + For i = 2 To Int(Sqr(SIZE)) + If bits(i) Then + For j = i * i To SIZE-1 Step i + bits(j) = False + Next + End If + Next + + ' Store primes in array + For i = 2 To SIZE-1 + If bits(i) Then + primes(primeCount) = i + primeCount += 1 + End If + Next +End Sub + +' Main program +sieve() +Print multi_order(37, 1000) ' Prints 100 +Print multi_order(37, 3343) ' Prints 1114 +Print multi_order(54, 100001) ' Prints 9090 +Print multi_order(3047753288, 2257683301) ' Prints 62713425 + +Sleep diff --git a/Task/Munchausen-numbers/Langur/munchausen-numbers.langur b/Task/Munchausen-numbers/Langur/munchausen-numbers.langur index b97ba6c9a9..244ff69d79 100644 --- a/Task/Munchausen-numbers/Langur/munchausen-numbers.langur +++ b/Task/Munchausen-numbers/Langur/munchausen-numbers.langur @@ -1,5 +1,5 @@ # sum power of digits -val spod = fn n:fold(fn{+}, map(fn x:x^x, n -> string -> s2n)) +val spod = fn n:fold(map(n -> string -> s2n, by=fn x:x^x), by=fn{+}) # Munchausen -writeln "Answers: ", filter(fn n: n == spod(n), series(1..5000)) +writeln "Answers: ", filter(series(5000), by=fn n:n == spod(n)) diff --git a/Task/Munchausen-numbers/PascalABC.NET/munchausen-numbers.pas b/Task/Munchausen-numbers/PascalABC.NET/munchausen-numbers.pas new file mode 100644 index 0000000000..c1e948ce26 --- /dev/null +++ b/Task/Munchausen-numbers/PascalABC.NET/munchausen-numbers.pas @@ -0,0 +1,2 @@ +## +(1..5000).Where(x -> x = x.ToString.Select(c -> (if c = '0' then 0 else c.ToDigit ** c.ToDigit)).Sum).Println; diff --git a/Task/Musical-scale/68000-Assembly/musical-scale.68000 b/Task/Musical-scale/68000-Assembly/musical-scale.68000 new file mode 100644 index 0000000000..70dc735408 --- /dev/null +++ b/Task/Musical-scale/68000-Assembly/musical-scale.68000 @@ -0,0 +1,25 @@ + lea sample(pc),a0 + move.l a0,$dff0a0 ; AUD0LCH and AUD0LCL + move.w #32,$dff0a4 ; AUD0LEN = number of sample words + move.w #48,$dff0a8 ; AUD0VOL + moveq #9,d2 ; number of notes -1 + lea notes(pc),a0 + move.w #$8203,$dff096 ; enable DMA for AUD0 +loop: move.w (a0)+,$dff0a6 + moveq #50,d1 ; delay 50 frames +waitv1: tst.b $dff006 ; VPOSHR + bne waitv1 +waitv2: tst.b $dff006 + beq waitv2 + dbf d1,waitv1 + dbf d2,loop + move.w #1,$dff096 ; turn DMA off again + rts + +notes: dc.w 212,189,168,159,141,126,112,106,106,106 + +; a simple triangular waveform +sample: dc.b 0, 8, 16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120 + dc.b 128, 120, 112, 104, 96, 88, 80, 72, 64, 56, 48, 40, 32, 24, 16, 8 + dc.b 0,-8,-16,-24,-32,-40,-48,-56,-64,-72,-80,-88,-96,-104,-112,-120 + dc.b -127,-120,-112,-140,-96,-88,-80,-72,-64,-56,-48,-40,-32,-24,-16,-8 diff --git a/Task/Musical-scale/Aquarius-BASIC/musical-scale.basic b/Task/Musical-scale/Aquarius-BASIC/musical-scale.basic new file mode 100644 index 0000000000..fef6565b5c --- /dev/null +++ b/Task/Musical-scale/Aquarius-BASIC/musical-scale.basic @@ -0,0 +1,6 @@ +10 FOR I=1 TO 8 +20 READ F +30 P=285*200/F +40 SOUND(F,P) +50 NEXT +60 DATA 262, 294, 330, 349, 392, 440, 494, 523 diff --git a/Task/Musical-scale/Atari-BASIC/musical-scale.basic b/Task/Musical-scale/Atari-BASIC/musical-scale.basic new file mode 100644 index 0000000000..d87d4a698d --- /dev/null +++ b/Task/Musical-scale/Atari-BASIC/musical-scale.basic @@ -0,0 +1,9 @@ +10 Q=31960.4:REM NTSC +20 IF PEEK(53268)=1 THEN Q=31668.7:REM PAL +30 FOR I=1 TO 8 +40 READ F +50 P=INT(Q/F-0.5) +60 SOUND 1,P,10,15 +70 FOR T=0 TO 800:NEXT T +80 NEXT I +90 DATA 262,294,330,349,392,440,494,523 diff --git a/Task/Musical-scale/PascalABC.NET/musical-scale.pas b/Task/Musical-scale/PascalABC.NET/musical-scale.pas new file mode 100644 index 0000000000..8dc903320b --- /dev/null +++ b/Task/Musical-scale/PascalABC.NET/musical-scale.pas @@ -0,0 +1,3 @@ +## +foreach var note in [261.63, 293.66, 329.63, 349.23, 392.00, 440.00, 493.88, 523.25] do + Console.Beep(note.Round, 500) diff --git a/Task/Mutual-recursion/Miranda/mutual-recursion.miranda b/Task/Mutual-recursion/Miranda/mutual-recursion.miranda new file mode 100644 index 0000000000..ebe291b2c3 --- /dev/null +++ b/Task/Mutual-recursion/Miranda/mutual-recursion.miranda @@ -0,0 +1,11 @@ +main :: [sys_message] +main = [Stdout ("F: " ++ show (map f [0..20]) ++ "\n"), + Stdout ("M: " ++ show (map m [0..20]) ++ "\n")] + +f :: num->num +f 0 = 1 +f n = n - m (f (n-1)) + +m :: num->num +m 0 = 0 +m n = n - f (m (n-1)) diff --git a/Task/Mutual-recursion/PascalABC.NET/mutual-recursion.pas b/Task/Mutual-recursion/PascalABC.NET/mutual-recursion.pas index 30c19f3292..b8ff897ee9 100644 --- a/Task/Mutual-recursion/PascalABC.NET/mutual-recursion.pas +++ b/Task/Mutual-recursion/PascalABC.NET/mutual-recursion.pas @@ -1,7 +1,7 @@ ## function M(n: integer): integer; forward; -function F(n: integer): integer := n < 1 ? 1 : n - M(F(n - 1)); -function M(n: integer): integer := n < 1 ? 0 : n - F(M(n - 1)); +function F(n: integer): integer := if n < 1 then 1 else n - M(F(n - 1)); +function M(n: integer): integer := if n < 1 then 0 else n - F(M(n - 1)); (0..19).select(x -> F(x)).println; (0..19).select(x -> M(x)).println; diff --git a/Task/Mutual-recursion/Zig/mutual-recursion.zig b/Task/Mutual-recursion/Zig/mutual-recursion.zig new file mode 100644 index 0000000000..eab66631c0 --- /dev/null +++ b/Task/Mutual-recursion/Zig/mutual-recursion.zig @@ -0,0 +1,15 @@ +fn f(n: u64) u64 { + return if (n == 0) 1 else n-m(f(n-1)); +} + +fn m(n: u64) u64 { + return if (n == 0) 0 else n-f(m(n-1)); +} + +pub fn main() !void { + const stdout = @import("std").io.getStdOut().writer(); + try stdout.writeAll(" n F M\n"); + for (0..20) |n| { + try stdout.print("{d: >2}: {d: >2} {d: >2}\n", .{n, f(n), m(n)}); + } +} diff --git a/Task/N-queens-problem/PascalABC.NET/n-queens-problem.pas b/Task/N-queens-problem/PascalABC.NET/n-queens-problem.pas new file mode 100644 index 0000000000..ccef0ba98e --- /dev/null +++ b/Task/N-queens-problem/PascalABC.NET/n-queens-problem.pas @@ -0,0 +1,17 @@ +const + N = 8; + +begin + var cols := (1..N); + var solutions := 0; + foreach var vec in cols.Permutations do + if (N = cols.Select(n -> vec[n - 1] + n).ToSet.Count) and + (N = cols.Select(n -> vec[n - 1] - n).ToSet.Count) then + begin + solutions += 1; +// foreach var col in ('a'..'h') index i do +// write(col, vec[i], ' '); +// write(if solutions mod 4 = 0 then #10 else ' '); + end; + writeln('Solutions: ', solutions); +end. diff --git a/Task/Named-parameters/PascalABC.NET/named-parameters.pas b/Task/Named-parameters/PascalABC.NET/named-parameters.pas new file mode 100644 index 0000000000..12fdc0f1d9 --- /dev/null +++ b/Task/Named-parameters/PascalABC.NET/named-parameters.pas @@ -0,0 +1,8 @@ +## +procedure test(first: integer; second: integer := 2; third: integer := 3); +begin +end; + +test(5); +test(5, 5); +test(5, third := 5, second := 5); diff --git a/Task/Narcissistic-decimal-number/PascalABC.NET/narcissistic-decimal-number.pas b/Task/Narcissistic-decimal-number/PascalABC.NET/narcissistic-decimal-number.pas new file mode 100644 index 0000000000..8b3416a0b8 --- /dev/null +++ b/Task/Narcissistic-decimal-number/PascalABC.NET/narcissistic-decimal-number.pas @@ -0,0 +1,26 @@ +function narc(): sequence of integer; +begin + var power := |0, 1, 2, 3, 4, 5, 6, 7, 8, 9|; + var limit := 10; + var x := 0; + repeat + if x >= limit then + begin + foreach var i in (0..9) do power[i] := power[i] * i; + limit := limit * 10; + end; + var sum := 0; + var xx := x; + while (xx > 0) do + begin + sum := sum + power[xx mod 10]; + xx := (xx / 10).floor; + end; + if sum = x then yield x; + x += 1; + until false; +end; + +begin + narc.Take(25).println; +end. diff --git a/Task/Next-highest-int-from-digits/PascalABC.NET/next-highest-int-from-digits.pas b/Task/Next-highest-int-from-digits/PascalABC.NET/next-highest-int-from-digits.pas new file mode 100644 index 0000000000..32e794561b --- /dev/null +++ b/Task/Next-highest-int-from-digits/PascalABC.NET/next-highest-int-from-digits.pas @@ -0,0 +1,53 @@ +function digits(n: biginteger): list; +begin + // Return the list of digits of "n" in reverse order. + result := new list; + if n = 0 then result.add(0); + while n <> 0 do + begin + result.add(byte(n mod 10)); + n := n div 10; + end; +end; + +function nextHighest(n: biginteger): biginteger; +begin + // Find the next highest integer of "n". + // If none is found, "n" is returned. + var d := digits(n); // Warning: in reverse order. + var m := d[0]; + foreach var i in 1..d.Count - 1 do + if d[i] < m then + begin + // Find the digit greater then d[i] and closest to it. + var delta := m - d[i] + 1; + var best: integer; + foreach var j in 0..i - 1 do + begin + var diff := d[j] - d[i]; + if (diff > 0) and (diff < delta) then + begin + // Greater and closest. + delta := diff; + best := j; + end; + end; + // Exchange digits. + (d[i], d[best]) := (d[best], d[i]); + // Sort previous digits. + var (d1, d2) := d.SplitAt(i); + d := d1.SortedDescending.ToList + d2.ToList; + break; + end + else m := d[i]; + // Compute the value from the digits. + foreach var val in d[::-1] do + result := 10 * result + val; +end; + +begin + foreach var n in [0, 9, 12, 21, 12453, 738440, 45072010, 95322020] do + println(n, ' → ', nextHighest(n)); + var n := '9589776899767587796600'.ToBigInteger; + println(n, '→', nextHighest(n)); +end. diff --git a/Task/Nim-game/PascalABC.NET/nim-game.pas b/Task/Nim-game/PascalABC.NET/nim-game.pas new file mode 100644 index 0000000000..a65c62b67a --- /dev/null +++ b/Task/Nim-game/PascalABC.NET/nim-game.pas @@ -0,0 +1,24 @@ +## +writeln('There are twelve tokens.'); +writeln('You can take 1, 2, or 3 on your turn.'); +writeln('Whoever takes the last token wins.'); + +var tokens := 12; + +while (tokens > 0) do +begin + writeln('There are ' + tokens + ' remaining.'); + writeln('How many do you take?'); + var playertake := ReadInteger; + + if (playertake < 1) or (playertake > 3) then + writeln('1, 2 or 3 only.') + else + begin + tokens -= playertake; + writeln('I take ' + (4 - playertake) + '.'); + tokens -= (4 - playertake); + end; +end; + +writeln('I win again.'); diff --git a/Task/Non-continuous-subsequences/PascalABC.NET/non-continuous-subsequences.pas b/Task/Non-continuous-subsequences/PascalABC.NET/non-continuous-subsequences.pas new file mode 100644 index 0000000000..3cc439b320 --- /dev/null +++ b/Task/Non-continuous-subsequences/PascalABC.NET/non-continuous-subsequences.pas @@ -0,0 +1,29 @@ +function AllSubSets(a: List; i: integer; lst: List): sequence of List; +begin + if i = a.Count then yield lst + else + begin + lst.Add(a[i]); + yield sequence AllSubSets(a, i + 1, lst); + lst.RemoveAt(lst.Count - 1); + yield sequence AllSubSets(a, i + 1, lst); + end; +end; + +function IsContinuous(lst: List) := +if lst.Count > 0 then lst[^1] - lst[0] + 1 = lst.Count else true; + +function ncsub(seq: list) := +Allsubsets(Lst(1..seq.Count), 0, new List) + .Where(s -> not iscontinuous(s)) + .Select(s -> s.Select(i -> seq[i - 1]).ToList); + +begin + var seq := |'C', 'D', 'A', 'E', 'B'|.ToList; + println('Non-continuous subsequences for', seq, ':'); + ncsub(seq).Println; + println; + println('Non-continuous subsequences:'); + for var n := 1 to 20 do + println([1..n], '=', ncsub([1..n].ToList).Count); +end. diff --git a/Task/Nonoblock/PascalABC.NET/nonoblock.pas b/Task/Nonoblock/PascalABC.NET/nonoblock.pas new file mode 100644 index 0000000000..ccd63c9919 --- /dev/null +++ b/Task/Nonoblock/PascalABC.NET/nonoblock.pas @@ -0,0 +1,37 @@ +function genSequence(ones: list; numZeros: integer): list; +begin + result := new list; + if ones.Count = 0 then result := Lst('0' * (numZeros +1)) + else + foreach var x in 1..(numZeros - ones.Count + 2) do + begin + var skipOne := ones.Skip(1).ToList; + foreach var tail in genSequence(skipOne, numZeros - x) do + result.add(('0' * x) + ones[0] + tail); + end; +end; + +procedure printBlock(data: string; length: integer); +begin + var a := data.select(c -> ord(c) - ord('0')).ToList; + var sumBytes := a.sum; + + writeln(#10, 'blocks ', a, ' cells ', length); + if length - sumBytes <= 0 then + println('No solution') + else + begin + var prep := a.Select(n -> '1' * n).ToList; + + foreach var r in genSequence(prep, length - sumBytes) do + r[2:].println; + end; +end; + +begin + printBlock('21', 5); + printBlock('', 5); + printBlock('8', 10); + printBlock('2323', 15); + printBlock('23', 5); +end. diff --git a/Task/Nth-root/ALGOL-60/nth-root-1.alg b/Task/Nth-root/ALGOL-60/nth-root-1.alg new file mode 100644 index 0000000000..54eecfc751 --- /dev/null +++ b/Task/Nth-root/ALGOL-60/nth-root-1.alg @@ -0,0 +1,21 @@ +begin + +comment - return the nth root of x to stated precision; +real procedure nthroot(x, n, precision); + value x, n, precision; real x, n, precision; +begin + real x0, x1; + x0 := x; + x1 := x / n; + for x0 := x0 while abs(x1 - x0) > precision do + begin + x0 := x1; + x1 := ((n-1)*x1 + x / x1 ** (n-1)) / n; + end; + nthroot := x1; +end; + +outstring(1,"Cube root of 81 ="); +outreal(1,nthroot(81, 3, 0.0000001)); + +end diff --git a/Task/Nth-root/ALGOL-60/nth-root-2.alg b/Task/Nth-root/ALGOL-60/nth-root-2.alg new file mode 100644 index 0000000000..fd6187db55 --- /dev/null +++ b/Task/Nth-root/ALGOL-60/nth-root-2.alg @@ -0,0 +1,5 @@ +real procedure nthroot(x, n); + value x, n; real x, n; +begin + nthroot := exp(ln(x) / n); +end; diff --git a/Task/Nth-root/ALGOL-60/nth-root-3.alg b/Task/Nth-root/ALGOL-60/nth-root-3.alg new file mode 100644 index 0000000000..5f133379b8 --- /dev/null +++ b/Task/Nth-root/ALGOL-60/nth-root-3.alg @@ -0,0 +1,5 @@ +real procedure nthroot(x, n); + value x, n; real x, n; +begin + nthroot := x ** (1/n); +end; diff --git a/Task/Nth-root/ANSI-BASIC/nth-root.basic b/Task/Nth-root/ANSI-BASIC/nth-root.basic new file mode 100644 index 0000000000..74e50776b8 --- /dev/null +++ b/Task/Nth-root/ANSI-BASIC/nth-root.basic @@ -0,0 +1,23 @@ +100 REM Nth root +110 DECLARE EXTERNAL FUNCTION NthRoot +120 LET X = 144 +130 PRINT "Finding the nth root of"; X; "to 6 decimal places" +140 PRINT " x n root x ^ (1 / n)" +150 PRINT "--------------------------------------" +160 FOR I = 1 TO 8 +170 PRINT USING "### ": X; +180 PRINT USING "#### ": I; +190 PRINT USING "###.######": NthRoot(I, X, 1.000000E-07); +200 PRINT USING " ###.######": X ^ (1 / I) +210 NEXT I +220 END +230 EXTERNAL FUNCTION NthRoot(N, X, Precision) +240 REM Returns the Nth root of value X to stated Precision +250 LET X0 = X +260 LET X1 = X / N ! initial guess +270 DO WHILE ABS(X1 - X0) > Precision +280 LET X0 = X1 +290 LET X1 = ((N - 1) * X1 + X / X1 ^ (N - 1)) / N +300 LOOP +310 LET NthRoot = X1 +320 END FUNCTION diff --git a/Task/Nth-root/AWK/nth-root.awk b/Task/Nth-root/AWK/nth-root-1.awk similarity index 100% rename from Task/Nth-root/AWK/nth-root.awk rename to Task/Nth-root/AWK/nth-root-1.awk diff --git a/Task/Nth-root/AWK/nth-root-2.awk b/Task/Nth-root/AWK/nth-root-2.awk new file mode 100644 index 0000000000..149c314327 --- /dev/null +++ b/Task/Nth-root/AWK/nth-root-2.awk @@ -0,0 +1,24 @@ +#!/usr/bin/awk -f +BEGIN { + # test + print nthroot(8,3) + print nthroot(16,2) + print nthroot(16,4) + print nthroot(125,3) + print nthroot(3,3) + print nthroot(3,2) +} + +function nthroot(a, n, x, y, a_n, n1_n) { + # no need for eps, the values are monotonically decreasing + # until the root is found (if the initial value is above the root) + x = 1 + a / n # starting value above the root + a_n = a/n # precompute loop invariants + n1_n = (n - 1) / n + do { + y = x + x = n1_n * x + a_n / x^(n-1) + } while (x < y) + # no harm to use average if x = y + return (x + y) / 2 +} diff --git a/Task/Nth-root/AWK/nth-root-3.awk b/Task/Nth-root/AWK/nth-root-3.awk new file mode 100644 index 0000000000..a408ea3387 --- /dev/null +++ b/Task/Nth-root/AWK/nth-root-3.awk @@ -0,0 +1,8 @@ +{ + x = $0 + do { + y = x + x = (x + $0/x)/2 + } while (x < y) + print "sqrt(" a ")=" x +} diff --git a/Task/Nth-root/BASIC/nth-root-3.basic b/Task/Nth-root/BASIC/nth-root-3.basic deleted file mode 100644 index 077503d9b9..0000000000 --- a/Task/Nth-root/BASIC/nth-root-3.basic +++ /dev/null @@ -1 +0,0 @@ -PRINT "The "; e; "th root of "; b; " is "; RootX(b, e, .000001) diff --git a/Task/Nth-root/GW-BASIC/nth-root.basic b/Task/Nth-root/GW-BASIC/nth-root.basic new file mode 100644 index 0000000000..222b294249 --- /dev/null +++ b/Task/Nth-root/GW-BASIC/nth-root.basic @@ -0,0 +1,23 @@ +100 REM Nth root +110 X# = 144 +120 PRINT "Finding the nth root of"; X#; "to 6 decimal places" +130 PRINT " x n root x ^ (1 / n)" +140 PRINT "--------------------------------------" +150 FOR I% = 1 TO 8 +160 PRINT USING "### "; X#; +170 PRINT USING "#### "; I%; +180 N% = I%: PREC# = .0000001#: GOSUB 1000 +190 PRINT USING "###.######"; NTH.ROOT#; +200 PRINT USING " ###.######"; X# ^ (1 / I%) +210 NEXT I% +220 END +1000 REM Calculate the N%th root of value X# to stated precision PREC# +1010 REM Result: NTH.ROOT# +1020 X0# = X# +1030 X1# = X# / N% ' initial guess +1040 WHILE ABS(X1# - X0#) > PREC# +1050 X0# = X1# +1060 X1# = ((N% - 1) * X1# + X# / X1# ^ (N% - 1)) / N% +1070 WEND +1080 NTH.ROOT# = X1# +1090 RETURN diff --git a/Task/Nth-root/Modula-2/nth-root.mod2 b/Task/Nth-root/Modula-2/nth-root.mod2 new file mode 100644 index 0000000000..fc8d4f18ec --- /dev/null +++ b/Task/Nth-root/Modula-2/nth-root.mod2 @@ -0,0 +1,47 @@ +MODULE NthRoot; +FROM LongMath IMPORT + power; +FROM STextIO IMPORT + WriteString, WriteLn; +FROM SLongIO IMPORT + WriteFixed; +FROM SWholeIO IMPORT + WriteInt; + +VAR + X: LONGREAL; + I: CARDINAL; + +PROCEDURE Root(X: LONGREAL; N: CARDINAL; Precision: LONGREAL): LONGREAL; +(* Returns the Nth root of value X to stated Precision *) +VAR + X0, X1, NR: LONGREAL; +BEGIN + NR := FLOAT(N); + X0 := X; + X1 := X / NR; (* initial guess *) + WHILE ABS(X1 - X0) > Precision DO + X0 := X1; + X1 := ((NR - 1.0) * X1 + X / power(X1, NR - 1.0)) / NR + END; + RETURN X1 +END Root; + +BEGIN + X := 144.0; + WriteString("Finding the nth root of "); + WriteFixed(X, 1, 5); + WriteString(" to 6 decimal places"); + WriteLn; + WriteString(" x n root x ^ (1 / n)"); + WriteLn; + WriteString("----------------------------------------"); + WriteLn; + FOR I := 1 TO 8 DO + WriteFixed(X, 1, 5); + WriteInt(I, 7); + WriteFixed(Root(X, I, 1.0E-07), 6, 14); + WriteFixed(power(X, 1. / FLOAT(I)), 6, 14); + WriteLn + END +END NthRoot. diff --git a/Task/Nth-root/OoRexx/nth-root.rexx b/Task/Nth-root/OoRexx/nth-root.rexx new file mode 100644 index 0000000000..ef8aae872c --- /dev/null +++ b/Task/Nth-root/OoRexx/nth-root.rexx @@ -0,0 +1,31 @@ +/* REXX */ +Numeric Digits 70 +Call test 2,2 +Call test 10,3 +Call test 625,-4 +Call test 100.666,47 +Call test -256,8 +Call test 12345678900098765432100.00987654321000123456789e333,19 +Exit +test: +Parse Arg x,n +xa=abs(x) +na=abs(n) +lnx=rxmlog(xa,70) +rt=rxmexp(lnx/na,70) +Numeric Digits 65 +result=rt+0 +If pos('.',result)>0 Then Do -- get rid of zeroes in decimals + Parse Var result int '.' dec + If dec=0 Then + result=int + End +If sign(n)=-1 Then result=1/result +If sign(x)=-1 Then result=result'j' +Say ' x = ' x +Say ' root = ' n +Say ' digits = ' 65 +Say ' answer = ' result +Say '' +Return +::REQUIRES rxm.cls diff --git a/Task/Nth-root/QuickBASIC/nth-root.basic b/Task/Nth-root/QuickBASIC/nth-root.basic new file mode 100644 index 0000000000..0f351df4f8 --- /dev/null +++ b/Task/Nth-root/QuickBASIC/nth-root.basic @@ -0,0 +1,24 @@ +' Nth root +DECLARE FUNCTION NthRoot# (N%, X#, Precision#) +X# = 144 +PRINT "Finding the nth root of"; X#; "to 6 decimal places" +PRINT " x n root x ^ (1 / n)" +PRINT "--------------------------------------" +FOR I% = 1 TO 8 + PRINT USING "### "; X#; + PRINT USING "#### "; I%; + PRINT USING "###.######"; NthRoot#(I%, X#, .0000001); + PRINT USING " ###.######"; X# ^ (1 / I%) +NEXT I% +END + +FUNCTION NthRoot# (N%, X#, Precision#) + ' Returns the Nth root of value X to stated Precision + X0# = X# + X1# = X# / N% ' initial guess + DO WHILE ABS(X1# - X0#) > Precision# + X0# = X1# + X1# = ((N% - 1) * X1# + X# / X1# ^ (N% - 1)) / N% + LOOP + NthRoot# = X1# +END FUNCTION diff --git a/Task/Nth-root/REXX/nth-root-1.rexx b/Task/Nth-root/REXX/nth-root-1.rexx deleted file mode 100644 index 0cb70d985e..0000000000 --- a/Task/Nth-root/REXX/nth-root-1.rexx +++ /dev/null @@ -1,38 +0,0 @@ -/*REXX program calculates the Nth root of X, with DIGS (decimal digits) accuracy. */ -parse arg x root digs . /*obtain optional arguments from the CL*/ -if x=='' | x=="," then x= 2 /*Not specified? Then use the default.*/ -if root=='' | root=="," then root= 2 /* " " " " " " */ -if digs=='' | digs=="," then digs=65 /* " " " " " " */ -numeric digits digs /*set the decimal digits to DIGS. */ -say ' x = ' x /*echo the value of X. */ -say ' root = ' root /* " " " " ROOT. */ -say ' digits = ' digs /* " " " " DIGS. */ -say ' answer = ' root(x, root) /*show the value of ANSWER. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -root: procedure; parse arg x 1 Ox, r 1 Or /*arg1 ──► x & Ox, 2nd ──► r & Or*/ - if r=='' then r=2 /*Was root specified? Assume √. */ - if r=0 then return '[n/a]' /*oops-ay! Can't do zeroth root.*/ - complex= x<0 & R//2==0 /*will the result be complex? */ - oDigs=digits() /*get the current number of digs.*/ - if x=0 | r=1 then return x/1 /*handle couple of special cases.*/ - dm=oDigs+5 /*we need a little guard room. */ - r=abs(r); x=abs(x) /*the absolute values of R and X.*/ - rm=r-1 /*just a fast version of ROOT -1*/ - numeric form /*take a good guess at the root─┐*/ - parse value format(x,2,1,,0) 'E0' with ? 'E' _ . /* ◄────────────────────────────┘*/ - g= (? / r'E'_ % r) + (x>1) /*kinda uses a crude "logarithm".*/ - d=5 /*start with five decimal digits.*/ - do until d==dm; d=min(d+d,dm) /*each time, precision doubles. */ - numeric digits d /*tell REXX to use D digits. */ - old=-1 /*assume some kind of old guess. */ - do until old=g; old=g /*where da rubber meets da road─┐*/ - g=format((rm*g**r+x)/r/g**rm,, d-2) /* ◄────── the root computation─┘*/ - end /*until old=g*/ /*maybe until the cows come home.*/ - end /*until d==dm*/ /*and wait for more cows to come.*/ - - if g=0 then return 0 /*in case the jillionth root = 0.*/ - if Or<0 then g=1/g /*root < 0 ? Reciprocal it is! */ - if \complex then g=g*sign(Ox) /*adjust the sign (maybe). */ - numeric digits oDigs /*reinstate the original digits. */ - return (g/1) || left('j', complex) /*normalize # to digs, append j ?*/ diff --git a/Task/Nth-root/REXX/nth-root-2.rexx b/Task/Nth-root/REXX/nth-root-2.rexx deleted file mode 100644 index 7f4dbc34e6..0000000000 --- a/Task/Nth-root/REXX/nth-root-2.rexx +++ /dev/null @@ -1,4 +0,0 @@ -do until old=g; old=g /*where da rubber meets da road-+*/
-g=format((rm*g**r+x)/r/g**rm,, d-2) /* ?------ the root computation-+*/
-'''say 'g' g 'old' old'''
-end /*until old=g*/ /*maybe until the cows come home.*/
diff --git a/Task/Nth-root/REXX/nth-root-3.rexx b/Task/Nth-root/REXX/nth-root.rexx similarity index 56% rename from Task/Nth-root/REXX/nth-root-3.rexx rename to Task/Nth-root/REXX/nth-root.rexx index 3f0c57e41e..d319e533a9 100644 --- a/Task/Nth-root/REXX/nth-root-3.rexx +++ b/Task/Nth-root/REXX/nth-root.rexx @@ -10,49 +10,8 @@ numeric digits digs /*set the decimal digits to say ' x = ' x /*echo the value of X. */ say ' root = ' root /* " " " " ROOT. */ say ' digits = ' digs /* " " " " DIGS. */ -say ' answer = ' nroot(x, root) /*show the value of ANSWER. */ +say ' answer = ' Nroot(x, root) /*show the value of ANSWER. */ exit /*stick a fork in it, we're all done. */ -/*--------------------------------------------------------------------------------------*/ -Nroot: -/* Nth root function = x^(1/n) */ -procedure expose glob. -arg x,n -/* Fast values */ -if x = 0 then - return 0 -if x = 1 then - return 1 -/* Formulas using faster methods */ -if n = 2 then - return Sqrt(x) -if n = 3 then - return Cbrt(x) -if n = 4 then - return Qtrt(x) -/* Calculate */ -sx = Sign(x); x = Abs(x) -p1 = Digits(); p2 = p1+2 -numeric digits 3 -/* First guess low accuracy */ -y = 1/Exp(Ln(x)/n) -numeric digits p2 -/* Dynamic precision */ -d = p2 -do k = 1 while d > 4 - d.k = d; d = d%2+1 -end -d.k = 4 -/* Halley */ -a = 1/n; b = n+1 -do j = k to 1 by -1 - numeric digits d.j - y = y*a*(b-x*y**n) -end -y = 1/y -if sx < 0 then - y = -y -numeric digits p1 -return y+0 include Numbers include Functions diff --git a/Task/Nth-root/RapidQ/nth-root.rapidq b/Task/Nth-root/RapidQ/nth-root.rapidq new file mode 100644 index 0000000000..2aa6bd3b8a --- /dev/null +++ b/Task/Nth-root/RapidQ/nth-root.rapidq @@ -0,0 +1,25 @@ +' Nth root +DECLARE FUNCTION NthRoot (N%, X#, Precision#) AS DOUBLE +X# = 144 +PRINT "Finding the nth root of ";X#;" to 6 decimal places" +PRINT " x n root x ^ (1 / n)" +PRINT "--------------------------------------" +FOR I% = 1 TO 8 + PRINT FORMAT$("%3d ", X#); + PRINT FORMAT$("%4d ", I%); + PRINT FORMAT$("%10.6f", NthRoot(I%, X#, .0000001)); + PRINT FORMAT$(" %10.6f", X# ^ (1 / I%)) +NEXT I% +input X# +END + +FUNCTION NthRoot (N%, X#, Precision#) AS DOUBLE + ' Returns the Nth root of value X to stated Precision + X0# = X# + X1# = X# / N% ' initial guess + WHILE ABS(X1# - X0#) > Precision# + X0# = X1# + X1# = ((N% - 1) * X1# + X# / X1# ^ (N% - 1)) / N% + WEND + NthRoot = X1# +END FUNCTION diff --git a/Task/Nth-root/S-BASIC/nth-root-1.basic b/Task/Nth-root/S-BASIC/nth-root-1.basic index a38e90743c..9a2373df01 100644 --- a/Task/Nth-root/S-BASIC/nth-root-1.basic +++ b/Task/Nth-root/S-BASIC/nth-root-1.basic @@ -4,12 +4,14 @@ end = exp((1.0 / n) * log(x)) rem - exercise the routine by finding successive roots of 144 var i = integer +var x = real -print "Finding the nth root of x" +x = 144 +print "Finding the nth root of"; x print " x n root" print "-----------------------" for i = 1 to 8 - print using "### #### ###.####"; 144; i; nthroot(144, i) + print using "### #### ###.####"; x; i; nthroot(x, i) next i end diff --git a/Task/Nth-root/S-BASIC/nth-root-2.basic b/Task/Nth-root/S-BASIC/nth-root-2.basic index 7a8c2ac639..7d03be3618 100644 --- a/Task/Nth-root/S-BASIC/nth-root-2.basic +++ b/Task/Nth-root/S-BASIC/nth-root-2.basic @@ -1,8 +1,8 @@ -rem - return the nth root of real.double value x to stated precision +rem - return the nth root of x to stated precision function nthroot(n, x, precision = real.double) = real.double var x0, x1 = real.double x0 = x - x1 = x / n rem - initial guess + x1 = x / n rem - initial guess while abs(x1 - x0) > precision do begin x0 = x1 @@ -13,11 +13,14 @@ end = x1 rem -- exercise the routine var i = integer -print "Finding the nth root of 144 to 6 decimal places" +var x = real.double + +x = 144 +print "Finding the nth root of"; x; " to 8 decimal places" print " x n root" print "------------------------" -for i = 1 to 8 - print using "### #### ###.######"; 144; i; nthroot(i, 144.0, 1E-7) +for i = 2 to 8 + print using "### #### ###.########"; x; i; nthroot(i, x, 1E-9) next i end diff --git a/Task/Nth-root/XPL0/nth-root.xpl0 b/Task/Nth-root/XPL0/nth-root.xpl0 index c29d27d80a..c3184fb7e8 100644 --- a/Task/Nth-root/XPL0/nth-root.xpl0 +++ b/Task/Nth-root/XPL0/nth-root.xpl0 @@ -1,21 +1,24 @@ include c:\cxpl\stdlib; -func real NRoot(A, N); \Return the Nth root of A -real A, N; -real X, X0, Y; +func real NRoot(A, N, Prec); \Return the Nth root of A with precision Prec +real A; +int N; +real Prec; +real X, X0, Y, NF; int I; -[X:= 1.0; \initial guess +[NF:= float(N); +X:= 1.0; \initial guess repeat X0:= X; Y:= 1.0; - for I:= 1 to fix(N)-1 do Y:= Y*X0; - X:= ((N-1.0)*X0 + A/Y) / N; -until abs(X-X0) < 1.0E-15; \(until X=X0 doesn't always work) + for I:= 1 to N-1 do Y:= Y*X0; + X:= ((NF-1.0)*X0 + A/Y) / NF; +until abs(X-X0) < Prec; \(until X=X0 doesn't always work) return X; ]; [Format(5, 15); -RlOut(0, NRoot( 2., 2.)); CrLf(0); +RlOut(0, NRoot( 2., 2, 1.0E-15)); CrLf(0); RlOut(0, Power( 2., 0.5)); CrLf(0); \for comparison -RlOut(0, NRoot(27., 3.)); CrLf(0); -RlOut(0, NRoot(1024.,10.)); CrLf(0); +RlOut(0, NRoot(27., 3, 1.0E-15)); CrLf(0); +RlOut(0, NRoot(1024., 10, 1.0E-15)); CrLf(0); ] diff --git a/Task/Number-names/Arturo/number-names.arturo b/Task/Number-names/Arturo/number-names.arturo new file mode 100644 index 0000000000..99358afb21 --- /dev/null +++ b/Task/Number-names/Arturo/number-names.arturo @@ -0,0 +1,60 @@ +small: [ + "zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" + "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" + "eighteen" "nineteen" +] + +tens: [ + "wrong" "wrong" "twenty" "thirty" "forty" + "fifty" "sixty" "seventy" "eighty" "ninety" +] + +prefixes: ["m" "b" "tr" "quadr" "quint" "sext" "sept" "oct" "non" "dec"] +big: ["" "thousand"] ++ map prefixes 'p -> p ++ "illion" + +wordify: function [number :integer][ + if number < 0 -> + return "negative " ++ wordify neg number + + if number < 20 -> + return small\[number] + + if number < 100 [ + [d m]: divmod number 10 + return tens\[d] ++ (zero? m)? -> "" -> "-" ++ wordify m + ] + + if number < 1000 [ + [d m]: divmod number 100 + return (~{|small\[d]| hundred}) ++ (zero? m)? -> "" -> " and " ++ wordify m + ] + + chunks: [] + n: number + while [not? zero? n][ + [n remainder]: divmod n 1000 + 'chunks ++ remainder + ] + + if (size chunks) > size big -> + return "integer value too large" + + words: [] + loop.with:'i chunks 'ch [ + scale: big\[i] + unless zero? ch [ + chunkStr: wordify ch + 'words ++ (empty? scale)? -> chunkStr + -> ~"|chunkStr| |scale|" + ] + ] + + return join.with:", " reverse words +] + +loop @[ + 0,1,4,5,10,15,18,25,83,140,300,678,1024, + 45039,123456,91740274651983, + neg 83125311200, neg 12, neg 7 +] 'num -> + print [pad to :string num 15, join.with: "\n"++ (repeat " " 16) split.lines wordwrap.at: 40 wordify num diff --git a/Task/Number-names/M2000-Interpreter/number-names.m2000 b/Task/Number-names/M2000-Interpreter/number-names.m2000 new file mode 100644 index 0000000000..b47caeb010 --- /dev/null +++ b/Task/Number-names/M2000-Interpreter/number-names.m2000 @@ -0,0 +1,62 @@ +module Number_names { + numname=lambda ->{ + flush + data "", "one", "two", "three", "four" + data "five", "six", "seven", "eight", "nine", "ten" + data "eleven", "twelve", "thirteen", "fourteen", "fifteen" + data "sixteen", "seventeen","eighteen", "nineteen" + dim lows(), tens(), lev() + lows()=array([]) + data "", "", "twenty", "thirty", "forty","fifty", "sixty" + data "seventy", "eighty", "ninety" + tens()=array([]) + lev()=("", "thousand", "million", "billion") + numname_int=lambda lows(), tens(), lev() (n as long) -> { + if n=0 then ="zero": exit + long tr[0], t=-1, i + string ret, prefix + if n < 0 then prefix= "negative ": n-! else prefix="" + while n>0 + t++ + tr[t]= n mod 1000 + n|div 1000 + end while + for i=t to 0 + tripn="" + if tr[i]=0 then continue for + lt= tr[i] mod 100 + h= tr[i] div 100 + if lt<20 then + tripn+=lows(lt) + else + tripn=tens(lt div 10)+if$(lt mod 10 >0 ->"-"+lows(lt mod 10),"") + end if + if h>0 then + if lt>0 then tripn = " and " + tripn + tripn = lows(h)+" hundred" + tripn + end if + if i=0 and t>0 and h = 0 then tripn = "and " + tripn + ret += tripn+" "+lev(i)+" " + next i + =prefix+trim$(ret) + } + =lambda numname_int (n as currency) ->{ + if int(n)=n then =numname_int(n): exit + string prefix= numname_int(int(abs(n)))+" point " + string decdig = str$(abs(n)-int(abs(n))), ret + if n<0 then prefix="negative "+prefix + ret=prefix + for i = 3 to len(decdig) + ret+=lambda(val(mid$(decdig, i, 1)))+" " + next i + =trim$(ret) + } + }() 'execute here so we get the inner lambda + report numname(0) + report numname(1.0) + report numname(-1.7) + report numname(910000) + report numname(987654) + report numname(100000017) +} +Number_names diff --git a/Task/Number-names/Quackery/number-names.quackery b/Task/Number-names/Quackery/number-names.quackery index 65f25e5730..086bc21982 100644 --- a/Task/Number-names/Quackery/number-names.quackery +++ b/Task/Number-names/Quackery/number-names.quackery @@ -10,7 +10,7 @@ [ [ table $ "nonety" $ "tenty" $ "twenty" - $ "thirty" $ "fourty" $ "fifty" + $ "thirty" $ "forty" $ "fifty" $ "sixty" $ "seventy" $ "eighty" $ "ninety" ] do ] is tens ( n --> $ ) diff --git a/Task/Numbers-which-are-not-the-sum-of-distinct-squares/PascalABC.NET/numbers-which-are-not-the-sum-of-distinct-squares.pas b/Task/Numbers-which-are-not-the-sum-of-distinct-squares/PascalABC.NET/numbers-which-are-not-the-sum-of-distinct-squares.pas new file mode 100644 index 0000000000..7841c5478c --- /dev/null +++ b/Task/Numbers-which-are-not-the-sum-of-distinct-squares/PascalABC.NET/numbers-which-are-not-the-sum-of-distinct-squares.pas @@ -0,0 +1,37 @@ +function soms(n: integer; f: list): boolean; +begin + if (n <= 0) then result := false + else + if n in f then result := true + else + case n.CompareTo(f.Sum) of + 1: result := false; + 0: result := true; + else + var rf := f[::-1].Skip(1).ToList; + result := soms(n - f.Last, rf) or soms(n, rf); + end; +end; + +begin + var i := 1; + var g := 1; + var s := new List; + var a := new List; + + repeat + if i.Sqrt.Floor.Sqr = i then s.Add(i); + if not soms(i, s) then + begin + g := i; + a.Add(g) + end; + i += 1; + until g < (i shr 1); + + println('Numbers which are not the sum of distinct squares:'); + a.println; + println; + println('Stopped checking after finding', i - g, 'sequential non-gaps after the final gap of', g); + println('Found', a.count, 'total.'); +end. diff --git a/Task/Numbers-which-are-not-the-sum-of-distinct-squares/Python/numbers-which-are-not-the-sum-of-distinct-squares.py b/Task/Numbers-which-are-not-the-sum-of-distinct-squares/Python/numbers-which-are-not-the-sum-of-distinct-squares.py new file mode 100644 index 0000000000..3802f1df42 --- /dev/null +++ b/Task/Numbers-which-are-not-the-sum-of-distinct-squares/Python/numbers-which-are-not-the-sum-of-distinct-squares.py @@ -0,0 +1,58 @@ +import math + + +def soms(n: int, f: list[int]): + if n <= 0: + return False + + if n in f: + return True + + sumation = sum(f) + + if n > sumation: + return False + + if n == sumation: + return True + + rf = f.copy() + i, j = 0, len(rf) - 1 + + while i < j: + rf[i], rf[j] = rf[j], rf[i] + i += 1 + j -= 1 + + rf = rf[1:] + return soms(n - f[len(f) - 1], rf) or soms(n, rf) + + +def main(): + s = [] + a = [] + + sf = "\nStopped checking after finding %d sequential non-gaps after the final gap of %d\n" + + i, g = 1, 1 + + while g >= (i >> 1): + r = int(math.sqrt(i)) + + if r * r == i: + s.append(i) + + if not soms(i, s): + g = i + a.append(g) + + i += 1 + + print("Numbers which are not the sum of distinct squares:") + print(a) + print(sf % (i - g, g), end="") + print("Found %d in total" % len(a)) + + +if __name__ == "__main__": + main() diff --git a/Task/Numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors/PascalABC.NET/numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors.pas b/Task/Numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors/PascalABC.NET/numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors.pas new file mode 100644 index 0000000000..6ae05f2f00 --- /dev/null +++ b/Task/Numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors/PascalABC.NET/numbers-which-are-the-cube-roots-of-the-product-of-their-proper-divisors.pas @@ -0,0 +1,28 @@ +function ProperDivisorsProduct(n: int64): int64; +begin + result := 1; + var d := 2; + repeat + if n mod d = 0 then + begin + result *= d; + var q := n div d; + if q <> d then result *= q; + end; + d += 1; + until d * d > n; +end; + +function a111398(): sequence of int64; +begin + foreach var n: int64 in 1.step do + if n * n * n = ProperDivisorsProduct(n) then yield n; +end; + +begin + foreach var n in a111398.Take(50) index i do + write(n:4, if (i + 1) mod 10 = 0 then #10 else ''); + writeln; + foreach var n in |500, 5000, 50000| do + writeln(n:5, ' ', a111398.ElementAt(n - 1)); +end. diff --git a/Task/Numbers-with-equal-rises-and-falls/PascalABC.NET/numbers-with-equal-rises-and-falls.pas b/Task/Numbers-with-equal-rises-and-falls/PascalABC.NET/numbers-with-equal-rises-and-falls.pas new file mode 100644 index 0000000000..ee7120586d --- /dev/null +++ b/Task/Numbers-with-equal-rises-and-falls/PascalABC.NET/numbers-with-equal-rises-and-falls.pas @@ -0,0 +1,17 @@ +function a296712(): sequence of integer; +begin + foreach var n in 1.step do + if n.ToString + .Pairwise((x, y) -> (if x > y then 1 else if x < y then -1 else 0)) + .Sum = 0 then + yield n; +end; + +begin + println('The first 200 numbers are:'); + a296712.Take(200).Print; + println; + println; + println('The 10,000,000th number is:'); + a296712.ElementAt(10_000_000 - 1).Println; +end. diff --git a/Task/Numeric-error-propagation/PascalABC.NET/numeric-error-propagation.pas b/Task/Numeric-error-propagation/PascalABC.NET/numeric-error-propagation.pas new file mode 100644 index 0000000000..60bc6aba5e --- /dev/null +++ b/Task/Numeric-error-propagation/PascalABC.NET/numeric-error-propagation.pas @@ -0,0 +1,64 @@ +type + Approx = record + private + value, sigma: real; + public + constructor(v, s: real); + begin + value := v; + sigma := s; + end; + + class function operator-(a: Approx) := new Approx(-a.value, a.sigma); + class function operator+(a: Approx) := a; + + class function operator+(a, b: Approx) := new Approx(a.value + b.value, (a.sigma.Sqr + b.sigma.Sqr).Sqrt); + class function operator+(a: Approx; b: real) := new Approx(a.value + b, a.sigma); + class function operator+(b: real; a: Approx) := a + b; + + class function operator-(a, b: Approx) := a + (-b); + class function operator-(a: Approx; b: real) := a + (-b); + class function operator-(b: real; a: Approx) := (-a) + b; + + class function operator*(a, b: Approx): Approx; + begin + var v := a.value * b.value; + Result := new Approx(v, v * ((a.sigma / a.value).Sqr + (b.sigma / b.value).Sqr).Sqrt) + end; + + class function operator*(a: Approx; b: real) := new Approx(a.value * b, abs(a.sigma * b)); + class function operator*(b: real; a: Approx) := a * b; + + class function operator/(a, b: Approx): Approx; + begin + var v := a.value / b.value; + Result := new Approx(v, v * ((a.sigma / a.value).Sqr + (b.sigma / b.value).Sqr).Sqrt); + end; + + class function operator/(a: Approx; b: real) := new Approx(a.value / b, abs(a.sigma * b)); + class function operator/(b: real; a: Approx) := a / b; + + class function operator**(a: Approx; b: real): Approx; + begin + var v := power(a.value, b); + Result := new Approx(v, abs(v * b * a.sigma / a.value)); + end; + + function ToString: string; override; + begin + Result := Format('{0} ± {1}', value, sigma); + end; + end; + +function Sqrt(Self: Approx): Approx; extensionmethod; +begin + result := Self ** 0.5; +end; + +begin + var x1 := new Approx(100, 1.1); + var y1 := new Approx(50, 1.2); + var x2 := new Approx(200, 2.2); + var y2 := new Approx(100, 2.3); + println(((x1 - x2) ** 2 + (y1 - y2) ** 2).Sqrt); +end. diff --git a/Task/Numerical-integration/PascalABC.NET/numerical-integration.pas b/Task/Numerical-integration/PascalABC.NET/numerical-integration.pas new file mode 100644 index 0000000000..2537966410 --- /dev/null +++ b/Task/Numerical-integration/PascalABC.NET/numerical-integration.pas @@ -0,0 +1,25 @@ +function integrate(a, b: real; n: integer; f: real-> real): real; +begin + var h := (b - a) / n; + var sum: array [0..4] of real; + for var i := 0 to n - 1 do + begin + var x := a + i * h; + sum[0] += f(x); + sum[1] += f(x + h / 2.0); + sum[2] += f(x + h); + sum[3] += (f(x) + f(x + h)) / 2.0; + sum[4] += (f(x) + 4.0 * f(x + h / 2.0) + f(x + h)) / 6.0; + end; + var methods := |'LeftRect ', 'MidRect ', 'RightRect', 'Trapezium', 'Simpson '|.tolist; + for var i := 0 to 4 do + println(methods[i], ' = ', sum[i] * h); + println; +end; + +begin + integrate(0.0, 1.0, 100, x -> x * x * x); + integrate(1.0, 100.0, 1_000, x -> 1 / x); + integrate(0.0, 5000.0, 5_000_000, x -> x); + integrate(0.0, 6000.0, 6_000_000, x -> x); +end. diff --git a/Task/Odd-word-problem/PascalABC.NET/odd-word-problem.pas b/Task/Odd-word-problem/PascalABC.NET/odd-word-problem.pas new file mode 100644 index 0000000000..ff11f731ed --- /dev/null +++ b/Task/Odd-word-problem/PascalABC.NET/odd-word-problem.pas @@ -0,0 +1,33 @@ +var + alpha := ('a'..'z') + ('A'..'Z'); + +procedure reverseWord(var ch: char); +begin + var nextch := readChar(); + if nextch in alpha then reverseWord(nextch); + write(ch); + ch := nextch; +end; + +procedure normalWord(var ch: char); +begin + write(ch); + ch := readChar(); + if ch in alpha then normalWord(ch); +end; + +begin + var ch := readChar(); + + while ch <> '.' do + begin + normalWord(ch); + if ch <> '.' then + begin + write(ch); + ch := readChar(); + reverseWord(ch); + end; + end; + write(ch) +end. diff --git a/Task/Old-lady-swallowed-a-fly/Quackery/old-lady-swallowed-a-fly.quackery b/Task/Old-lady-swallowed-a-fly/Quackery/old-lady-swallowed-a-fly.quackery new file mode 100644 index 0000000000..241ec851f9 --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/Quackery/old-lady-swallowed-a-fly.quackery @@ -0,0 +1,32 @@ + [ [ table + [ say "fly" ] + [ say "spider" ] + [ say "bird" ] + [ say "cat" ] + [ say "dog" ] + [ say "goat" ] + [ say "cow" ] ] do ] is beast ( n --> ) + + [ [ table + [ say "I don't know why she swallowed a fly." ] + [ say "That wiggled and jiggled and tickled inside her." ] + [ say "How absurd to swallow a bird." ] + [ say "Imagine that, she swallowed a cat!" ] + [ say "What a hog to swallow a dog." ] + [ say "She just opened her throat and swallowed that goat." ] + [ say "I don't know how she swallowed a cow." ] ] do ] is observation ( n --> ) + + [ say "There was an old lady who swallowed a " dup beast + dup if [ cr dup observation ] + times + [ cr say "She swallowed the " i 1+ beast + say " to catch the " i beast ] + cr 0 observation + cr say "Perhaps she'll die." ] is verse ( n --> ) + + [ say "There was an old lady who swallowed a horse." + cr say "She's dead, of course." ] is coda ( --> ) + + [ 7 times [ i^ verse cr cr ] coda ] is song ( --> ) + + song diff --git a/Task/Old-lady-swallowed-a-fly/SETL/old-lady-swallowed-a-fly.setl b/Task/Old-lady-swallowed-a-fly/SETL/old-lady-swallowed-a-fly.setl new file mode 100644 index 0000000000..c98b271fea --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/SETL/old-lady-swallowed-a-fly.setl @@ -0,0 +1,26 @@ +program old_lady; + animals := ["fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse"]; + verses := [ + "I don't know why she swallowed that fly.\nPerhaps she'll die.\n", + "That wiggled and jiggled and tickled inside her!", + "How absurd to swallow a bird", + "Imagine that, she swallowed a cat", + "What a hog to swallow a dog", + "She just opened her throat and swallowed that goat", + "I don't know how she swallowed that cow", + "She's dead, of course." + ]; + + loop for i in [1..8] do + print("There was an old lady who swallowed a " + animals(i)); + print(verses(i)); + if i=8 then quit; end if; + loop for j in [i, i-1..2] do + print("She swallowed the " + animals(j) + + " to catch the " + animals(j-1)); + if j < 4 then + print(verses(j-1)); + end if; + end loop; + end loop; +end program; diff --git a/Task/One-dimensional-cellular-automata/PascalABC.NET/one-dimensional-cellular-automata.pas b/Task/One-dimensional-cellular-automata/PascalABC.NET/one-dimensional-cellular-automata.pas new file mode 100644 index 0000000000..2559c48baf --- /dev/null +++ b/Task/One-dimensional-cellular-automata/PascalABC.NET/one-dimensional-cellular-automata.pas @@ -0,0 +1,8 @@ +## +var gen := '_###_##_#_#_#_#__#__'.Select(ch -> (if ch = '#' then 1 else 0)).ToList; +loop 10 do +begin + gen.Select(n -> (if n = 1 then '#' else '_')).println; + gen := (0 + gen + 0).ToList; + gen := (1..gen.Count - 2).Select(m -> (if gen[m - 1:m + 2].Sum = 2 then 1 else 0)).ToList; +end; diff --git a/Task/One-of-n-lines-in-a-file/PascalABC.NET/one-of-n-lines-in-a-file.pas b/Task/One-of-n-lines-in-a-file/PascalABC.NET/one-of-n-lines-in-a-file.pas new file mode 100644 index 0000000000..c0ca6221be --- /dev/null +++ b/Task/One-of-n-lines-in-a-file/PascalABC.NET/one-of-n-lines-in-a-file.pas @@ -0,0 +1,18 @@ +## +function oneOfN(n: integer): integer; +begin + result := 0; + for var x := 0 to n-1 do + if random(x+1) = 0 then + result := x; +end; + +function oneOfNTest(n: integer := 10; trials: integer := 1_000_000): array of integer; +begin + result := new integer[n]; + if n >= 0 then + foreach var i in 1..trials do + result[oneOfN(n)] += 1; +end; + +oneOfNTest.println; diff --git a/Task/OpenWebNet-password/PascalABC.NET/openwebnet-password.pas b/Task/OpenWebNet-password/PascalABC.NET/openwebnet-password.pas new file mode 100644 index 0000000000..c851d1aa63 --- /dev/null +++ b/Task/OpenWebNet-password/PascalABC.NET/openwebnet-password.pas @@ -0,0 +1,47 @@ +const + INT_BITS = 32; + +function rotateLeft(n, d: longword) := (n shl d) or (n shr (INT_BITS - d)); + +function rotateRight(n, d: longword) := (n shr d) or (n shl (INT_BITS - d)); + +function ownCalcPass(password, nonce: string): longword; +begin + var start := true; + + foreach var c in nonce do + begin + if (c <> '0') and start then + begin + result := password.tointeger; + start := false; + end; + case c of + '0': ; + '1': result := rotateRight(result, 7); + '2': result := rotateRight(result, 4); + '3': result := rotateRight(result, 3); + '4': result := rotateLeft(result, 1); + '5': result := rotateLeft(result, 5); + '6': result := rotateLeft(result, 12); + '7': result := (result and $0000FF00) or result shl 24 + or (result and $00FF0000) shr 16 or (result and $FF000000) shr 8; + '8': result := result shl 16 or result shr 24 or (result and $00FF0000) shr 8; + '9': result := not result; + else raise new Exception('non-digit in nonce.'); + end; + end; +end; + +procedure testPasswordCalc(password, nonce: string; expected: longword); +begin + var res := ownCalcPass(password, nonce); + print(if res = expected then 'PASS ' else 'FAIL '); + println(password, nonce, res, expected); +end; + +begin + testPasswordCalc('12345', '603356072', 25280520); + testPasswordCalc('12345', '410501656', 119537670); + testPasswordCalc('12345', '630292165', 4269684735); +end. diff --git a/Task/Operator-precedence/PascalABC.NET/operator-precedence.pas b/Task/Operator-precedence/PascalABC.NET/operator-precedence.pas new file mode 100644 index 0000000000..a06d8ffd7a --- /dev/null +++ b/Task/Operator-precedence/PascalABC.NET/operator-precedence.pas @@ -0,0 +1,11 @@ +Table of operations priorities: + +** 1 (highest) +@, not, L , +, - (unary), new 2 +*, /, div, mod, and, shl, shr, as, is 3 ++, - (binary), or, xor 4 +.. 5 += , <> , < , > , <=, >=, in 6 +?: 7 (lowest) + +Brackets are used to change the order of operations in expressions. diff --git a/Task/Order-two-numerical-lists/PascalABC.NET/order-two-numerical-lists.pas b/Task/Order-two-numerical-lists/PascalABC.NET/order-two-numerical-lists.pas new file mode 100644 index 0000000000..2edd125b7d --- /dev/null +++ b/Task/Order-two-numerical-lists/PascalABC.NET/order-two-numerical-lists.pas @@ -0,0 +1,15 @@ +## +function operator <(a, b: List): boolean; +extensionmethod; where T: IComparable; +begin + foreach var (x, y) in Zip(a, b) do + begin + if x = y then continue; + result := x.CompareTo(y) < 0; + exit; + end; + result := a.Count < b.Count; +end; + +println(Lst(1, 2, 1, 3, 2) < Lst(1, 2, 0, 4, 4, 0, 0, 0)); +println(Lst(1, 2, 0, 4, 4, 0, 0, 0) < Lst(1, 2, 1, 3, 2)); diff --git a/Task/Ordered-words/Free-Pascal-Lazarus/ordered-words.pas b/Task/Ordered-words/Free-Pascal-Lazarus/ordered-words.pas new file mode 100644 index 0000000000..776e952f6c --- /dev/null +++ b/Task/Ordered-words/Free-Pascal-Lazarus/ordered-words.pas @@ -0,0 +1,54 @@ +Program Ordered_Words; +{$mode ObjFPC}{$H+} + +Uses +Classes; + +Const + FILENAME = 'unixdict.txt'; + +Function IsOrdered(Const S: String): boolean; + +Var + I, Len: integer; +Begin + Len := Length(S); + If Len < 2 Then + Exit(True); + For I := 2 To Len Do + If S[I] < S[I - 1] Then + Exit(False); + Result := True; +End; + +Var + WordList, OrderedWords: TStringList; + CurrentWord: string; + CurrentLength, LongestLength: integer; + +Begin + LongestLength := 0; + WordList := TStringList.Create; + OrderedWords := TStringList.Create; + + WordList.LoadFromFile(FILENAME); + For CurrentWord In WordList Do + Begin + CurrentLength := Length(CurrentWord); + If CurrentLength >= LongestLength Then + If IsOrdered(CurrentWord) Then + If CurrentLength > LongestLength Then + Begin + LongestLength := CurrentLength; + OrderedWords.Clear; + OrderedWords.Add(CurrentWord); + End + Else If CurrentLength = LongestLength Then + OrderedWords.Add(CurrentWord); + End; + For CurrentWord In OrderedWords Do + WriteLn(CurrentWord); + + WordList.Free; + OrderedWords.Free; +End. diff --git a/Task/Ordered-words/M2000-Interpreter/ordered-words.m2000 b/Task/Ordered-words/M2000-Interpreter/ordered-words.m2000 new file mode 100644 index 0000000000..a44766a0af --- /dev/null +++ b/Task/Ordered-words/M2000-Interpreter/ordered-words.m2000 @@ -0,0 +1,38 @@ +module Ordered_Words { + orderword=lambda ->{ + buffer a as integer*30 + =lambda a (s as string) -> { + if len(s)*2>len(a) then buffer a as integer*len(s) + return a, 0:=s + if len(s)=1 then =true: exit + for i=1 to len(s)-1 + if a[i-1]>a[i] then break + next i + =true + } + }() + max=2 + res=stack + document a$ + load.doc a$, "unixdict.txt" + k=doc.par(a$) + i=0 + m=Paragraph(a$, 0) + if forward(a$, m) then + while m + i++ + if i mod 20=1 then Print Over round(i/k*100,2);"%" : refresh + word=paragraph$(a$, (m)) + if orderword(word) then + if max; +begin + assert(k >= 2); + result := if n = 2 then Lst(1, 1, 1) else rn(n - 1, n + 1); + while result.Count <> k do + result.Add(result[^(n + 1):^1].Sum); +end; + +for var n := 2 to 8 do + println(n, ': ', rn(n, 15)); diff --git a/Task/Padovan-sequence/PascalABC.NET/padovan-sequence.pas b/Task/Padovan-sequence/PascalABC.NET/padovan-sequence.pas new file mode 100644 index 0000000000..41650536d6 --- /dev/null +++ b/Task/Padovan-sequence/PascalABC.NET/padovan-sequence.pas @@ -0,0 +1,71 @@ +const + PP = 1.324717957244746025960908854; + S = 1.0453567932525329623; + +var + Rules := dict(('A', string('B')), ('B', string('C')), ('C', 'AB')); + +function padovan1(n: integer): sequence of integer; +begin + // ## Yield the first 'n' Padovan values using recurrence relation. + loop min(n, 3) do yield 1; + var (a, b, c) := (1, 1, 1); + var count := 3; + while count < n do + begin + (a, b, c) := (b, c, a + b); + yield c; + count += 1; + end; +end; + +function padovan2(n: integer): sequence of integer; +begin + // ## Yield the first 'n' Padovan values using formula. + if n > 1 then yield 1; + var p := 1.0; + var count := 1; + while count < n do + begin + yield (p / S).Round; + p *= PP; + count += 1; + end; +end; + +function padovan3(n: integer): sequence of string; +begin + // ## Yield the strings produced by the L-system. + var s: string := 'A'; + var count := 0; + while count < n do + begin + yield s; + var next := string(''); + foreach var ch in s do + next += Rules[ch]; + s := next; + count += 1; + end; +end; + +begin + println('First 20 terms of the Padovan sequence:'); + println(padovan1(20)); + + var list1 := padovan1(64).ToList; + var list2 := padovan2(64).ToList; + println('The first 64 iterative and calculated values', + if list1.SequenceEqual(list2) then 'are the same.' else 'differ.'); + + println; + println('First 10 L-system strings:'); + println(padovan3(10)); + println; + println('Lengths of the 32 first L-system strings:'); + var list3 := padovan3(32).select(it -> it.Length).ToList; + list3.println; + writeln('These lengths are ', + if list3.SequenceEqual(list1[0:32]) then '' else 'not ', + 'the 32 first terms of the Padovan sequence.'); +end. diff --git a/Task/Palindrome-dates/PascalABC.NET/palindrome-dates.pas b/Task/Palindrome-dates/PascalABC.NET/palindrome-dates.pas new file mode 100644 index 0000000000..85480628cb --- /dev/null +++ b/Task/Palindrome-dates/PascalABC.NET/palindrome-dates.pas @@ -0,0 +1,23 @@ +uses system; + +function Reverse(x: integer) := x mod 10 * 10 + x div 10; + +function IsValidDate(y, m, d: integer; var date: datetime) := + DateTime.TryParse(y.tostring + '-' + m.tostring + '-' + d.tostring, date); + +function PalindromicDates(startYear: integer): sequence of datetime; +begin + var y := startyear; + repeat + var m := Reverse(y mod 100); + var d := Reverse(y div 100); + var date: datetime; + if (IsValidDate(y, m, d, date)) then yield date; + y += 1; + until false; +end; + +begin + foreach var date in PalindromicDates(2021).Take(15) do + Writeln(date.ToString('yyyy-MM-dd')); +end. diff --git a/Task/Palindrome-detection/EasyLang/palindrome-detection.easy b/Task/Palindrome-detection/EasyLang/palindrome-detection.easy index 5a80f5f29d..fa6af77dde 100644 --- a/Task/Palindrome-detection/EasyLang/palindrome-detection.easy +++ b/Task/Palindrome-detection/EasyLang/palindrome-detection.easy @@ -3,7 +3,7 @@ func$ reverse s$ . for i = 1 to len a$[] div 2 swap a$[i] a$[len a$[] - i + 1] . - return strjoin a$[] + return strjoin a$[] "" . func palin s$ . if s$ = reverse s$ diff --git a/Task/Palindrome-detection/Golfscript/palindrome-detection-2.golf b/Task/Palindrome-detection/Golfscript/palindrome-detection-2.golf index 64bf7cf402..58cdea2875 100644 --- a/Task/Palindrome-detection/Golfscript/palindrome-detection-2.golf +++ b/Task/Palindrome-detection/Golfscript/palindrome-detection-2.golf @@ -1,4 +1,3 @@ -"ABBA" pal -"a" pal -"13231+464+989=989+464+13231" pal -"123 456 789 897 654 321" pal +["ABBA" "a" +"13231+464+989=989+464+13231" +"123 456 789 897 654 321"]{pal puts}/ diff --git a/Task/Palindrome-detection/Idris/palindrome-detection-1.idris b/Task/Palindrome-detection/Idris/palindrome-detection-1.idris new file mode 100644 index 0000000000..3dbcc99256 --- /dev/null +++ b/Task/Palindrome-detection/Idris/palindrome-detection-1.idris @@ -0,0 +1,30 @@ +module Palindromes + +import Data.Primitives.Views +import Data.List +import Data.List.Views +import Data.Nat + +isPalindromeReverse : String -> Bool +isPalindromeReverse str = let cs = unpack str in cs == reverse cs + +isPalindromeReverseHalf : String -> Bool +isPalindromeReverseHalf str = + let cs = (unpack str) + n = (length str) `div` 2 + in take n cs == (take n $ reverse cs) + +isPalindromeSplit : String -> Bool +isPalindromeSplit str = + let cs = unpack str + n = length cs `div` 2 + (left, right) = bimap id reverse $ splitAt n cs + in all (uncurry (==)) $ zip left right + +isPalindromeSnoc : String -> Bool +isPalindromeSnoc str = + let cs = unpack str in go cs + where go : Eq a => List a -> Bool + go xs with (snocList xs) + go (x :: ys ++ [z]) | Snoc z (x::ys) _ = x == z && go ys + go _ | _ = True diff --git a/Task/Palindrome-detection/Idris/palindrome-detection-2.idris b/Task/Palindrome-detection/Idris/palindrome-detection-2.idris new file mode 100644 index 0000000000..734cb00569 --- /dev/null +++ b/Task/Palindrome-detection/Idris/palindrome-detection-2.idris @@ -0,0 +1,58 @@ +module PalindromesTypeLevel + +import Data.List +import Data.List.Views + + +isPalindromeDirect : (str : String) -> (str = reverse str) => Bool +isPalindromeDirect _ = True + +ipd = isPalindromeDirect "AABBAA" + +failing + ipdf = isPalindromeDirect "ABCCBB" + + +||| Proof that the list is constructed of consecutive pairs of equal elements. +||| Last element can be unpaired. +data EqualPairsInList : List a -> Type where + Nil : EqualPairsInList [] + Single : EqualPairsInList [x] + EqualPair : EqualPairsInList xs -> EqualPairsInList (x :: x :: xs) + +||| Reorders the list so that the first half is interleaved with a reversed second half. +interleaveOwnHalfReverse : List a -> List a +interleaveOwnHalfReverse [] = [] +interleaveOwnHalfReverse [x] = [x] +interleaveOwnHalfReverse (x :: y :: ys) = let (z, zs) = splitLast (y::ys) in x :: z :: interleaveOwnHalfReverse zs + where splitLast : (xs : List a) -> NonEmpty xs => (a, List a) + splitLast [x] = (x, []) + splitLast (x :: y :: ys) = let (z, zs) = splitLast (y::ys) in (z, x::zs) + +||| Precondition for checking if a list is a palindrome. +IsPalindrome : List a -> Type +IsPalindrome = EqualPairsInList . interleaveOwnHalfReverse + +||| Function for testing palindromes. Typechecks only when applied to a palindrome list. +isPalindrome : (xs : List a) -> IsPalindrome xs => Bool +isPalindrome _ = True + +||| Palindrome precondition specialized for strings. +IsPalindromeStr : String -> Type +IsPalindromeStr = IsPalindrome . unpack + +||| Function for testing string palindromes. Typechecks only when applied to a palindrome list. +isPalindromeStr : (str : String) -> IsPalindromeStr str => Bool +isPalindromeStr _ = True + + +-- Tests + +ip = isPalindrome [1, 4, 3, 1, 1, 3, 4, 1] +ips = isPalindromeStr "ABCDCBA" + +failing + ipf = isPalindrome [2, 2, 2, 3, 2, 2] + +failing + ipsf = isPalindromeStr "RBCDCBA" diff --git a/Task/Palindrome-detection/YAMLScript/palindrome-detection.ys b/Task/Palindrome-detection/YAMLScript/palindrome-detection.ys index dbf1adef7e..5faba4be6b 100644 --- a/Task/Palindrome-detection/YAMLScript/palindrome-detection.ys +++ b/Task/Palindrome-detection/YAMLScript/palindrome-detection.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(n=31337): not =: when((n:S != n:S:reverse) ' not') diff --git a/Task/Palindromic-gapful-numbers/PascalABC.NET/palindromic-gapful-numbers.pas b/Task/Palindromic-gapful-numbers/PascalABC.NET/palindromic-gapful-numbers.pas new file mode 100644 index 0000000000..b172609d71 --- /dev/null +++ b/Task/Palindromic-gapful-numbers/PascalABC.NET/palindromic-gapful-numbers.pas @@ -0,0 +1,30 @@ +function pal_gen(): sequence of BigInteger; +begin + var o := 10; + var e := 10; + repeat + var fwd_o := o.ToString; + var fwd_e := e.ToString; + var rev_o := fwd_o[^2:0:-1]; + var rev_e := fwd_e[::-1]; + var pal := Min((fwd_o + rev_o).ToBigInteger, (fwd_e + rev_e).ToBigInteger); + yield pal; + if pal.ToString.Length.IsEven then e += 1 else o += 1; + until false; +end; + +function is_gapful(n: BigInteger) := n mod (n.ToString[1].ToDigit * 10 + (n mod 10)) = 0; + +begin + writeln('palindromic gapful numbers from 1 to 20:'); + for var i := 1 to 9 do + writeln(i, ': ', pal_gen.Where(n -> is_gapful(n)).Where(n -> n mod 10 = i).Take(20)); + writeln; + writeln('palindromic gapful numbers from 86 to 100:'); + for var i := 1 to 9 do + writeln(i, ': ', pal_gen.Where(n -> is_gapful(n)).Where(n -> n mod 10 = i).Skip(85).Take(15)); + writeln; + writeln('palindromic gapful numbers from 991 to 1000:'); + for var i := 1 to 9 do + writeln(i, ': ', pal_gen.Where(n -> is_gapful(n)).Where(n -> n mod 10 = i).Skip(990).Take(10)); +end. diff --git a/Task/Pancake-numbers/00-TASK.txt b/Task/Pancake-numbers/00-TASK.txt index 37e1a1ab7c..c1308a4030 100644 --- a/Task/Pancake-numbers/00-TASK.txt +++ b/Task/Pancake-numbers/00-TASK.txt @@ -13,4 +13,3 @@ Few people know p(20), generously I shall award an extra credit for anyone doing # [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/ARM-Assembly/pancake-numbers.arm b/Task/Pancake-numbers/ARM-Assembly/pancake-numbers.arm new file mode 100644 index 0000000000..c05f240a1e --- /dev/null +++ b/Task/Pancake-numbers/ARM-Assembly/pancake-numbers.arm @@ -0,0 +1,393 @@ +/* ARM assembly Raspberry PI */ +/* program pancake number */ +/* */ + + /* REMARK 1 : this program use routines in a include file + see task Include a file language arm assembly + for the routine affichageMess conversion10 + see at end of this program the instruction include */ +/* for constantes see task include a file in arm assembly */ +/************************************/ +/* Constantes */ +/************************************/ +.include "../constantes.inc" +.equ NBPANCAKEMAX, 30 +.equ NBQUEUEITEM, 5000000 +.equ NBVALUEMAX, 15 +.equ NUMPAN, 10 + +/************************************/ +/* Macros */ +/************************************/ +//.include "../../ficmacros32.inc" @ use for developper debugging + +/*******************************************/ +/* Structures */ +/********************************************/ + +/* structure pancake flip*/ + .struct 0 +Pan_left: @ next element left + .struct Pan_left + 4 +Pan_right: @ next element right + .struct Pan_right + 4 +Pan_value: @ + .struct Pan_value + NBVALUEMAX +Pan_flips: + .struct Pan_flips + 1 @ flips counter +Pan_end: +/*********************************/ +/* Initialized data */ +/*********************************/ +.data +szMessStart: .asciz "Program 32 bits start.\n" +szMessFinOK: .asciz "Program normal end. \n" +szMessError: .asciz "ERROR array flips too small.\n" +szMessErrnotFind: .asciz "Address not find in area.\n" + +szCarriageReturn: .asciz "\n" +szMessResHead: .asciz "Pancake : @ " +szMessResLib: .asciz "Flips : @ example : " +sMessResult: .asciz " @," + +.align 4 + +QueuePancake: .skip 4 * NBQUEUEITEM +EndQueuePancake: +/*********************************/ +/* UnInitialized data */ +/*********************************/ +.bss +sZoneConv: .skip 24 +iCptMax: .skip 4 +iAdddressMax: .skip 4 +Pancakes: .skip 4 * NBPANCAKEMAX +arrayFlips: .skip Pan_end * NBQUEUEITEM + +iQueueStart: .skip 4 @ queue start pointer +iQueueEnd: .skip 4 @ queue end pointer +areaFlipTemp: .skip 4+NBVALUEMAX + + +/*********************************/ +/* code section */ +/*********************************/ +.text +.global main +main: @ entry of program + ldr r0,iAdrszMessStart + bl affichageMess + mov r4,#2 @ pancake number +1: + mov r0,r4 + bl pancakesNum + add r4,r4,#1 + cmp r4,#NUMPAN + ble 1b + + ldr r0,iAdrszMessFinOK + bl affichageMess +100: @ standard end of the program + mov r0, #0 @ return code + mov r7, #EXIT @ request to exit program + svc #0 @ perform the system call + +iAdrszCarriageReturn: .int szCarriageReturn +iAdrsMessResult: .int sMessResult +iAdrszMessStart: .int szMessStart +iAdrszMessFinOK: .int szMessFinOK +/******************************************************************/ +/* pancake Number */ +/******************************************************************/ +/* r0 contains pancake number */ +pancakesNum: @ INFO: pancakesNum + push {r2-r4,lr} + mov r4,r0 + mov r1,#1 + ldr r2,iAdriCptMax + str r1,[r2] + mov r10,#1 @ max flips counter + ldr r0,iAdrQueuePancake + ldr r1,iAdriQueueStart + str r0,[r1] + ldr r1,iAdriQueueEnd + str r0,[r1] + ldr r11,iAdrarrayFlips @ flips array item 0 + ldr r0,iAdriAdddressMax + str r11,[r0] @ init with flips array item 0 + mov r3,#0 @ init pointer + str r3,[r11,#Pan_left] + str r3,[r11,#Pan_right] + strb r3,[r11,#Pan_flips] @ init counter flips + add r6,r11,#Pan_value + mov r1,#1 +1: @ init flips area with first combinaison + str r1,[r6,r3] + add r3,r3,#1 + add r1,r1,#1 + cmp r1,r4 + ble 1b + @ init queue + ldr r0,iAdrQueuePancake + str r11,[r0] @ init with first item + add r0,r0,#4 + ldr r1,iAdriQueueEnd + str r0,[r1] + mov r12,#1 @ indice flip area + +2: + ldr r1,iAdriQueueEnd + ldr r1,[r1] @ load end queue pointer + ldr r2,iAdriQueueStart + ldr r0,[r2] @ load start queue pointer + cmp r1,r0 @ end queue ? + beq 20f + ldr r5,[r0] @ load value to start pointer + add r0,r0,#4 @ new start queue pointer + str r0,[r2] @ and store + + + add r0,r5,#Pan_flips + ldrb r9,[r0] + add r9,r9,#1 @ flip + 1 + mov r8,#1 @ poste 1 +5: @ start loop + mov r0,r5 @ address pancake area + + mov r1,#0 + mov r2,r4 + mov r3,r8 + bl flip + cmp r0,#-1 + beq 99f + mov r7,r0 @ flipped + + mov r1,r11 @ area pancake address + mov r2,r4 + mov r3,r12 + bl searchArea + cmp r0,#-1 + beq 10f @ find -> next loop + mov r3,#Pan_end + mul r6,r3,r12 + add r6,r6,r11 + cmp r0,#0 + streq r6,[r1,#Pan_left] + strne r6,[r1,#Pan_right] + strb r9,[r6,#Pan_flips] + + add r3,r6,#Pan_value + ldr r2,iAdrareaFlipTemp + add r2,r2,#Pan_value + mov r0,#0 + str r0,[r6,#Pan_left] + str r0,[r6,#Pan_right] + 6: + ldrb r1,[r2,r0] + strb r1,[r3,r0] + add r0,r0,#1 + cmp r0,r4 + blt 6b + + add r12,r12,#1 @ + ldr r0,iMaxItem + cmp r12,r0 + bge 99f + ldr r0,iAdriQueueEnd + ldr r1,[r0] @ load end queue pointer + str r6,[r1] @ add fliped in queue + add r1,r1,#4 + ldr r2,iAdrEndQueuePancake + ldr r2,[r2] + cmp r1,r2 @ maxi ? + bge 99f + + str r1,[r0] @ store next end queue pointer + cmp r9,r10 + ble 10f + mov r10,r9 + ldr r0,iAdriAdddressMax + str r7,[r0] +10: @ loops + + add r8,r8,#1 + cmp r8,r4 + blt 5b + b 2b +20: + mov r0,r4 + ldr r1,iAdrsZoneConv + bl conversion10 @ décimal conversion + add r1,r1,r0 + mov r0,#0 + strb r0,[r1] + ldr r0,iAdrszMessResHead + ldr r1,iAdrsZoneConv @ insert conversion + bl strInsertAtCharInc + bl affichageMess + mov r0,r10 + ldr r1,iAdrsZoneConv + bl conversion10 @ décimal conversion + add r1,r1,r0 + mov r0,#0 + strb r0,[r1] + ldr r0,iAdrszMessResLib + ldr r1,iAdrsZoneConv @ insert conversion + bl strInsertAtCharInc + bl affichageMess + + ldr r1,iAdriAdddressMax + ldr r0,[r1] + mov r1,r4 + bl displayTable + b 100f +98: + affregtit erreur + ldr r0,iAdrszMessErrnotFind + bl affichageMess + mov r0,#-1 +99: + ldr r0,iAdrszMessError + bl affichageMess + mov r0,#-1 +100: + pop {r2-r4,pc} +iAdrPancakes: .int Pancakes +iAdrQueuePancake: .int QueuePancake +iAdriQueueStart: .int iQueueStart +iAdriQueueEnd: .int iQueueEnd +iAdrEndQueuePancake: .int EndQueuePancake +iAdrarrayFlips: .int arrayFlips + +iAdrszMessError: .int szMessError +iAdriCptMax: .int iCptMax +iAdriAdddressMax: .int iAdddressMax +iAdrszMessErrnotFind: .int szMessErrnotFind +iAdrszMessResHead: .int szMessResHead +iAdrszMessResLib: .int szMessResLib +iMaxItem: .int NBQUEUEITEM +/******************************************************************/ +/* flip */ +/******************************************************************/ +/* r0 contains the address of table */ +/* r1 contains first start index +/* r2 contains the number of elements */ +/* r3 contains the position of flip */ +flip: @ INFO: flip + push {r1-r8,lr} @ save registers + mov r5,r0 + ldr r8,iAdrareaFlipTemp + mov r4,#Pan_value + mov r0,#0 + add r7,r8,#Pan_value + add r4,r4,r5 +1: @ copy area loop + + ldrb r6,[r4,r0] + strb r6,[r7,r0] + add r0,r0,#1 + cmp r0,r2 + blt 1b @ loop + + mov r0,r7 + cmp r3,r2 + subge r3,r2,#1 @ last index if position >= size +2: + cmp r1,r3 + bge 3f + ldrb r5,[r0,r1] @ load value first index + ldrb r6,[r0,r3] @ load value position index + strb r6,[r0,r1] @ inversion + strb r5,[r0,r3] @ + sub r3,r3,#1 + add r1,r1,#1 + b 2b +3: + mov r0,r8 @ return flip area temp +100: + pop {r1-r8,pc} +iAdrareaFlipTemp: .int areaFlipTemp +/******************************************************************/ +/* search area in table area */ +/******************************************************************/ +/* r0 contains the address area to search */ +/* r1 contains address area address +/* r2 nombre elements */ +/* r3 nombre address area */ +/* r0 return -1 if find, 0 if pointer left, 1 if pointer right */ +/* r1 return address item */ +searchArea : + push {r4-r11,lr} @ save registers + mov r7,#0 + mov r9,#Pan_end + add r10,r0,#Pan_value + mov r6,r1 +1: @ loop begin + mov r8,#0 @ indice value array + add r5,r6,#Pan_value @ load value address +2: + ldrb r4,[r10,r8] @ load one value to search + ldrb r11,[r5,r8] @ load one value to tree + add r8,r8,#1 + cmp r4,r11 @ compare value + blt 3f @ smaller + bgt 4f @ highter + cmp r8,r2 @ end value ? + blt 2b @ no -> loop + mov r0,#-1 @ equal return -1 + b 100f +3: @ smaller + ldr r4,[r6,#Pan_left] @ load left pointer + cmp r4,#0 @ end ? + movne r6,r4 + bne 1b @ loop + mov r1,r6 @ last pointer address + mov r0,#0 @ not find pointer left + b 100f +4: @ highter + ldr r4,[r6,#Pan_right] @ load right pointer + cmp r4,#0 + movne r6,r4 + bne 1b + mov r1,r6 @ last pointer address + mov r0,#1 @ not find pointer right +100: + pop {r4-r11,pc} + + +/******************************************************************/ +/* Display table elements */ +/******************************************************************/ +/* r0 contains the address of table */ +/* r1 contains elements number */ +displayTable: @ INFO: displayTable + push {r0-r3,lr} @ save registers + mov r4,r1 + add r2,r0,#Pan_value + mov r3,#0 +1: @ loop display table + ldrb r0,[r2,r3] + ldr r1,iAdrsZoneConv + bl conversion10 @ décimal conversion + add r1,r1,r0 + mov r0,#0 + strb r0,[r1] + ldr r0,iAdrsMessResult + ldr r1,iAdrsZoneConv @ insert conversion + bl strInsertAtCharInc + bl affichageMess @ display message + add r3,#1 + cmp r3,r4 + blt 1b + ldr r0,iAdrszCarriageReturn + bl affichageMess + mov r0,r2 +100: + pop {r0-r3,lr} + bx lr +iAdrsZoneConv: .int sZoneConv + +/***************************************************/ +/* ROUTINES INCLUDE */ +/***************************************************/ +.include "../affichage.inc" diff --git a/Task/Pancake-numbers/C++/pancake-numbers.cpp b/Task/Pancake-numbers/C++/pancake-numbers.cpp index 70a3d06253..e7c8202a2e 100644 --- a/Task/Pancake-numbers/C++/pancake-numbers.cpp +++ b/Task/Pancake-numbers/C++/pancake-numbers.cpp @@ -1,52 +1,49 @@ -#include -#include #include -#include -#include -#include +#include #include +#include +#include +#include +#include +#include -std::vector flip_stack(std::vector& stack, const int32_t index) { - reverse(stack.begin(), stack.begin() + index); +std::vector flip_stack(std::vector stack, const uint32_t& index) { + std::reverse(stack.begin(), stack.begin() + index); return stack; } -std::pair, int32_t> pancake(const int32_t number) { - std::vector initial_stack(number); +std::pair, uint32_t> pancake(const uint32_t& number) { + std::vector initial_stack(number); std::iota(initial_stack.begin(), initial_stack.end(), 1); - std::map, int32_t> stack_flips = { std::make_pair(initial_stack, 1) }; - std::queue> queue; + std::map, uint32_t> stack_flips = { std::make_pair(initial_stack, 0) }; + std::queue> queue; queue.push(initial_stack); while ( ! queue.empty() ) { - std::vector stack = queue.front(); + std::vector stack = queue.front(); queue.pop(); - const int32_t flips = stack_flips[stack] + 1; - for ( int i = 2; i <= number; ++i ) { - std::vector flipped = flip_stack(stack, i); - if ( stack_flips.find(flipped) == stack_flips.end() ) { + const uint32_t flips = stack_flips[stack] + 1; + for ( uint32_t i = 2; i <= number; ++i ) { + std::vector flipped = flip_stack(stack, i); + if ( ! stack_flips.contains(flipped) ) { stack_flips[flipped] = flips; queue.push(flipped); } } } - auto ptr = std::max_element( - stack_flips.begin(), stack_flips.end(), - [] ( const auto & pair1, const auto & pair2 ) { - return pair1.second < pair2.second; - } - ); + const auto ptr = std::max_element(stack_flips.begin(), stack_flips.end(), + [](const auto& pair1, const auto& pair2){ return pair1.second < pair2.second; }); return std::make_pair(ptr->first, ptr->second); } int main() { - for ( int32_t n = 1; n <= 9; ++n ) { - std::pair, int32_t> result = pancake(n); + for ( uint32_t n = 1; n <= 9; ++n ) { + std::pair, uint32_t> result = pancake(n); std::cout << "pancake(" << n << ") = " << std::setw(2) << result.second << ". Example ["; - for ( uint64_t i = 0; i < result.first.size() - 1; ++i ) { + for ( uint32_t i = 0; i < result.first.size() - 1; ++i ) { std::cout << result.first[i] << ", "; } std::cout << result.first.back() << "]" << std::endl; diff --git a/Task/Pancake-numbers/FreeBASIC/pancake-numbers.basic b/Task/Pancake-numbers/FreeBASIC/pancake-numbers.basic index fccbd46483..7b45c49976 100644 --- a/Task/Pancake-numbers/FreeBASIC/pancake-numbers.basic +++ b/Task/Pancake-numbers/FreeBASIC/pancake-numbers.basic @@ -1,23 +1,37 @@ -Dim As Integer num_pancakes = 20 -Dim As Integer i, j, c = 0, n - Function pancake(n As Integer) As Integer - Dim As Integer gap = 2, sum = 2, adj = -1 - While sum < n + Dim As Integer gap, pg, gapsum, adj, temp + + gap = 2 + pg = 1 + gapsum = gap + adj = -1 + While gapsum < n adj += 1 - gap = (gap * 2) - 1 - sum += gap + temp = gap + gap += pg + pg = temp + gapsum += gap Wend + Return n + adj End Function -For i = 0 To 3 - For j = 1 To 5 - n = (i * 5) + j - c += 1 - Print Using "p(##) = ## "; n; pancake(n); - If c Mod 5 = 0 Then Print - Next j +' Main program +Dim As Integer numbers(1 To 20), results(1 To 20) +Dim As Integer i, row, col, idx + +' Generate sequence 1 to 20 +For i = 1 To 20 + numbers(i) = i + results(i) = pancake(i) Next i +For row = 0 To 3 + For col = 1 To 5 + idx = row * 5 + col + Print Using "p(##) = ## "; numbers(idx); results(idx); + Next col + Print +Next row + Sleep diff --git a/Task/Pancake-numbers/Gambas/pancake-numbers.gambas b/Task/Pancake-numbers/Gambas/pancake-numbers.gambas index 5056e83a0c..042c109d2d 100644 --- a/Task/Pancake-numbers/Gambas/pancake-numbers.gambas +++ b/Task/Pancake-numbers/Gambas/pancake-numbers.gambas @@ -1,27 +1,43 @@ +Public numbers[20] As Integer +Public results[20] As Integer + Public Sub Main() - Dim i As Integer, j As Integer, c As Integer = 0, n As Integer + Dim i As Integer, row As Integer, col As Integer, idx As Integer - For i = 0 To 3 - For j = 1 To 5 - n = (i * 5) + j - c += 1 - Print "p("; Format$(n, "##"); ") = "; Format$(pancake(n), "##"); " "; - If c Mod 5 = 0 Then Print + ' Generate sequence 1 to 20 + For i = 0 To 19 + numbers[i] = i + 1 + results[i] = pancake(i + 1) + Next + + For row = 0 To 3 + For col = 0 To + idx = row * 5 + col + Print "p("; Format$(numbers[idx], "##"); ") = "; Format$(results[idx], "##"); " "; Next + Print Next End Function pancake(n As Integer) As Integer - Dim gap As Integer = 2, sum As Integer = 2, adj As Integer = -1 + Dim gap As Integer, pg As Integer, gapsum As Integer, adj As Integer, tmp As Integer - While sum < n + gap = 2 + pg = 1 + gapsum = gap + adj = -1 + + While gapsum < n adj += 1 - gap = (gap * 2) - 1 - sum += gap + tmp = gap + gap += pg + pg = tmp + gapsum += gap Wend + Return n + adj End Function diff --git a/Task/Pancake-numbers/Java/pancake-numbers-1.java b/Task/Pancake-numbers/Java/pancake-numbers-1.java index 126c595da8..a061523e2b 100644 --- a/Task/Pancake-numbers/Java/pancake-numbers-1.java +++ b/Task/Pancake-numbers/Java/pancake-numbers-1.java @@ -1,23 +1,31 @@ -public class Pancake { - private static int pancake(int n) { - int gap = 2; - int sum = 2; - int adj = -1; - while (sum < n) { - adj++; - gap = 2 * gap - 1; - sum += gap; - } - return n + adj; - } - - public static void main(String[] args) { - for (int i = 0; i < 4; i++) { - for (int j = 1; j < 6; j++) { - int n = 5 * i + j; - System.out.printf("p(%2d) = %2d ", n, pancake(n)); +public final class PancakeNumbersApproximation { + + public static void main(String[] args) { + for ( int i = 0; i < 4; i++ ) { + for ( int j = 1; j < 6; j++ ) { + final int n = 5 * i + j; + System.out.print(String.format("%s%2d%s%d%s", "p(", n, ") = ", pancake(n), "\t")); } System.out.println(); } } + + private static int pancake(int number) { + int gap = 2; + int previousGap = 1; + int sumGaps = gap; + int adjustment = -1; + + while ( sumGaps < number ) { + adjustment += 1; + final int previousGapCopy = previousGap; + previousGap = gap; + gap += previousGapCopy; + sumGaps += gap; + } + + number += adjustment; + return number; + } + } diff --git a/Task/Pancake-numbers/Java/pancake-numbers-2.java b/Task/Pancake-numbers/Java/pancake-numbers-2.java index 7c5fc884aa..87518ae864 100644 --- a/Task/Pancake-numbers/Java/pancake-numbers-2.java +++ b/Task/Pancake-numbers/Java/pancake-numbers-2.java @@ -1,47 +1,53 @@ -import static java.util.Comparator.comparing; -import static java.util.stream.Collectors.toList; - import java.util.ArrayDeque; import java.util.ArrayList; import java.util.Collections; +import java.util.Comparator; import java.util.HashMap; import java.util.List; import java.util.Map; import java.util.Queue; +import java.util.stream.Collectors; import java.util.stream.IntStream; +public final class PancakeNumbers { -public class Pancake { + public static void main(String[] args) { + for ( int n = 1; n <= 9; n++ ) { + PancakeInfo result = pancake(n); + System.out.println(String.format("%s%2d%s", "Pancake(", result.index, "). Example " + result.pancake)); + } + } + + private static PancakeInfo pancake(int number) { + List initialStack = IntStream.rangeClosed(1, number).boxed().collect(Collectors.toList()); + Map, Integer> stackFlips = new HashMap, Integer>(); + stackFlips.put(initialStack, 0); + Queue> queue = new ArrayDeque>(); + queue.add(initialStack); + + while ( ! queue.isEmpty() ) { + List stack = queue.remove(); - private static List flipStack(List stack, int spatula) { - List copy = new ArrayList<>(stack); - Collections.reverse(copy.subList(0, spatula)); + final int flipCount = stackFlips.get(stack) + 1; + for ( int i = 2; i <= number; i++ ) { + List flipped = flipStack(stack, i); + if ( stackFlips.putIfAbsent(flipped, flipCount) == null ) { + queue.add(flipped); + } + } + } + + Map.Entry, Integer> entry = + stackFlips.entrySet().stream().max(Comparator.comparing( e -> e.getValue() )).get(); + return new PancakeInfo(entry.getKey(), entry.getValue()); + } + + private static List flipStack(List stack, int index) { + List copy = new ArrayList(stack); + Collections.reverse(copy.subList(0, index)); return copy; } + + private static record PancakeInfo(List pancake, int index) {} - private static Map.Entry, Integer> pancake(int n) { - List initialStack = IntStream.rangeClosed(1, n).boxed().collect(toList()); - Map, Integer> stackFlips = new HashMap<>(); - stackFlips.put(initialStack, 1); - Queue> queue = new ArrayDeque<>(); - queue.add(initialStack); - while (!queue.isEmpty()) { - List stack = queue.remove(); - int flips = stackFlips.get(stack) + 1; - for (int i = 2; i <= n; ++i) { - List flipped = flipStack(stack, i); - if (stackFlips.putIfAbsent(flipped, flips) == null) { - queue.add(flipped); - } - } - } - return stackFlips.entrySet().stream().max(comparing(e -> e.getValue())).get(); - } - - public static void main(String[] args) { - for (int i = 1; i <= 10; ++i) { - Map.Entry, Integer> result = pancake(i); - System.out.printf("pancake(%s) = %s. Example: %s\n", i, result.getValue(), result.getKey()); - } - } } diff --git a/Task/Pancake-numbers/Scala/pancake-numbers.scala b/Task/Pancake-numbers/Scala/pancake-numbers-1.scala similarity index 100% rename from Task/Pancake-numbers/Scala/pancake-numbers.scala rename to Task/Pancake-numbers/Scala/pancake-numbers-1.scala diff --git a/Task/Pancake-numbers/Scala/pancake-numbers-2.scala b/Task/Pancake-numbers/Scala/pancake-numbers-2.scala new file mode 100644 index 0000000000..349ada38f3 --- /dev/null +++ b/Task/Pancake-numbers/Scala/pancake-numbers-2.scala @@ -0,0 +1,29 @@ +object PancakeNumbers extends App: + + private def pancake(n: Int): Int = + var gap = 2 + var sum = 2 + var adj = -1 + + while (sum < n) { + adj += 1 + gap = gap * 2 - 1 + sum += gap + } + + n + adj + + private def formatPancakeNumbers(maxN: Int, perRow: Int): List[String] = + (1 to maxN).toList + .grouped(perRow) + .map { group => + group.map(n => f"p($n%2d) = ${pancake(n)}%2d").mkString(" ") + } + .toList + + private def runPancakeNumbers(): Unit = + val maxN = 20 + val formattedOutput = formatPancakeNumbers(maxN, perRow = 5) + formattedOutput.foreach(println) + + runPancakeNumbers() diff --git a/Task/Parallel-calculations/Scala/parallel-calculations.scala b/Task/Parallel-calculations/Scala/parallel-calculations.scala new file mode 100644 index 0000000000..45f3446d7b --- /dev/null +++ b/Task/Parallel-calculations/Scala/parallel-calculations.scala @@ -0,0 +1,56 @@ +import scala.collection.parallel.CollectionConverters._ + +case class PrimeFactorInfo( + number: Int, + smallestPrimeFactor: Int, + primeFactors: List[Int] + ) + +def isPrime(n: Int): Boolean = { + @annotation.tailrec + def checkDivisor(d: Int): Boolean = { + if (d * d > n) true + else if (n % d == 0) false + else checkDivisor(d + 2) + } + + if (n < 2) false + else if (n == 2 || n == 3) true + else if (n % 2 == 0 || n % 3 == 0) false + else checkDivisor(5) +} + +def primeFactorInfo(n: Int): PrimeFactorInfo = { + require(n > 1, "Number must be more than one") + + @annotation.tailrec + def factorize(num: Int, currentFactor: Int = 2, factors: List[Int] = Nil): List[Int] = { + if (num == 1) factors.reverse + else if (isPrime(num)) (num :: factors).reverse + else if (num % currentFactor == 0) factorize(num / currentFactor, currentFactor, currentFactor :: factors) + else { + val nextFactor = if (currentFactor == 2) 3 else currentFactor + 2 + factorize(num, nextFactor, factors) + } + } + + val factors = if (isPrime(n)) List(n) + else factorize(n).sorted + + PrimeFactorInfo(n, factors.min, factors) +} + +object ParallelCalculations extends App { + + private val numbers: List[Int] = List( + 12757923, 12878611, 12878893, 12757923, 15808973, 15780709, 197622519 + ) + private val info: List[PrimeFactorInfo] = numbers.par.map(primeFactorInfo).toList + private val maxFactor: Int = info.map(_.smallestPrimeFactor).max + private val results: List[PrimeFactorInfo] = info.filter(_.smallestPrimeFactor == maxFactor) + + println(s"The following number(s) have the largest minimal prime factor of $maxFactor:") + results.foreach { result => + println(s" ${result.number} whose prime factors are ${result.primeFactors.mkString(", ")}") + } +} diff --git a/Task/Parametric-polymorphism/Python/parametric-polymorphism-1.py b/Task/Parametric-polymorphism/Python/parametric-polymorphism-1.py new file mode 100644 index 0000000000..a99472d43d --- /dev/null +++ b/Task/Parametric-polymorphism/Python/parametric-polymorphism-1.py @@ -0,0 +1,38 @@ +"""Parametric polymorphism. Requires Python >= 3.9.""" + +from typing import Callable +from typing import Generic +from typing import Iterable +from typing import TypeVar +from typing import Union + +T = TypeVar("T") + + +class Tree(Generic[T]): + def __init__(self, value: T): + self.value = value + self.left: Union[Tree[T], None] = None + self.right: Union[Tree[T], None] = None + + def map(self, func: Callable[[T], T]) -> Iterable[T]: + yield func(self.value) + if self.left is not None: + yield from self.left.map(func) + if self.right is not None: + yield from self.right.map(func) + + +if __name__ == "__main__": + tree = Tree(7) + tree.left = Tree(42) + tree.right = Tree(101) + tree.right.left = Tree(1) + + # Fails static type checking as "foo" is not an int. + # tree.left.left = Tree[int]("foo") + + # Fails static type checking as Tree[str] is not Tree[int] + # tree.left.left = Tree("bar") + + print(list(tree.map(lambda v: v + 1))) # [8, 43, 102, 2] diff --git a/Task/Parametric-polymorphism/Python/parametric-polymorphism-2.py b/Task/Parametric-polymorphism/Python/parametric-polymorphism-2.py new file mode 100644 index 0000000000..25762e97ef --- /dev/null +++ b/Task/Parametric-polymorphism/Python/parametric-polymorphism-2.py @@ -0,0 +1,33 @@ +"""Parametric polymorphism. Requires Python >= 3.12.""" + +from typing import Callable +from typing import Iterable + + +class Tree[T]: + def __init__(self, value: T): + self.value = value + self.left: Tree[T] | None = None + self.right: Tree[T] | None = None + + def map(self, func: Callable[[T], T]) -> Iterable[T]: + yield func(self.value) + if self.left is not None: + yield from self.left.map(func) + if self.right is not None: + yield from self.right.map(func) + + +if __name__ == "__main__": + tree = Tree(7) + tree.left = Tree(42) + tree.right = Tree(101) + tree.right.left = Tree(1) + + # Fails static type checking as "foo" is not an int. + # tree.left.left = Tree[int]("foo") + + # Fails static type checking as Tree[str] is not Tree[int] + # tree.left.left = Tree("bar") + + print(list(tree.map(lambda v: v + 1))) # [8, 43, 102, 2] diff --git a/Task/Parametric-polymorphism/Zig/parametric-polymorphism.zig b/Task/Parametric-polymorphism/Zig/parametric-polymorphism.zig new file mode 100644 index 0000000000..92e3d00840 --- /dev/null +++ b/Task/Parametric-polymorphism/Zig/parametric-polymorphism.zig @@ -0,0 +1,33 @@ +const std = @import("std"); + +pub fn main() void { + var tree = Tree(u8).init(10); + std.debug.print("Before: {}\n", .{tree.value}); + tree.replace_all(65); + std.debug.print("After: {}\n", .{tree.value}); + +} + +pub fn Tree(T: type) type { + + return struct { + const Self = @This(); + value: T, + left: ?*Self, + right: ?*Self, + + pub fn init(value: T) Self { + return Self{ + .value = value, + .left = null, + .right = null, + }; + } + + pub fn replace_all(self: *Self, value: T) void { + self.value = value; + if (self.left) |_| self.left.?.replace_all(value); + if (self.right) |_| self.right.?.replace_all(value); + } + }; +} diff --git a/Task/Parsing-RPN-calculator-algorithm/Lua/parsing-rpn-calculator-algorithm.lua b/Task/Parsing-RPN-calculator-algorithm/Lua/parsing-rpn-calculator-algorithm.lua deleted file mode 100644 index fe4c77654b..0000000000 --- a/Task/Parsing-RPN-calculator-algorithm/Lua/parsing-rpn-calculator-algorithm.lua +++ /dev/null @@ -1,52 +0,0 @@ -local stack = {} -function push( a ) table.insert( stack, 1, a ) end -function pop() - if #stack == 0 then return nil end - return table.remove( stack, 1 ) -end -function writeStack() - for i = #stack, 1, -1 do - io.write( stack[i], " " ) - end - print() -end -function operate( a ) - local s - if a == "+" then - push( pop() + pop() ) - io.write( a .. "\tadd\t" ); writeStack() - elseif a == "-" then - s = pop(); push( pop() - s ) - io.write( a .. "\tsub\t" ); writeStack() - elseif a == "*" then - push( pop() * pop() ) - io.write( a .. "\tmul\t" ); writeStack() - elseif a == "/" then - s = pop(); push( pop() / s ) - io.write( a .. "\tdiv\t" ); writeStack() - elseif a == "^" then - s = pop(); push( pop() ^ s ) - io.write( a .. "\tpow\t" ); writeStack() - elseif a == "%" then - s = pop(); push( pop() % s ) - io.write( a .. "\tmod\t" ); writeStack() - else - push( tonumber( a ) ) - io.write( a .. "\tpush\t" ); writeStack() - end -end -function calc( s ) - local t, a = "", "" - print( "\nINPUT", "OP", "STACK" ) - for i = 1, #s do - a = s:sub( i, i ) - if a == " " then operate( t ); t = "" - else t = t .. a - end - end - if a ~= "" then operate( a ) end - print( string.format( "\nresult: %.13f", pop() ) ) -end ---[[ entry point ]]-- -calc( "3 4 2 * 1 5 - 2 3 ^ ^ / +" ) -calc( "22 11 *" ) diff --git a/Task/Partition-function-P/ALGOL-68/partition-function-p.alg b/Task/Partition-function-P/ALGOL-68/partition-function-p.alg new file mode 100644 index 0000000000..fccba86274 --- /dev/null +++ b/Task/Partition-function-P/ALGOL-68/partition-function-p.alg @@ -0,0 +1,46 @@ +BEGIN # calculate the partition function of some integers # + # translated from the FreeBASIC sample # + PR precision 128 PR # set the number of digits for LONG LONG INT # + MODE PARTINT = LONG LONG INT; + PROC partitions p = ( INT n )PARTINT: + BEGIN + [ 0 : n ]PARTINT p; FOR i FROM LWB p TO UPB p DO p[ i ] := 0 OD; + p[ 0 ] := 1; + FOR i TO n DO + INT k := 0; + WHILE k +:= 1; + INT j := ( k * ( 3 * k - 1 ) ) OVER 2; + IF j > i + THEN FALSE # exit the loop # + ELSE IF ODD k THEN + p[ i ] +:= p[ i - j ] + ELSE + p[ i ] -:= p[ i - j ] + FI; + j +:= k; + IF j > i + THEN FALSE # exit the loop # + ELSE IF ODD k THEN + p[ i ] +:= p[ i - j ] + ELSE + p[ i ] -:= p[ i - j ] + FI; + TRUE # continue to loop # + FI + FI + DO SKIP OD + OD; + p[ n ] + END # partitions p # ; + + BEGIN + print( ( "P(0..12):" ) ); + FOR x FROM 0 TO 12 DO + print( ( " ", whole( partitions p( x ), 0 ) ) ) + OD; + print( ( newline, "P(127): ", whole( partitions p( 127 ), 0 ) ) ); + print( ( newline, "P(255): ", whole( partitions p( 255 ), 0 ) ) ); + print( ( newline, "P(6666): ", whole( partitions p( 6666 ), 0 ) ) ); + print( ( newline ) ) + END +END diff --git a/Task/Partition-function-P/Haskell/partition-function-p.hs b/Task/Partition-function-P/Haskell/partition-function-p-1.hs similarity index 100% rename from Task/Partition-function-P/Haskell/partition-function-p.hs rename to Task/Partition-function-P/Haskell/partition-function-p-1.hs diff --git a/Task/Partition-function-P/Haskell/partition-function-p-2.hs b/Task/Partition-function-P/Haskell/partition-function-p-2.hs new file mode 100644 index 0000000000..7990f93ed9 --- /dev/null +++ b/Task/Partition-function-P/Haskell/partition-function-p-2.hs @@ -0,0 +1,2 @@ +part = 1 : b 1 + where b n = p where p = zipWith (+) (1 : b (n + 1)) (replicate n 0 ++ p) diff --git a/Task/Partition-function-P/Haskell/partition-function-p-3.hs b/Task/Partition-function-P/Haskell/partition-function-p-3.hs new file mode 100644 index 0000000000..763b5b3f73 --- /dev/null +++ b/Task/Partition-function-P/Haskell/partition-function-p-3.hs @@ -0,0 +1,6 @@ +ghci> take 30 part +[1,1,2,3,5,7,11,15,22,30,42,56,77,101,135,176,231,297,385,490,627,792,1002,1255,1575,1958,2436,3010,3718,4565] +ghci> :set +s +ghci> part !! 6666 +193655306161707661080005073394486091998480950338405932486880600467114423441282418165863 +(4.89 secs, 5,214,048,336 bytes) diff --git a/Task/Partition-function-P/J/partition-function-p.j b/Task/Partition-function-P/J/partition-function-p-1.j similarity index 100% rename from Task/Partition-function-P/J/partition-function-p.j rename to Task/Partition-function-P/J/partition-function-p-1.j diff --git a/Task/Partition-function-P/J/partition-function-p-2.j b/Task/Partition-function-P/J/partition-function-p-2.j new file mode 100644 index 0000000000..e2219223e7 --- /dev/null +++ b/Task/Partition-function-P/J/partition-function-p-2.j @@ -0,0 +1 @@ +{{ {: (y{. +//.@(*/) )/ (0=}.|/])@i. @ >:y}} diff --git a/Task/Partition-function-P/J/partition-function-p-3.j b/Task/Partition-function-P/J/partition-function-p-3.j new file mode 100644 index 0000000000..955870d33f --- /dev/null +++ b/Task/Partition-function-P/J/partition-function-p-3.j @@ -0,0 +1,2 @@ + {{ {: (y{. +//.@(*/) )/ (x:(0=}.|/])@i. @ >:y)}} 666 +11393868451739000294452939 diff --git a/Task/Partition-function-P/SETL/partition-function-p.setl b/Task/Partition-function-P/SETL/partition-function-p.setl new file mode 100644 index 0000000000..faa0dd6601 --- /dev/null +++ b/Task/Partition-function-P/SETL/partition-function-p.setl @@ -0,0 +1,36 @@ +program partition_function; + loop for n in [666, 6666] do + show_partition_with_time(n); + end loop; + + proc show_partition_with_time(n); + s := clock; + p := partition(n); + d := (clock - s) / 1000; + print("p(" + str n + ") = " + str p + " (" + str d + "s)"); + end proc; + + proc partition(n); + pn := [1,1]; + loop for i in [3..n+2] do + pn(i) := 0; + loop init k := 1; step k +:= 1; do + penta := k * (3 * k-1) div 2; + if penta >= i-1 then quit; end if; + if k mod 2 = 1 then + pn(i) +:= pn(i-penta); + else + pn(i) -:= pn(i-penta); + end if; + penta +:= k; + if penta >= i-1 then quit; end if; + if k mod 2 = 1 then + pn(i) +:= pn(i-penta); + else + pn(i) -:= pn(i-penta); + end if; + end loop; + end loop; + return pn(n+2); + end proc; +end program; diff --git a/Task/Pascals-triangle/FutureBasic/pascals-triangle.basic b/Task/Pascals-triangle/FutureBasic/pascals-triangle.basic new file mode 100644 index 0000000000..5f71055f27 --- /dev/null +++ b/Task/Pascals-triangle/FutureBasic/pascals-triangle.basic @@ -0,0 +1,20 @@ +include "NSLog.incl" +NSLogSetTitle( @"Pascal's Triangle" ) +NSLogSetTextAlignment( NSTextAlignmentCenter ) + +clear local fn pyramid( n as int ) + int v( 20, 20 ) + v( 0, 1 ) = 1 + nslog( @"\n 1 " ) + for int y = 1 to n -1 + for int x = 1 to y + 1 + v( y, x ) = v( y - 1, x - 1 ) + v( y - 1, x ) + nslog( @"%4d \b", v( y, x ) ) + next + nslog( @"" ) + next +end fn + +fn pyramid( 15 ) + +handleevents diff --git a/Task/Pathological-floating-point-problems/EasyLang/pathological-floating-point-problems.easy b/Task/Pathological-floating-point-problems/EasyLang/pathological-floating-point-problems.easy index cc6ad6edbf..efa8b72473 100644 --- a/Task/Pathological-floating-point-problems/EasyLang/pathological-floating-point-problems.easy +++ b/Task/Pathological-floating-point-problems/EasyLang/pathological-floating-point-problems.easy @@ -46,6 +46,6 @@ proc task2ok . . mul i bal bal$[] bal -= 1 . - print "Balance after 25 years: $" & bal & "." & substr strjoin bal$[] 1 16 + print "Balance after 25 years: $" & bal & "." & substr strjoin bal$[] "" 1 16 . task2ok diff --git a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-1.jq b/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-1.jq index eea1e73398..7bfc030148 100644 --- a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-1.jq +++ b/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-1.jq @@ -1,17 +1,9 @@ -# Input: the value at which to compute v +# A (naive) limitless generator def v: - # Input: cache - # Output: updated cache - def v_(n): - (n|tostring) as $s - | . as $cache - | if ($cache | has($s)) then . - else if n == 1 then $cache["1"] = 2 - elif n == 2 then $cache["2"] = -4 - else ($cache | v_(n-1) | v_(n - 2)) as $new - | $new[(n-1)|tostring] as $x - | $new[(n-2)|tostring] as $y - | $new + {($s): ((111 - (1130 / $x) + (3000 / ($x * $y)))) } - end - end; - . as $m | {} | v_($m) | .[($m|tostring)] ; + [2, -4] + | recurse( [.[1], 111 - (1130 / .[1]) + 3000 / (.[0] * .[1])] ) + | .[0]; + +[limit(100; v)] +| (3, 4, 5, 6, 7, 8, 20, 30, 50, 100) as $i +| [$i, .[$i - 1]] diff --git a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-2.jq b/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-2.jq index 64e4ca8c42..c25a7af901 100644 --- a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-2.jq +++ b/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-2.jq @@ -1 +1,11 @@ -(3,4,5,6,7,8,20,30,50,100) | v +# Given the balance in the prior year, compute the new balance in year n. +# Input: { e: m, c: n } representing m*e + n +def new_balance(n): + if n == 0 then {e: 1, c: -1} + else {e: (.e * n), c: (.c * n - 1) } + end; + +def balance(n): + def e: 1|exp; + reduce range(0;n) as $i ({}; new_balance($i) ) + | (.e * e) + .c; diff --git a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-3.jq b/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-3.jq index c25a7af901..45c0ab4f6c 100644 --- a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-3.jq +++ b/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-3.jq @@ -1,11 +1 @@ -# Given the balance in the prior year, compute the new balance in year n. -# Input: { e: m, c: n } representing m*e + n -def new_balance(n): - if n == 0 then {e: 1, c: -1} - else {e: (.e * n), c: (.c * n - 1) } - end; - -def balance(n): - def e: 1|exp; - reduce range(0;n) as $i ({}; new_balance($i) ) - | (.e * e) + .c; +balance(25) diff --git a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-4.jq b/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-4.jq deleted file mode 100644 index 45c0ab4f6c..0000000000 --- a/Task/Pathological-floating-point-problems/Jq/pathological-floating-point-problems-4.jq +++ /dev/null @@ -1 +0,0 @@ -balance(25) diff --git a/Task/Peano-curve/ALGOL-68/peano-curve.alg b/Task/Peano-curve/ALGOL-68/peano-curve.alg index bc5d4c2bbb..2f62d20b9a 100644 --- a/Task/Peano-curve/ALGOL-68/peano-curve.alg +++ b/Task/Peano-curve/ALGOL-68/peano-curve.alg @@ -53,7 +53,7 @@ BEGIN # Peano Curve in SVG # put( svg file, ( "'/>", newline, "", newline ) ); close( svg file ) - FI # sierpinski square # ; + FI # peano curve # ; peano curve( "peano.svg", 1200, 12, 3, 50, 50 ) diff --git a/Task/Peano-curve/C/peano-curve.c b/Task/Peano-curve/C/peano-curve.c index 7d70c91302..50e63f94c6 100644 --- a/Task/Peano-curve/C/peano-curve.c +++ b/Task/Peano-curve/C/peano-curve.c @@ -1,35 +1,82 @@ -/*Abhishek Ghosh, 14th September 2018*/ +#include -#include -#include +#include +#include -void Peano(int x, int y, int lg, int i1, int i2) { +/* should be a power of 3 e.g. 1, 3, 9, 27, 81, 243, 729 */ +const int peano_width = 81; +/* the window is a square */ +const int window_side_len = 800; + +void +peano(sfVertexArray *verts, int x, int y, int lg, int i1, int i2) +{ + /* initial x, initial y, curve width (3^m), initial i1, initial i2 */ if (lg == 1) { - lineto(3*x,3*y); + sfVertex v; + v.position.x = 12.0 * x; /* multiply by 12 to scale-up the curve */ + v.position.y = 12.0 * y; + v.color = sfWhite; + sfVertexArray_append(verts, v); return; } - lg = lg/3; - Peano(x+(2*i1*lg), y+(2*i1*lg), lg, i1, i2); - Peano(x+((i1-i2+1)*lg), y+((i1+i2)*lg), lg, i1, 1-i2); - Peano(x+lg, y+lg, lg, i1, 1-i2); - Peano(x+((i1+i2)*lg), y+((i1-i2+1)*lg), lg, 1-i1, 1-i2); - Peano(x+(2*i2*lg), y+(2*(1-i2)*lg), lg, i1, i2); - Peano(x+((1+i2-i1)*lg), y+((2-i1-i2)*lg), lg, i1, i2); - Peano(x+(2*(1-i1)*lg), y+(2*(1-i1)*lg), lg, i1, i2); - Peano(x+((2-i1-i2)*lg), y+((1+i2-i1)*lg), lg, 1-i1, i2); - Peano(x+(2*(1-i2)*lg), y+(2*i2*lg), lg, 1-i1, i2); + + peano(verts, x+(2*i1*lg), y+(2*i1*lg), lg, i1, i2); + peano(verts, x+((i1-i2+1)*lg), y+((i1+i2)*lg), lg, i1, 1-i2); + peano(verts, x+lg, y+lg, lg, i1, 1-i2); + peano(verts, x+((i1+i2)*lg), y+((i1-i2+1)*lg), lg, 1-i1, 1-i2); + peano(verts, x+(2*i2*lg), y+(2*(1-i2)*lg), lg, i1, i2); + peano(verts, x+((1+i2-i1)*lg), y+((2-i1-i2)*lg), lg, i1, i2); + peano(verts, x+(2*(1-i1)*lg), y+(2*(1-i1)*lg), lg, i1, i2); + peano(verts, x+((2-i1-i2)*lg), y+((1+i2-i1)*lg), lg, 1-i1, i2); + peano(verts, x+(2*(1-i2)*lg), y+(2*i2*lg), lg, 1-i1, i2); } -int main(void) { +int +main(void) +{ + sfVideoMode mode = {window_side_len, window_side_len, 32}; + sfRenderWindow* window; + sfEvent event; + sfVideoMode vidmode; + sfVector2i winpos; + sfVertexArray *verts; - initwindow(1000,1000,"Peano, Peano"); + /* this will end up holding peano_width^2 vertices */ + verts = sfVertexArray_create(); + sfVertexArray_setPrimitiveType(verts, sfLineStrip); - Peano(0, 0, 1000, 0, 0); /* Start Peano recursion. */ - - getch(); - cleardevice(); - - return 0; + /* Create the main window */ + window = sfRenderWindow_create(mode, "Peano Curve", sfResize | sfClose, NULL); + if (!window) + return EXIT_FAILURE; + + /* Centre the window */ + vidmode = sfVideoMode_getDesktopMode(); + winpos.x = vidmode.width/2 - window_side_len/2; + winpos.y = vidmode.height/2 - window_side_len/2; + sfRenderWindow_setPosition(window, winpos); + + /* Generate the vertices */ + peano(verts, 0, 0, peano_width, 0, 0); + + /* Start the event loop */ + while (sfRenderWindow_isOpen(window)) { + /* Process events */ + while (sfRenderWindow_pollEvent(window, &event)) { + /* Close window : exit */ + if (event.type == sfEvtClosed) + sfRenderWindow_close(window); + } + + sfRenderWindow_clear(window, sfBlack); + /* Render the line */ + sfRenderWindow_drawVertexArray(window, verts, NULL); + sfRenderWindow_display(window); + } + sfRenderWindow_destroy(window); + + return EXIT_SUCCESS; } diff --git a/Task/Pell-numbers/Sidef/pell-numbers.sidef b/Task/Pell-numbers/Sidef/pell-numbers.sidef new file mode 100644 index 0000000000..592a4136e6 --- /dev/null +++ b/Task/Pell-numbers/Sidef/pell-numbers.sidef @@ -0,0 +1,31 @@ +func pell_number(n) { + lucasU(2, -1, n) +} + +func pell_lucas_number(n) { + lucasV(2, -1, n) +} + +say ("The first 10 Pell numbers: ", 10.of(pell_number).join(", ")) +say ("The first 10 Pell-Lucas numbers: ", 10.of(pell_lucas_number).join(", ")) + +say "\nFirst 10 rational approximations to √2:" +{|n| pell_lucas_number(n) / 2 / pell_number(n) }.map(1..10).each {|r| + say "#{'%10s' % r.as_frac} =~ #{r.as_float}" +} + +var pell_prime_indices = 10.by {|n| pell_number(n).is_prime } +say "\nThe first 10 Pell primes: " +pell_prime_indices.each {|n| + say "Pell(#{'%2s' % n}) = #{pell_number(n)}" +} + +say ("\nThe first 10 Newman-Shank-Williams numbers: ", + 10.of{|n| pell_number(2*n) + pell_number(2*n + 1) }.join(', ')) + +say "\nThe first 10 Pythagorean triples corresponding to near isosceles right triangles:" +10.of{|n| pell_number(2*n + 1) }.map {|h| + var t = isqrt(h**2 >> 1) + assert_eq(t**2 + (t+1)**2, h**2) + [t, t+1, h] +}.each{.say} diff --git a/Task/Pells-equation/Langur/pells-equation.langur b/Task/Pells-equation/Langur/pells-equation.langur index ec0697af10..0458436259 100644 --- a/Task/Pells-equation/Langur/pells-equation.langur +++ b/Task/Pells-equation/Langur/pells-equation.langur @@ -1,5 +1,3 @@ -val fun = fn a, b, c: [b, b * c + a] - val solvePell = fn(n) { val x = trunc(n ^/ 2) var y, z, r = x, 1, x * 2 @@ -20,9 +18,9 @@ val C = fn(x) { # format number string with commas var neg, s = "", x -> string if s[1] == '-' { - neg, s = "-", s -> rest + neg, s = "-", less(s, of=1) } - neg ~ join(",", split(-3, s)) + neg ~ join(split(s, by=-3), by=",") } for n in [61, 109, 181, 277, 8941] { diff --git a/Task/Pells-equation/Zig/pells-equation-1.zig b/Task/Pells-equation/Zig/pells-equation-1.zig new file mode 100644 index 0000000000..3ef8f0923d --- /dev/null +++ b/Task/Pells-equation/Zig/pells-equation-1.zig @@ -0,0 +1 @@ +@subWithOverflow() diff --git a/Task/Pells-equation/Zig/pells-equation-2.zig b/Task/Pells-equation/Zig/pells-equation-2.zig new file mode 100644 index 0000000000..95733d5b96 --- /dev/null +++ b/Task/Pells-equation/Zig/pells-equation-2.zig @@ -0,0 +1 @@ +u256 diff --git a/Task/Pells-equation/Zig/pells-equation-3.zig b/Task/Pells-equation/Zig/pells-equation-3.zig new file mode 100644 index 0000000000..58b298fc2f --- /dev/null +++ b/Task/Pells-equation/Zig/pells-equation-3.zig @@ -0,0 +1,60 @@ +const std = @import("std"); + +pub fn main() !void { + const writer = std.io.getStdOut().writer(); + + try printSolvedPell(61, writer); + try printSolvedPell(109, writer); + try printSolvedPell(181, writer); + try printSolvedPell(277, writer); +} + +const Pair = struct { + v1: u256, + v2: u256, + + fn init(a: u256, b: u256) Pair { + return Pair{ + .v1 = a, + .v2 = b, + }; + } +}; + +fn solvePell(n: u256) Pair { + const x: u256 = std.math.sqrt(n); + + // n is a perfect square - no solution other than 1,0 + if (x * x == n) + return Pair.init(1, 0); + + // there are non-trivial solutions + var y = x; + var z: u256 = 1; + var r = 2 * x; + var e = Pair.init(1, 0); + var f = Pair.init(0, 1); + var a: u256 = 0; + var b: u256 = 0; + + while (true) { + y = r * z - y; + z = (n - y * y) / z; + r = (x + y) / z; + e = Pair.init(e.v2, r * e.v2 + e.v1); + f = Pair.init(f.v2, r * f.v2 + f.v1); + a = e.v2 + x * f.v2; + b = f.v2; + const ov = @subWithOverflow(a * a, n * b * b); + if (ov[1] != 0) + continue; + if (ov[0] == 1) // a * a, n * b * b == 1 + break; + } + return Pair.init(a, b); +} + +fn printSolvedPell(n: u256, writer: anytype) !void { + const r = solvePell(n); + try writer.print("x^2 - {d:3} * y^2 = 1 for x = {d:21} and y = {d:19}\n", .{ n, r.v1, r.v2 }); +} diff --git a/Task/Pentagram/ALGOL-68/pentagram.alg b/Task/Pentagram/ALGOL-68/pentagram.alg new file mode 100644 index 0000000000..789e0c9999 --- /dev/null +++ b/Task/Pentagram/ALGOL-68/pentagram.alg @@ -0,0 +1,42 @@ +BEGIN # draw a pentagram, using SVG # + + OP SIND = ( REAL x )REAL: sin( x * pi / 180 ); + OP COSD = ( REAL x )REAL: cos( x * pi / 180 ); + PRIO FMT = 9; + OP FMT = ( REAL v, INT dp )STRING: + BEGIN + STRING result = IF ENTIER v = v + THEN whole( v, - dp * 16 ) + ELSE fixed( v, - dp * 16, ABS dp ) + FI; + INT v pos := LWB result; + WHILE result[ v pos ] = " " DO v pos +:= 1 OD; + result[ v pos : ] + END # FMT # ; + PROC point = ( REAL x, y )STRING: x FMT 2 + " " + y FMT 2; + + PROC draw gram = ( INT width, height, vertices, REAL side, start x, start y, line width )VOID: + BEGIN + REAL angle = 360 / vertices; + print( ( "", newline + ) + ); + REAL x := start x, y := start y; + print( ( " ", newline ) ); + print( ( "", newline ) ) + END # draw gram #; + + draw gram( 500, 300, 5, 240, 150, 50, 3 ) + +END diff --git a/Task/Pentagram/FutureBasic/pentagram.basic b/Task/Pentagram/FutureBasic/pentagram.basic new file mode 100644 index 0000000000..d42c9cbd30 --- /dev/null +++ b/Task/Pentagram/FutureBasic/pentagram.basic @@ -0,0 +1,51 @@ +_window = 1 + +void local fn DrawInView + CFMutableArrayRef points = fn MutableArrayWithCapacity( 0 ) + CGPoint ptA,ptB,ptC,ptD,ptE + float xo,yo, z, x,y, twoPi = 0.0174533 + + xo = 225 + yo = 20 + z = 340 + + ptA = fn CGPointMake( xo,yo) + x = xo - z*sin(18*TwoPi) + y = yo + z*cos(18*TwoPi) + ptB = fn CGPointMake( x,y) + ptE = fn CGPointMake( xo + z*sin(18*TwoPi),y) + x = ptB.x + z*cos(36*TwoPi) + y = ptB.y - z*sin(36*TwoPi) + ptC = fn CGPointMake( x,y) + x -= z + ptD = fn CGPointMake(x,y) + + MutableArrayAddObject( points, fn ValueWithPoint( ptA ) ) + MutableArrayAddObject( points, fn ValueWithPoint( ptB ) ) + MutableArrayAddObject( points, fn ValueWithPoint( ptC ) ) + MutableArrayAddObject( points, fn ValueWithPoint( ptD ) ) + MutableArrayAddObject( points, fn ValueWithPoint( ptE ) ) + MutableArrayAddObject( points, fn ValueWithPoint( ptA ) ) + BezierPathStrokeFillPolygon( points, 2, fn ColorBlack, fn ColorSystemBlue ) + +end fn + +void local fn BuildWindow + window _window, @"Pentagram", ( 0,0,450,400 ) + WindowCenter(_window) + WindowSubclassContentView(_window) + ViewSetFlipped( _windowContentViewTag, YES ) + ViewSetNeedsDisplay( _windowContentViewTag ) +end fn + +void local fn DoDialog( ev as long) + select ( ev ) + case _viewDrawRect : fn DrawInView + end select +end fn + +fn BuildWindow + +on dialog fn DoDialog + +HandleEvents diff --git a/Task/Percolation-Bond-percolation/FreeBASIC/percolation-bond-percolation.basic b/Task/Percolation-Bond-percolation/FreeBASIC/percolation-bond-percolation.basic new file mode 100644 index 0000000000..6e5cc21dc0 --- /dev/null +++ b/Task/Percolation-Bond-percolation/FreeBASIC/percolation-bond-percolation.basic @@ -0,0 +1,98 @@ +Randomize Timer + +Const RAND_MAX = 32767 +Const FILL = 1 +Const RWALL = 2 +Const BWALL = 4 + +Dim Shared As Integer x = 10, y = 10 +Dim Shared As Integer grid(x * (y + 2)) +Dim Shared As Integer m, n +Dim Shared As Integer cells, endPos + +Sub makeGrid(p As Double) + Dim As Integer i, j, thresh, r1, r2, r3 + + thresh = Int(p * RAND_MAX) + m = x + n = y + + For i = 0 To Ubound(grid) : grid(i) = 0 : Next + + For i = 0 To m-1: grid(i) = BWALL Or RWALL : Next + + cells = m + endPos = m + + For i = 0 To y-1 + For j = x-1 To 1 Step -1 + r1 = Int(Rnd * (RAND_MAX + 1)) + r2 = Int(Rnd * (RAND_MAX + 1)) + grid(endPos) = Iif(r1 < thresh, BWALL, 0) Or Iif(r2 < thresh, RWALL, 0) + endPos += 1 + Next + r3 = Int(Rnd * (RAND_MAX + 1)) + grid(endPos) = RWALL Or Iif(r3 < thresh, BWALL, 0) + endPos += 1 + Next +End Sub + +Sub showGrid() + Dim As Integer i, j + + For j = 0 To m-1 + Print "+--"; + Next + Print "+" + + For i = 0 To n + Print Iif(i = n, " ", "|"); + For j = 0 To m-1 + Print Iif((grid(i * m + j + cells) And FILL) <> 0, "[]", " "); + Print Iif((grid(i * m + j + cells) And RWALL) <> 0, "|", " "); + Next + Print + If i = n Then Exit Sub + For j = 0 To m-1 + Print Iif((grid(i * m + j + cells) And BWALL) <> 0, "+--", "+ "); + Next + Print "+" + Next +End Sub + +Function filled(p As Integer) As Boolean + If (grid(p) And FILL) <> 0 Then Return False + grid(p) = grid(p) Or FILL + If p >= endPos Then Return True + + Return ((grid(p + 0) And BWALL) = 0 Andalso filled(p + m)) Orelse _ + ((grid(p + 0) And RWALL) = 0 Andalso filled(p + 1)) Orelse _ + ((grid(p - 1) And RWALL) = 0 Andalso filled(p - 1)) Orelse _ + ((grid(p - m) And BWALL) = 0 Andalso filled(p - m)) +End Function + +Function percolate() As Boolean + Dim i As Integer = 0 + While i < m Andalso Not filled(cells + i) + i += 1 + Wend + Return i < m +End Function + +' Main program +makeGrid(0.5) +percolate() +showGrid() + +Print !"\nRunning " & x & " x " & y & " grids 10,000 times for each p:" +For p As Integer = 1 To 9 + Dim As Integer cnt = 0 + Dim As Double pp = p / 10 + For i As Integer = 0 To 9999 + makeGrid(pp) + If percolate() Then cnt += 1 + Next + Print Using "p = #.# : #.####"; pp; cnt / 10000 +Next + +Sleep diff --git a/Task/Perfect-numbers/Zig/perfect-numbers.zig b/Task/Perfect-numbers/Zig/perfect-numbers.zig index fc7e187815..6546be0c9b 100644 --- a/Task/Perfect-numbers/Zig/perfect-numbers.zig +++ b/Task/Perfect-numbers/Zig/perfect-numbers.zig @@ -1,8 +1,8 @@ const std = @import("std"); const expect = std.testing.expect; -const stdout = std.io.getStdOut().outStream(); pub fn main() !void { + const stdout = std.io.getStdOut().writer(); var i: u32 = 2; try stdout.print("The first few perfect numbers are: ", .{}); while (i <= 10_000) : (i += 2) if (propersum(i) == i) @@ -23,7 +23,7 @@ fn propersum(n: u32) u32 { } test "Proper divisors" { - expect(propersum(28) == 28); - expect(propersum(71) == 1); - expect(propersum(30) == 42); + try expect(propersum(28) == 28); + try expect(propersum(71) == 1); + try expect(propersum(30) == 42); } diff --git a/Task/Periodic-table/C-sharp/periodic-table.cs b/Task/Periodic-table/C-sharp/periodic-table.cs new file mode 100644 index 0000000000..68540b31df --- /dev/null +++ b/Task/Periodic-table/C-sharp/periodic-table.cs @@ -0,0 +1,35 @@ +// Periodic table +using System; + +class PeriodicTable +{ + private static readonly int[] aArray = {1, 2, 5, 13, 57, 72, 89, 104}; + private static readonly int[] bArray = {-1, 15, 25, 35, 72, 21, 58, 7}; + + public void RowAndColumn(int n, out int r, out int c) + { + int i = 7; + while (aArray[i] > n) + i--; + int m = n + bArray[i]; + r = m / 18 + 1; + c = m % 18 + 1; + } +} + +class Program +{ + public static void Main() + { + PeriodicTable pt = new PeriodicTable(); + // Example elements (atomic numbers). + int[] nums = new int[]{1, 2, 29, 42, 57, 58, 72, 89, 90, 103}; + foreach (var n in nums) + { + int r, c; + pt.RowAndColumn(n, out r, out c); + Console.Write(String.Format("{0,3:###} ->", n)); + Console.WriteLine(String.Format("{0,2:##}{1,3:###}", r, c)); + } + } +} diff --git a/Task/Periodic-table/JavaScript/periodic-table.js b/Task/Periodic-table/JavaScript/periodic-table.js new file mode 100644 index 0000000000..241c432974 --- /dev/null +++ b/Task/Periodic-table/JavaScript/periodic-table.js @@ -0,0 +1,24 @@ +// Periodic table + +class PeriodicTable { + constructor() { + this.aArray = [1, 2, 5, 13, 57, 72, 89, 104]; + this.bArray = [-1, 15, 25, 35, 72, 21, 58, 7]; + } + + rowAndColumn(n) { + var i = 7; + while (this.aArray[i] > n) + i--; + var m = n + this.bArray[i]; + return [Math.floor(m / 18) + 1, m % 18 + 1]; + } +} + +pt = new PeriodicTable(); +// Example elements (atomic numbers). +for (var n of [1, 2, 29, 42, 57, 58, 72, 89, 90, 103]) { + [r, c] = pt.rowAndColumn(n); + console.log(n.toString().padStart(3, ' ') + " ->" + + r.toString().padStart(2, ' ') + c.toString().padStart(3, ' ')); +} diff --git a/Task/Periodic-table/M2000-Interpreter/periodic-table.m2000 b/Task/Periodic-table/M2000-Interpreter/periodic-table.m2000 new file mode 100644 index 0000000000..87137341b8 --- /dev/null +++ b/Task/Periodic-table/M2000-Interpreter/periodic-table.m2000 @@ -0,0 +1,22 @@ +module Periodic_table { + Dim Element() As Integer + Element()= (1, 2, 29, 42, 57, 58, 59, 71, 72, 89, 90, 103, 113) + For I = 0 To len(Element())-1 + MostarPos(Element(I)) + Next I + Sub MostarPos(N As Integer) + Local Integer M, I, R, C + Local A() as integer, B() as integer + A() = (1, 2, 5, 13, 57, 72, 89, 104) + B() = (-1, 15, 25, 35, 72, 21, 58, 7) + I = 7 + While A(I) > N + I -= 1 + End While + M = N + B(I) + R = (M Div 18) +1 + C = (M Mod 18) +1 + Print format$("Atomic number {0:-3} -> {1}, {2}", N, R, C) + End Sub +} +Periodic_table diff --git a/Task/Periodic-table/Modula-2/periodic-table.mod2 b/Task/Periodic-table/Modula-2/periodic-table.mod2 new file mode 100644 index 0000000000..349a80a4db --- /dev/null +++ b/Task/Periodic-table/Modula-2/periodic-table.mod2 @@ -0,0 +1,39 @@ +MODULE PeriodicTable; +FROM STextIO IMPORT + WriteLn, WriteString; +FROM SWholeIO IMPORT + WriteInt; +TYPE + TAB = ARRAY [0 .. 7] OF INTEGER; + TANum = ARRAY [0 .. 9] OF INTEGER; +CONST + A = TAB{1, 2, 5, 13, 57, 72, 89, 104}; + B = TAB{-1, 15, 25, 35, 72, 21, 58, 7}; + +PROCEDURE ShowRowAndColumn(ANum: INTEGER); +VAR + I, M, R, C: CARDINAL; +BEGIN + I := 7; + WHILE A[I] > ANum DO + I := I - 1 + END; + M := ANum + B[I]; + R := M DIV 18 + 1; + C := M MOD 18 + 1; + WriteInt(ANum, 3); + WriteString(" ->"); + WriteInt(R, 2); + WriteInt(C, 3); + WriteLn; +END ShowRowAndColumn; + +VAR + J : CARDINAL; + ANum: TANum; (* Example elements (atomic numbers) *) +BEGIN + ANum := TANum{1, 2, 29, 42, 57, 58, 72, 89, 90, 103}; + FOR J := 0 TO 9 DO + ShowRowAndColumn(ANum[J]) + END +END PeriodicTable. diff --git a/Task/Peripheral-drift-illusion/Nim/peripheral-drift-illusion.nim b/Task/Peripheral-drift-illusion/Nim/peripheral-drift-illusion.nim index 7a44691a15..bbd3d9b653 100644 --- a/Task/Peripheral-drift-illusion/Nim/peripheral-drift-illusion.nim +++ b/Task/Peripheral-drift-illusion/Nim/peripheral-drift-illusion.nim @@ -1,11 +1,11 @@ -import gintro/[glib, gobject, gtk, gio, cairo] +import gtk2, glib2, gdk2, cairo const Width = 600 Height = 460 type - Color = array[3, float] + Color = (float, float, float) Edge {.pure.} = enum LT, TR, RB, BL const @@ -23,20 +23,23 @@ const [TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL], [TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT]] - Black: Color = [0.0, 0.0, 0.0] - Blue: Color = [0.2, 0.3, 1.0] - White: Color = [1.0, 1.0, 1.0] - Yellow: Color = [0.8, 0.8, 0.0] + Black: Color = (0.0, 0.0, 0.0) + Blue: Color = (0.2, 0.3, 1.0) + White: Color = (1.0, 1.0, 1.0) + Yellow: Color = (0.8, 0.8, 0.0) Colors: array[Edge, array[4, Color]] = [[White, Black, Black, White], [White, White, Black, Black], [Black, White, White, Black], [Black, Black, White, White]] -#--------------------------------------------------------------------------------------------------- -proc draw(area: DrawingArea; context: Context) = - ## Draw the pattern in the area. +template setSource(ctx: ptr Context; color: Color) = + ctx.setSourceRgb(color[0], color[1], color[2]) + + +proc draw(context: ptr Context) = + ## Draw the pattern. func line(x1, y1, x2, y2: float; color: Color) = context.setSource(color) @@ -62,34 +65,33 @@ proc draw(area: DrawingArea; context: Context) = line(px + 23, py + 23, px, py + 23, carray[2]) line(px, py + 23, px, py, carray[3]) -#--------------------------------------------------------------------------------------------------- -proc onDraw(area: DrawingArea; context: Context; data: pointer): bool = +proc onExposeEvent(area: PDrawingArea; event: PEventExpose; data: pointer): gboolean {.cdecl.} = ## Callback to draw/redraw the drawing area contents. - - area.draw(context) + let context = cairoCreate(area.window) + context.draw() result = true -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +proc onDestroyEvent(widget: PWidget; data: pointer): gboolean {.cdecl.} = + ## Process the "destroy" event. + mainQuit() - let window = app.newApplicationWindow() - window.setSizeRequest(Width, Height) - window.setTitle("Peripheral drift illusion") - # Create the drawing area. - let area = newDrawingArea() - window.add(area) +nimInit() +let window = windowNew(WINDOW_TOPLEVEL) +window.setSizeRequest(Width, Height) +window.setTitle("Peripheral drift illusion") - # Connect the "draw" event to the callback to draw the pattern. - discard area.connect("draw", ondraw, pointer(nil)) +# Create the drawing area. +let area = drawingAreaNew() +window.add area - window.showAll() +# Connect the "expose" event to the callback to draw the pattern. +discard area.signalConnect("expose-event", SIGNAL_FUNC(onExposeEvent), nil) -#——————————————————————————————————————————————————————————————————————————————————————————————————— +# Quit the application if the window is closed. +discard window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) -let app = newApplication(Application, "Rosetta.Illusion") -discard app.connect("activate", activate) -discard app.run() +window.showAll() +main() diff --git a/Task/Peripheral-drift-illusion/Octave/peripheral-drift-illusion.octave b/Task/Peripheral-drift-illusion/Octave/peripheral-drift-illusion.octave new file mode 100644 index 0000000000..b581cbab55 --- /dev/null +++ b/Task/Peripheral-drift-illusion/Octave/peripheral-drift-illusion.octave @@ -0,0 +1,69 @@ +function pdi_circle(cell_size = 50, numrows = 15, numcols = 15, radius = 15, offset = 5, rotx = 2, roty = 2, color1 = [0, 0, 255], color2 = [0, 255, 0]) +% creates peripheral drift illusion using circles +% pdi_circle(cell_size, numrows, numcols, radius, offset, rotx, roty, color1, color2) +% pdi_circle(50, 15, 15, 15, 5, 2, 2, [0, 0, 255], [0, 255, 0]) + +% color dimension +colorB = uint8([0, 0, 0]); +colorW = uint8([255, 255, 255]); +color1 = uint8(color1); +color2 = uint8(color2); + +% pixels per cell +centerC = cell_size * [1 1] / 2; +[cellX, cellY] = ndgrid(1:cell_size, 1:cell_size); +cell_ones = ones(cell_size, cell_size, "uint8"); + +% total image size +img_size = [numrows, numcols] * cell_size +final_image = zeros(img_size(1), img_size(2), 3, "uint8"); + +% offset steps +stepx = 2 * pi * rotx / numrows; +stepy = 2 * pi * roty / numcols; + +% loop over cells +for nr = 1:numrows, for nc = 1:numcols + + % find offset centers + step_phase = (nr-1) * stepx + (nc-1) * stepy; + offsetC = offset * [cos(step_phase), sin(step_phase)]; + centerB = centerC + offsetC; + centerW = centerC - offsetC; + + % fill background + image1 = cell_ones * color2(1); + image2 = cell_ones * color2(2); + image3 = cell_ones * color2(3); + + % fill white + insideW = sqrt((cellX - centerW(1)).^2 + (cellY - centerW(2)).^2) <= radius; + image1(insideW) = colorW(1); + image2(insideW) = colorW(2); + image3(insideW) = colorW(3); + + % fill black + insideB = sqrt((cellX - centerB(1)).^2 + (cellY - centerB(2)).^2) <= radius; + image1(insideB) = colorB(1); + image2(insideB) = colorB(2); + image3(insideB) = colorB(3); + + % fill foreground + insideC = sqrt((cellX - centerC(1)).^2 + (cellY - centerC(2)).^2) <= radius; + image1(insideC) = color1(1); + image2(insideC) = color1(2); + image3(insideC) = color1(3); + + % generate image + offset_image = cat(3, image1, image2, image3); + final_rows = (nr-1) * cell_size + [1:cell_size]; + final_cols = (nc-1) * cell_size + [1:cell_size]; + final_image(final_rows, final_cols, :) = offset_image; + +endfor, endfor + +% show and save image +imshow(final_image) +imwrite(final_image, "PeripheralDriftOctave.png") + +endfunction diff --git a/Task/Peripheral-drift-illusion/Python/peripheral-drift-illusion.py b/Task/Peripheral-drift-illusion/Python/peripheral-drift-illusion.py new file mode 100644 index 0000000000..c784e1f9ea --- /dev/null +++ b/Task/Peripheral-drift-illusion/Python/peripheral-drift-illusion.py @@ -0,0 +1,56 @@ +import pygame + +width, height = 750, 700 + +RADIUS = width // 15 + +width += RADIUS +height += RADIUS + +def calculate_angle_pos( + start: tuple[int | float, int | float], radius: int | float, angle: int | float +): + vec = pygame.math.Vector2(0, -radius).rotate((angle) % 360) + return start[0] + vec.x, start[1] + vec.y + +def main(): + pygame.init() + pygame.display.set_caption('Drift Illusion') + + screen = pygame.display.set_mode((width, height)) + + running = True + + while running: + for event in pygame.event.get(): + if event.type == pygame.QUIT: + running = False + + screen.fill((0, 125, 0)) + + step = 360 / 15 + angle = step + + for y in range(RADIUS, height, RADIUS): + for x in range(RADIUS, width, RADIUS): + rad = RADIUS // 3 + + comp_angle = (angle + 180) % 361 + + x1, y1 = calculate_angle_pos((x, y), (1/2.5) * rad, angle) + x2, y2 = calculate_angle_pos((x, y), (1/2.5) * rad, comp_angle) + + pygame.draw.circle(screen, (255, 255, 255), (x1, y1), rad) + pygame.draw.circle(screen, (0, 0, 0), (x2, y2), rad) + pygame.draw.circle(screen, (0, 0, 255), (x, y), rad) + + angle = (angle - step) % 361 + + angle = (angle - step) % 361 + + pygame.display.flip() + + pygame.quit() + +if __name__ == '__main__': + main() diff --git a/Task/Permutations-Derangements/Haskell/permutations-derangements-3.hs b/Task/Permutations-Derangements/Haskell/permutations-derangements-3.hs new file mode 100644 index 0000000000..1b03d6b0ef --- /dev/null +++ b/Task/Permutations-Derangements/Haskell/permutations-derangements-3.hs @@ -0,0 +1,14 @@ +import Data.Ratio ((%), numerator) + +infixl 7 *. +(*.) :: Num a => a -> [a] -> [a] +x *. (p:ps) = x*p : x*.ps + +instance Num a => Num [a] where + negate = map negate + (+) = zipWith (+) + (*) (p:ps) (q:qs) = p*q : ((p*.qs) + ps*(q:qs)) + fromInteger n = fromInteger n:repeat 0 + +expseq :: [Rational] -> [Rational] +expseq ps = zipWith (\p q -> p*fromInteger q) ps (scanl (*) 1 [1..]) diff --git a/Task/Permutations-Derangements/Haskell/permutations-derangements-4.hs b/Task/Permutations-Derangements/Haskell/permutations-derangements-4.hs new file mode 100644 index 0000000000..d485297c1f --- /dev/null +++ b/Task/Permutations-Derangements/Haskell/permutations-derangements-4.hs @@ -0,0 +1,8 @@ +derangements :: [Integer] +derangements = map numerator + (expseq (invexp/(1:(-1):repeat 0))) + +invexp :: [Rational] +invexp = zipWith (%) (cycle [1,-1]) factorials + where + factorials = scanl (*) 1 [1..] diff --git a/Task/Permutations-Derangements/Haskell/permutations-derangements-5.hs b/Task/Permutations-Derangements/Haskell/permutations-derangements-5.hs new file mode 100644 index 0000000000..e86433cce4 --- /dev/null +++ b/Task/Permutations-Derangements/Haskell/permutations-derangements-5.hs @@ -0,0 +1,4 @@ +ghci> take 10 derangements +[1,0,1,2,9,44,265,1854,14833,133496] +ghci> derangements !! 20 +895014631192902121 diff --git a/Task/Permutations-Derangements/PascalABC.NET/permutations-derangements.pas b/Task/Permutations-Derangements/PascalABC.NET/permutations-derangements.pas new file mode 100644 index 0000000000..41ec4b72c6 --- /dev/null +++ b/Task/Permutations-Derangements/PascalABC.NET/permutations-derangements.pas @@ -0,0 +1,23 @@ +function derangements(a: array of T) := + a.Permutations.where(p -> p.where((x, i) -> x = a[i]).Count = 0); + +function subFactorial(n: integer): int64; +begin + if n <= 1 then result := 1 - n + else result := (n - 1) * (subfactorial(n - 1) + subfactorial(n - 2)); +end; + +begin + println('Derangements of 1 2 3 4:'); + foreach var d in derangements(|1, 2, 3, 4|) do + d.println; + + println(#10, 'Number of derangements:'); + println('n counted calculated'); + println('- ------- ----------'); + for var n := 1 to 10 do + writeln(n:2, derangements(range(1, n).ToArray).count:9, subfactorial(n):10); + + println; + println('!20 = ', subfactorial(20)); +end. diff --git a/Task/Permutations/AWK/permutations.awk b/Task/Permutations/AWK/permutations-1.awk similarity index 100% rename from Task/Permutations/AWK/permutations.awk rename to Task/Permutations/AWK/permutations-1.awk diff --git a/Task/Permutations/AWK/permutations-2.awk b/Task/Permutations/AWK/permutations-2.awk new file mode 100644 index 0000000000..8a202c697c --- /dev/null +++ b/Task/Permutations/AWK/permutations-2.awk @@ -0,0 +1,33 @@ +# determine and print all permutations of numbers 1..n + +# General variant: simple, single array, recursive, not in lexical order +# +# An array with n places is used, marked by 0 as free. +# The current element l replaces the free places one by one, +# and the next element l+1 is probed recursively with the array. +# +function permute1(l, n, r, i) { + if ( l <= n) { + for (i=1; i<=n; ++i) { + if (r[i] == 0) { + r[i] = l + permute1(l+1, n, r) + r[i] = 0 + } + } + return + } + # print result; consumes ca. 50% of CPU time + s = "" + for (i=1; i <= length(r); ++i) # ensure order + s = s r[i] " " + print s +} + +# command line parameter is number of elements. +BEGIN { + n = 3 # default + if (ARGC > 1) n = ARGV[1] # number may be given as parameter + for (i=1; i <=n; ++i) r[i] = 0 # fill with zeroes + permute1(1, n, r) +} diff --git a/Task/Permutations/AWK/permutations-3.awk b/Task/Permutations/AWK/permutations-3.awk new file mode 100644 index 0000000000..f8a31c3005 --- /dev/null +++ b/Task/Permutations/AWK/permutations-3.awk @@ -0,0 +1,23 @@ +function permute(l, k, i, s) { + if (k == length(l)) { + show(s) + return + } + for (i=k; i <= length(l); ++i) { + swap(l, i, k) + permute(l, k+1) + swap(l, k, i) + } +} +function swap(l, i, k, t) { + t = l[i] + l[i] = l[k] + l[k] = t +} +BEGIN { + n = 3 # default + if (ARGC > 1) n = ARGV[1] # number may be given as parameter + for (i=1; i <=n; ++i) + l[i] = i + permute(l, 1) + } diff --git a/Task/Permutations/Langur/permutations.langur b/Task/Permutations/Langur/permutations.langur index b94494e034..2a97227c73 100644 --- a/Task/Permutations/Langur/permutations.langur +++ b/Task/Permutations/Langur/permutations.langur @@ -7,7 +7,7 @@ val permute = fn(plist) { if len(plist) > limit: throw "permutation limit exceeded (currently {{limit}})" var elements = plist - var ordinals = pseries(len(elements)) + var ordinals = series(len(elements)) val n = len(ordinals) var i, j diff --git a/Task/Permutations/M2000-Interpreter/permutations-2.m2000 b/Task/Permutations/M2000-Interpreter/permutations-2.m2000 index c2613878b0..8889cf5d07 100644 --- a/Task/Permutations/M2000-Interpreter/permutations-2.m2000 +++ b/Task/Permutations/M2000-Interpreter/permutations-2.m2000 @@ -1,43 +1,42 @@ Module StepByStep { - Function PermutationStep (a) { - c1=lambda (&f, a) ->{ - =car(a) - f=true - } - m=len(a) - c=c1 - while m>1 { - c1=lambda c2=c,p, m=(,) (&f, a) ->{ - if len(m)=0 then m=a - =cons(car(m),c2(&f, cdr(m))) - if f then f=false:p++: m=cons(cdr(m), car(m)) : if p=len(m) then p=0 : m=(,):: f=true - } - c=c1 - m-- - } - =lambda c, a (&f) -> { - =c(&f, a) - } - } - k=false - StepA=PermutationStep((1,2,3,4)) - while not k { - Print StepA(&k) - } - k=false - StepA=PermutationStep((100,200,300)) - while not k { - Print StepA(&k) - } - k=false - StepA=PermutationStep(("A", "B", "C", "D")) - while not k { - Print StepA(&k) - } - k=false - StepA=PermutationStep(("DOG", "CAT", "BAT")) - while not k { - Print StepA(&k) - } + Function PermutationStep { + a=array([]) + c1=lambda (&f, a) ->{ + =car(a) + f=true + } + m=len(a) + c=c1 + while m>1 + c1=lambda c2=c, p, m=(,) (&f, a) ->{ + if len(m)=0 then m=a + =cons(car(m),c2(&f, cdr(m))) + if f then + f=false + p++ + m=cons(cdr(m), car(m)) + if p=len(m) then + p=0 + m=(,) + f=true + end if + end if + } + c=c1 + m-- + end while + =lambda c, a (&f) -> { + =c(&f, a) + } + } + display(PermutationStep(1,2,3,4)) + display(PermutationStep(100,200,300)) + display(PermutationStep("A", "B", "C", "D")) + display(PermutationStep("DOG", "CAT", "BAT")) + + sub display(S as lambda) + k=false + while not k : Print S(&k)#str$(): end while + end sub } StepByStep diff --git a/Task/Phrase-reversals/EasyLang/phrase-reversals.easy b/Task/Phrase-reversals/EasyLang/phrase-reversals.easy index 6d593561d0..6c28250eda 100644 --- a/Task/Phrase-reversals/EasyLang/phrase-reversals.easy +++ b/Task/Phrase-reversals/EasyLang/phrase-reversals.easy @@ -5,10 +5,10 @@ func$[] rev a$[] . return a$[] . lin$ = "rosetta code phrase reversal" -print strjoin rev strchars lin$ +print strjoin rev strchars lin$ "" words$[] = strsplit lin$ " " for w$ in words$[] - write strjoin rev strchars w$ + write strjoin rev strchars w$ "" write " " . print "" diff --git a/Task/Pick-random-element/V-(Vlang)/pick-random-element.v b/Task/Pick-random-element/V-(Vlang)/pick-random-element.v index 2b166baed8..c8f880e892 100644 --- a/Task/Pick-random-element/V-(Vlang)/pick-random-element.v +++ b/Task/Pick-random-element/V-(Vlang)/pick-random-element.v @@ -2,5 +2,7 @@ import rand fn main() { list := ["friends", "peace", "people", "happiness", "hello", "world"] - for index in 1..list.len + 1 {println(index.str() + ': ' + list[rand.intn(list.len) or {}])} + for index in 1..list.len + 1 { + println(index.str() + ": " + list[rand.intn(list.len) or {}]) + } } diff --git a/Task/Pinstripe-Display/Nim/pinstripe-display.nim b/Task/Pinstripe-Display/Nim/pinstripe-display.nim index db98319f49..f00d71c49a 100644 --- a/Task/Pinstripe-Display/Nim/pinstripe-display.nim +++ b/Task/Pinstripe-Display/Nim/pinstripe-display.nim @@ -1,60 +1,52 @@ -import gintro/[glib, gobject, gtk, gio, cairo] +import gtk2, glib2, gdk2, cairo const Width = 420 Height = 420 -const Colors = [[255.0, 255.0, 255.0], [0.0, 0.0, 0.0]] +const Colors = [(1.0, 1.0, 1.0), (0.0, 0.0, 0.0)] -#--------------------------------------------------------------------------------------------------- -proc draw(area: DrawingArea; context: Context) = +proc onExposeEvent(widget: PWidget; event: PEventExpose; data: Pgpointer): gboolean {.cdecl.} = ## Draw the bars. const lineHeight = Height div 4 + let cr = cairo_create(widget.window) + var y = 0.0 for lineWidth in [1.0, 2.0, 3.0, 4.0]: - context.setLineWidth(lineWidth) + cr.setLineWidth(lineWidth) var x = 0.0 var colorIndex = 0 while x < Width: - context.setSource(Colors[colorIndex]) - context.moveTo(x, y) - context.lineTo(x, y + lineHeight) - context.stroke() + let (r, g, b) = Colors[colorIndex] + cr.setSourceRgb(r, g, b) + cr.moveTo(x, y) + cr.lineTo(x, y + lineHeight) + cr.stroke() colorIndex = 1 - colorIndex x += lineWidth y += lineHeight -#--------------------------------------------------------------------------------------------------- + cr.destroy() -proc onDraw(area: DrawingArea; context: Context; data: pointer): bool = - ## Callback to draw/redraw the drawing area contents. - area.draw(context) - result = true +proc onDestroyEvent(widget: PWidget; data: Pgpointer): gboolean {.cdecl.} = + ## Quit the application. + main_quit() -#--------------------------------------------------------------------------------------------------- -proc activate(app: Application) = - ## Activate the application. +nim_init() +let window = window_new(gtk2.WINDOW_TOPLEVEL) +window.set_title("Pinstripe") - let window = app.newApplicationWindow() - window.setSizeRequest(Width, Height) - window.setTitle("Color pinstripe") +let drawingArea = drawing_area_new() +window.add drawingArea +drawingArea.set_size_request(Width, Height) - # Create the drawing area. - let area = newDrawingArea() - window.add(area) +discard drawingArea.signal_connect("expose-event", SIGNAL_FUNC(onExposeEvent), nil) +discard window.signal_connect("destroy", SIGNAL_FUNC(onDestroyEvent), nil) - # Connect the "draw" event to the callback to draw the bars. - discard area.connect("draw", ondraw, pointer(nil)) - - window.showAll() - -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.Pinstripe") -discard app.connect("activate", activate) -discard app.run() +window.show_all() +main() diff --git a/Task/Pinstripe-Printer/Nim/pinstripe-printer.nim b/Task/Pinstripe-Printer/Nim/pinstripe-printer.nim index ac1d287c15..9bd328695e 100644 --- a/Task/Pinstripe-Printer/Nim/pinstripe-printer.nim +++ b/Task/Pinstripe-Printer/Nim/pinstripe-printer.nim @@ -1,19 +1,63 @@ -import gintro/[glib, gobject, gtk, gio, cairo] +import gtk2, glib2, cairo -const Colors = [[255.0, 255.0, 255.0], [0.0, 0.0, 0.0]] +############################################################################### +# Missing declarations needed for print operations. -#--------------------------------------------------------------------------------------------------- +when defined(win32): + const lib = "libgtk-win32-2.0-0.dll" +elif defined(macosx): + const lib = "(libgtk-quartz-2.0.0.dylib|libgtk-x11-2.0.dylib)" +else: + const lib = "libgtk-x11-2.0.so(|.0)" -proc beginPrint(op: PrintOperation; printContext: PrintContext; data: pointer) = - ## Process signal "begin_print", that is set the number of pages to print. - op.setNPages(1) +# Missing type definitions. +type + PrintOperation = PObject + PrintContext = PObject + PrintOperationAction = enum + PRINT_OPERATION_ACTION_PRINT_DIALOG + PRINT_OPERATION_ACTION_PRINT + PRINT_OPERATION_ACTION_PREVIEW + PRINT_OPERATION_ACTION_EXPORT + PrintOperationResult = enum + PRINT_OPERATION_RESULT_ERROR + PRINT_OPERATION_RESULT_APPLY + PRINT_OPERATION_RESULT_CANCEL + PRINT_OPERATION_RESULT_IN_PROGRESS -#--------------------------------------------------------------------------------------------------- +# Missing external procedures. +proc print_operation_new(): PrintOperation {.cdecl, + importc: "gtk_print_operation_new", dynlib: lib.} +proc print_operation_run(op: PrintOperation; action: PrintOperationAction; + parent: PWindow; error: pointer): PrintOperationResult {.cdecl, + importc: "gtk_print_operation_run", dynlib: lib.} +proc set_n_pages(op: PrintOperation; n: gint) {.cdecl, + importc: "gtk_print_operation_set_n_pages", dynlib: lib.} +proc get_cairo_context(printContext: PrintContext): ptr Context {.cdecl, + importc: "gtk_print_context_get_cairo_context", dynlib: lib.} +proc width(printContext: PrintContext): cdouble {.cdecl, + importc: "gtk_print_context_get_width", dynlib: lib.} +proc height(printContext: PrintContext): cdouble {.cdecl, + importc: "gtk_print_context_get_height", dynlib: lib.} -proc drawPage(op: PrintOperation; printContext: PrintContext; pageNum: int; data: pointer) = - ## Draw a page. - let context = printContext.getCairoContext() +############################################################################### + +const Colors = [(1.0, 1.0, 1.0), (0.0, 0.0, 0.0)] + + +proc beginPrint(op: PrintOperation; printContext: PrintContext; + data: Pgpointer): gboolean {.cdecl.} = + ## Process "begin_print" signal. + op.setNPages(1) # Print one page. + result = true + + +proc drawPage(op: PrintOperation; printContext: PrintContext; + pageNum: int; data: Pgpointer): gboolean {.cdecl.} = + ## Process "draw_page" signal. + + let context = printContext.get_cairo_context() let lineHeight = printContext.height / 4 var y = 0.0 @@ -22,7 +66,8 @@ proc drawPage(op: PrintOperation; printContext: PrintContext; pageNum: int; data var x = 0.0 var colorIndex = 0 while x < printContext.width: - context.setSource(Colors[colorIndex]) + let (r, g, b) = Colors[colorIndex] + context.setSourceRgb(r, g, b) context.moveTo(x, y) context.lineTo(x, y + lineHeight) context.stroke() @@ -30,21 +75,13 @@ proc drawPage(op: PrintOperation; printContext: PrintContext; pageNum: int; data x += lineWidth y += lineHeight -#--------------------------------------------------------------------------------------------------- + result = true -proc activate(app: Application) = - ## Activate the application. - # Launch a print operation. - let op = newPrintOperation() - op.connect("begin_print", beginPrint, pointer(nil)) - op.connect("draw_page", drawPage, pointer(nil)) +nim_init() - # Run the print dialog. - discard op.run(printDialog) - -#——————————————————————————————————————————————————————————————————————————————————————————————————— - -let app = newApplication(Application, "Rosetta.Pinstripe") -discard app.connect("activate", activate) -discard app.run() +# Print the pinstripe. +let op = print_operation_new() +discard op.g_signal_connect("begin_print", G_CALLBACK(begin_print), nil) +discard op.g_signal_connect("draw_page", G_CALLBACK(draw_page), nil) +discard op.print_operation_run(PRINT_OPERATION_ACTION_PRINT_DIALOG, nil, nil) diff --git a/Task/Poker-hand-analyser/FutureBasic/poker-hand-analyser.basic b/Task/Poker-hand-analyser/FutureBasic/poker-hand-analyser.basic new file mode 100644 index 0000000000..1b24f05b77 --- /dev/null +++ b/Task/Poker-hand-analyser/FutureBasic/poker-hand-analyser.basic @@ -0,0 +1,349 @@ +include "Tlbx GameplayKit.incl" + +_window = 1 + +_Deal = 100 +_Four = 101 +_Full = 102 +_flush = 103 +_straight = 104 +_SFlush = 105 +_NewDeck = 106 + +begin globals +int gOmit(52) +int gCount = 1 +int gDeck(4,13) +CFStringRef gSpecial(5) +bool gInsert = NO +bool gNewDeck = NO +end globals + +local fn Set + for int x = 1 to 52):gOmit(x) = x:next +end fn + +//Ken's code +local fn MyImageDrawingHandler( r as CGRect, userData as ptr ) + AttributedStringDrawAtPoint( userData, fn CGPointMake(0,0) ) +end fn = YES + +local fn StringToImage( string as CFStringRef, font as FontRef, color as ColorRef ) as ImageRef + CFDictionaryRef attributes = @{NSFontAttributeName:font,NSForegroundColorAttributeName:color} + CFMutableAttributedStringRef aString = fn MutableAttributedStringWithAttributes( string, attributes ) +end fn = fn ImageWithDrawingHandler( fn AttributedStringSize( aString ), NO, @fn MyImageDrawingHandler, aString ) + +local fn ConvertValueToEmoji( value as long ) as CFStringRef + UInt32 unicodeInt + ScannerRef scanner = fn ScannerWithString( fn StringWithFormat( @"0x%X", value ) ) + fn ScannerScanHexInt( scanner, @unicodeInt ) +end fn = fn StringWithBytes( @unicodeInt, 4, NSUTF32LittleEndianStringEncoding ) + +void local fn BuildWnd + int height = 800 + CGrect rr = fn CGRectMake( 0,0,500,height) + + window _window, @"Assess Poker Hands" , rr + + rr = fn CGRectMake( 10, 60, 90, 26 ) + button _Four,,,@"4 of kind", rr + rr = fn CGRectOffset( rr, 90, 0 ) + button _Full,,,@"Full House", rr + rr = fn CGRectOffset( rr, 90, 0 ) + button _Flush,,,@"Flush", rr + rr = fn CGRectOffset( rr, 90, 0 ) + button _straight,,,@"Straight", rr + rr = fn CGRectOffset( rr, 90, 0 ) + button _sFlush,,,@"S Flush", rr + rr = fn CGRectMake( 120, 20, 100, 26) + button _Deal,,,@"Deal Hand", rr + rr = fn CGRectMake( 240, 20, 200, 26) + checkbox _NewDeck,,,@"New deck each time", rr + textlabel 2,@"Row of buttons to prove the rare hands assess correctly", ( 40, 90, 380, 26 ) + +end fn + +void local fn SetDeck + int x,y + for x = 1 to 13 + for y = 0 to 3 + gDeck(y,x) = (y*13 + 1) + x - 1 + next + next +end fn + +local fn SetCards + NSUInteger i, index, c, j = 1 + CFMutableArrayRef NumbArr = fn MutableArrayNew + + index = 0 : c = 0 + for i = 127137 to 127199 + if ( c == 11 ) + c++ + else + MutableArrayInsertObjectAtIndex( NumbArr, fn StringWithFormat(@"%ld;%d", i, j), index ) + index++ + c++ + j++ + end if + if c mod 14 == 0 && i != 127198 then c = 0 : i += 2 + next + + AppSetProperty( @"Numbers",fn ArrayWithArray( NumbArr ) ) + CFArrayRef Numbers = fn AppProperty( @"Numbers" ) + AppSetProperty( @"NoShuffled",fn ArrayShuffledArray( Numbers )) + +end fn + +local fn GetRandomNo as int + int j,item + Bool check = NO + + do + j = rnd( 52 ) + if gOmit(j) > -1 + item = j + gOmit(j) = -gOmit(j) + check = YES + end if + until check == YES + +end fn = item + +clear local fn AssessHand( cNo(5) as int) as CFStringRef + CFStringRef answer = @"High Card" + int x,y,check + int w,b,col,row,ans(5) + bool checked + + //Sort cards lowest to highest + for x = 1 to 5 + for y = x+1 to 5 + if cNo(y) < cNo(x) then Swap cNo(x), cNo(y) + next + next + + b = 20 + for w = 1 to 5 + for x = 5 to 1 step -1 + for col = 13 to 1 step -1 + for row = 3 to 0 step -1 + if cNo(x) == gDeck(row,col) + if col < b + ans(x) = col + b = 20 + else + end if + end if + next + next + next + next + for x = 1 to 5 + for y = x+1 to 5 + if ans(y) < ans(x) then Swap ans(x), ans(y) + next + next + + //Check for pair, two pair, three of a kind, Four of a kind + if ans(1) == ans(2) && ans(2) == ans(3) && ans(3) == ans(4) then answer = @"Four of a Kind":Exit fn = answer + if ans(2) == ans(3) && ans(3) == ans(4) && ans(4) == ans(5) then answer = @"Four of a Kind":Exit fn = answer + if ans(1) == ans(2) && ans(2) == ans(3) && ans(4) == ans(5) then answer = @"Full House":Exit fn = answer + if ans(1) == ans(2) && ans(3) == ans(4) && ans(4) == ans(5) then answer = @"Full House":Exit fn = answer + if ans(1) == ans(2) && ans(2) == ans(3) then answer = @"three of a kind":Exit fn = answer + if ans(2) == ans(3) && ans(3) == ans(4) then answer = @"three of a kind":Exit fn = answer + if ans(3) == ans(4) && ans(4) == ans(5) then answer = @"three of a kind":Exit fn = answer + if ans(1) == ans(2) && ans(3) == ans(4) then answer = @"two pair":Exit fn = answer + if ans(1) == ans(2) && ans(4) == ans(5) then answer = @"two pair":Exit fn = answer + if ans(1) == ans(2)|| ans(3) == ans(2)|| ans(3) == ans(4) || ans(4) == ans(5) then answer = @"Pair":Exit fn = answer + + + //Check for Straight Flush + if (cNo(1) < 10 && cNo(1) > 0 ) || (cNo(1) < 23 && cNo(1) > 13) || (cNo(1) < 36 && cNo(1) > 26)|| (cNo(1) < 49 && cNo(1) > 39) + if cNo(2) != cNo(1) + 1 + else + if cNo(3) != cNo(2) + 1 + else + if cNo(4) != cNo(3) + 1 + else + if cNo(5) != cNo(4) + 1 + else + answer = @"Straight Flush" + exit fn = answer + end if + end if + end if + end if + end if + + //Check for flush + if (cNo(1) < 10 && cNo(1) > 0 ) || (cNo(1) < 23 && cNo(1) > 13) || (cNo(1) < 36 && cNo(1) > 26)|| (cNo(1) < 49 && cNo(1) > 39) + check = 1 + if (cNo(1) < 10 && cNo(1) > 0 )//Spades + for x = 2 to 5 + if cNo(x) < 13 && cNo(x) > 0 + check++ + end if + next + if check == 5 then answer = @"Flush of Spades" : Exit fn = answer + end if + if (cNo(1) < 23 && cNo(1) > 13 )//Hearts + for x = 2 to 5 + if cNo(x) < 27 && cNo(x) > 13 + check++ + end if + next + if check == 5 then answer = @"Flush of Hearts" : Exit fn = answer + end if + if (cNo(1) < 36 && cNo(1) > 26)//Diamonds + for x = 2 to 5 + if cNo(x) < 40 && cNo(x) > 26 + check++ + end if + next + if check == 5 then answer = @"Flush of Diamonds" : Exit fn = answer + end if + if (cNo(1) < 49 && cNo(1) > 39)//Clubs + for x = 2 to 5 + if cNo(x) < 53 && cNo(x) > 39 + check++ + end if + next + if check == 5 then answer = @"Flush of Clubs" : Exit fn = answer + end if + end if + + //Check for Straight + //Find lowest card ignoring suit + + for x = 5 to 2 step -1 + if (ans(x) - ans(x-1)) == 1 + checked = YES + else + checked = NO + exit next + end if + next + if checked == YES + answer = @"straight" + end if + +end fn = answer + +clear local fn DealHand + CFArrayRef Numb = fn AppProperty( @"NoShuffled" ) + CFStringRef Ans,card,Number + int x, item, CardNo(5), y + CFRange range + + text @"Menlo", 72, fn ColorText + + for x = 1 to 5 + do + if gInsert = YES + ans = gSpecial(x) + else + item = fn GetRandomNo + Ans = Numb[ item] + end if + range = fn StringRangeOfString( Ans, @";" ) + card = fn StringSubstringToIndex( Ans, range.location ) + Number = fn StringSubStringFromIndex( Ans, range.location + 1) + cardNo(x) = fn StringIntValue( Number ) + y = fn StringIntValue( card) + until y != 127199 + if y > 127152 && y < 127185 then text,, fn ColorRed else text,,fn ColorBlack + printf @"%@\b", fn ConvertValueToEmoji( y ) + next + if gNewDeck == YES then fn Set + text @"Times",24, fn ColorMagenta + printf fn AssessHand( cardNo(0)) + printf @"" + text @"Menlo", 72, fn ColorText + gInsert = NO +end fn + +local fn Flush + gSpecial(1) = @"127155;16" + gSpecial(2) = @"127160;21" + gSpecial(3) = @"127153;14" + gSpecial(4) = @"127158;19" + gSpecial(5) = @"127163;24" +end fn + +local fn Four + gSpecial(1) = @"127137;1" + gSpecial(2) = @"127169;27" + gSpecial(3) = @"127153;14" + gSpecial(4) = @"127158;19" + gSpecial(5) = @"127185;40" +end fn + +local fn Full + gSpecial(1) = @"127140;4" + gSpecial(2) = @"127159;20" + gSpecial(3) = @"127175;33" + gSpecial(4) = @"127156;17" + gSpecial(5) = @"127188;43" +end fn + +local fn Straight + gSpecial(1) = @"127158;19" + gSpecial(2) = @"127145;9" + gSpecial(3) = @"127191;46" + gSpecial(4) = @"127178;36" + gSpecial(5) = @"127176;34" +end fn + +local fn SFlush + gSpecial(1) = @"127156;17" + gSpecial(2) = @"127158;19" + gSpecial(3) = @"127160;21" + gSpecial(4) = @"127157;18" + gSpecial(5) = @"127159;20" +end fn + +void local fn doDialog(act as long, ref as long, wnd as long ) + select act + case _btnClick + select ref + case _Newdeck + if fn ButtonState( _NewDeck ) == NSControlStateValueOn then gNewDeck = YES else gNewDeck = NO + case _Deal + if gCount < 11 + fn DealHand + gCount++ + else + cls + fn Set + fn SetDeck + fn SetCards + gCount = 1 + end if + case _Flush + gInsert = YES + fn Flush + case _Four + gInsert = YES + fn Four + case _Full + gInsert = YES + fn Full + case _Straight + gInsert = YES + fn Straight + case _SFlush + gInsert = YES + fn SFlush + end select + end select + +end fn +fn SetDeck +fn SetCards +fn BuildWnd + + +on dialog fn doDialog + +HandleEvents diff --git a/Task/Poker-hand-analyser/XPL0/poker-hand-analyser.xpl0 b/Task/Poker-hand-analyser/XPL0/poker-hand-analyser.xpl0 index 95ceb38d34..7e4aed6322 100644 --- a/Task/Poker-hand-analyser/XPL0/poker-hand-analyser.xpl0 +++ b/Task/Poker-hand-analyser/XPL0/poker-hand-analyser.xpl0 @@ -3,36 +3,36 @@ int Count(1+18); \Counts of ranks and suits in a hand proc ShowCat; \Show category of poker hand int I, J; -[for I:= 1 to 14 do +[for I:= 1 to 10 do [if Count(I) = 1 then [for J:= I+1 to I+4 do \are next 4 cards present? if Count(J) # 1 then J:= 100; if J <= 100 then [Text(0, "straight"); for J:= 15 to 18 do \scan suits - if Count(J) >= 4 then Text(0, "-flush"); + if Count(J) = 5 then Text(0, "-flush"); return; ]; ]; ]; for I:= 15 to 18 do - if Count(I) = 4 then [Text(0, "flush"); return]; -for I:= 1 to 14 do \scan ranks + if Count(I) = 5 then [Text(0, "flush"); return]; +for I:= 2 to 14 do \scan ranks if Count(I) = 4 then [Text(0, "four-of-a-kind"); return]; -for I:= 1 to 14 do +for I:= 2 to 14 do [if Count(I) = 3 then - [for J:= 1 to 14 do + [for J:= 2 to 14 do if Count(J) = 2 then [Text(0, "full-house"); return]; Text(0, "three-of-a-kind"); return; ]; ]; -for I:= 1 to 14 do +for I:= 2 to 14 do [if Count(I) = 2 then - [for J:= 1 to 14 do + [for J:= 2 to 14 do if J # I and Count(J) = 2 then - [Text(0, "two-pairs"); return]; + [Text(0, "two-pair"); return]; Text(0, "one-pair"); return; ]; ]; @@ -71,7 +71,7 @@ for H:= 0 to 9-1 do ^ : [N:= 0; Card:= Card+1; if Card >= 5 then quit] other N:= Char-^0; Count(N):= Count(N)+1; - if N = 14 then Count(1):= Count(1)+1; \two-place ace + if N = 14 then Count(1):= Count(1)+1; \ace in two places if N <= 14 then Rank:= N else [Suit:= N - 15; if Valid(Suit) and 1<= 3 && isodd(n) && all(i -> n % i != 0, 3:2:isqrt(n))) end n = 100 -a = filter(isprime_trialdivision, [1:n]) +a = filter(isprime_trialdivision, 1:n) + +import Primes.primes # for check, use existing library function if all(a .== primes(n)) println("The primes <= ", n, " are:\n ", a) diff --git a/Task/Primality-by-trial-division/Langur/primality-by-trial-division-1.langur b/Task/Primality-by-trial-division/Langur/primality-by-trial-division-1.langur index 747b0d4414..a0304f5019 100644 --- a/Task/Primality-by-trial-division/Langur/primality-by-trial-division-1.langur +++ b/Task/Primality-by-trial-division/Langur/primality-by-trial-division-1.langur @@ -1,6 +1,6 @@ val isPrime = fn(i) { i == 2 or i > 2 and - not any(fn x:i div x, pseries(2 .. i ^/ 2)) + not any(series(2 .. i ^/ 2, asconly=true), by=fn x:i div x) } -writeln filter(isPrime, series(100)) +writeln filter(series(100), by=isPrime) diff --git a/Task/Primality-by-trial-division/Langur/primality-by-trial-division-2.langur b/Task/Primality-by-trial-division/Langur/primality-by-trial-division-2.langur index 678610b891..5e876b0618 100644 --- a/Task/Primality-by-trial-division/Langur/primality-by-trial-division-2.langur +++ b/Task/Primality-by-trial-division/Langur/primality-by-trial-division-2.langur @@ -12,4 +12,4 @@ val isPrime = fn(i) { return n ndiv 2 and chkdiv(n, 3) } -writeln filter(isPrime, series(100)) +writeln filter(series(100), by=isPrime) diff --git a/Task/Primes---allocate-descendants-to-their-ancestors/FreeBASIC/primes---allocate-descendants-to-their-ancestors.basic b/Task/Primes---allocate-descendants-to-their-ancestors/FreeBASIC/primes---allocate-descendants-to-their-ancestors.basic new file mode 100644 index 0000000000..12fa00a865 --- /dev/null +++ b/Task/Primes---allocate-descendants-to-their-ancestors/FreeBASIC/primes---allocate-descendants-to-their-ancestors.basic @@ -0,0 +1,107 @@ +Type NumberList + As Integer count + As Ulongint values(50000) +End Type + +Sub AddToList(Byref list As NumberList, value As Ulongint) + list.values(list.count) = value + list.count += 1 +End Sub + +Function GetPrimes(max As Integer) As NumberList + Dim primes As NumberList + + If max < 2 Then Return primes + + AddToList(primes, 2) + Dim As Integer i, j + For j = 3 To max Step 2 + Dim As Boolean isPrime = True + For i = 0 To primes.count - 1 + If j Mod primes.values(i) = 0 Then + isPrime = False + Exit For + End If + Next + If isPrime Then AddToList(primes, j) + Next + Return primes +End Function + +Sub SortList(Byref list As NumberList) + Dim As Integer i, j + For i = 0 To list.count - 2 + For j = i + 1 To list.count - 1 + If list.values(i) > list.values(j) Then + Swap list.values(i), list.values(j) + End If + Next + Next +End Sub + +Const maxSum = 99 +Dim Shared As NumberList descendants(maxSum), ancestors(maxSum) +Dim primes As NumberList = GetPrimes(maxSum) +Dim As Integer p, s, d + +' Calculate descendants +For p = 0 To primes.count - 1 + Dim As Ulongint prime = primes.values(p) + AddToList(descendants(prime), prime) + + For s = 1 To maxSum - prime + For d = 0 To descendants(s).count - 1 + Dim As Ulongint newDesc = prime * descendants(s).values(d) + AddToList(descendants(s + prime), newDesc) + Next + Next +Next + +' Remove last element from prime descendants and 4 +For s = 0 To primes.count - 1 + p = primes.values(s) + If descendants(p).count > 0 Then descendants(p).count -= 1 +Next +If descendants(4).count > 0 Then descendants(4).count -= 1 + +' Calculate totals and print results +Dim As Integer total = 0 +For s = 1 To maxSum + SortList(descendants(s)) + total += descendants(s).count + + ' Calculate ancestors for current s + For d = 0 To descendants(s).count - 1 + If descendants(s).values(d) <= maxSum Then + ' Add all ancestors from previous calculations + For p = 0 To ancestors(s).count - 1 + AddToList(ancestors(descendants(s).values(d)), ancestors(s).values(p)) + Next + ' Add current value as ancestor + AddToList(ancestors(descendants(s).values(d)), s) + End If + Next + + If s < 21 Or s = 46 Or s = 74 Or s = maxSum Then + Print Using "##: "; s; + Print ancestors(s).count; " Ancestors[s]: ["; + For p = 0 To ancestors(s).count - 1 + Print ancestors(s).values(p); + If p < ancestors(s).count - 1 Then Print ", "; + Next + Print "] " & Iif(s = 46 Or s = 74, !"\t", !"\t\t"); + + Print Using "#####"; descendants(s).count; + Print " Descendants[s]: ["; + For p = 0 To Iif(descendants(s).count > 10, 9, descendants(s).count - 1) + Print descendants(s).values(p); + If p < Iif(descendants(s).count > 10, 9, descendants(s).count - 1) Then Print ", "; + Next + If descendants(s).count > 10 Then Print ", ..."; + Print "]" + End If +Next + +Print !"\nTotal descendants "; total + +Sleep diff --git a/Task/Primorial-numbers/REXX/primorial-numbers-1.rexx b/Task/Primorial-numbers/REXX/primorial-numbers-1.rexx deleted file mode 100644 index 78b99be865..0000000000 --- a/Task/Primorial-numbers/REXX/primorial-numbers-1.rexx +++ /dev/null @@ -1,43 +0,0 @@ -/*REXX program computes some primorial numbers for low numbers, and for various 10^n.*/ -parse arg N H . /*get optional arguments: N, L, H */ -if N=='' | N==',' then N= 10 /*Not specified? Then use the default.*/ -if H=='' | H==',' then H= 100000 /* " " " " " " */ -numeric digits 600000 /*be able to handle gihugic numbers. */ -w= length( commas( digits() ) ) /*W: width of the largest commatized #*/ -@.=.; @.0= 1; @.1= 2; @.2= 3; @.3= 5; @.4= 7; @.5= 11; @.6= 13 /*some low primes.*/ - s.1= 4; s.2= 9; s.3= 25; s.4= 49; s.5= 121; s.6= 169 /*squared primes. */ -#= 6 /*number of primes*/ - do j=0 for N /*calculate the first N primorial #s.*/ - say right(j, length(N))th(j) " primorial is: " right(commas(primorial(j) ), N+2) - end /*j*/ -say -iw= length( commas(H) ) + 2 /*IW: width of largest commatized index*/ -p= 1 /*initialize the first multiplier for P*/ - do k=1 for H /*process a large range of numbers. */ - p= p * prime(k) /*calculate the next primorial number. */ - parse var k L 2 '' -1 R /*get the left and rightmost dec digits*/ - if R\==0 then iterate /*if right─most decimal digit\==0, skip*/ - if L\==1 then iterate /* " left─most " " \==1, " */ - if strip(k, , 0)\==1 then iterate /*Not a power of 10? Then skip this K.*/ - say right( commas(k), iw)th(k) ' primorial number length in decimal digits is:' , - right( commas( length(p) ), w) - end /*k*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -commas: parse arg _; do ?=length(_)-3 to 1 by -3; _=insert(',', _, ?); end; return _ -th: parse arg th; return word('th st nd rd', 1+ (th//10)*(th//100%10\==1)*(th//10<4)) -/*──────────────────────────────────────────────────────────────────────────────────────*/ -primorial: procedure expose @. s. #; parse arg y; != 1 /*obtain the arg Y. */ - do p=0 to y; != ! * prime(p) /*calculate product. */ - end /*p*/; return ! /*return with the #. */ -/*──────────────────────────────────────────────────────────────────────────────────────*/ -prime: procedure expose @. s. #; parse arg n; if @.n\==. then return @.n - numeric digits 9 /*limit digs to min.*/ - do j=@.#+2 by 2 /*start looking at #*/ - if j//2==0 then iterate; if j//3==0 then iterate /*divisible by 2│3 ?*/ - parse var j '' -1 _; if _==5 then iterate /*right─most dig≡5? */ - if j//7==0 then iterate; if j//11==0 then iterate /*divisible by 7│11?*/ - do k=6 while s.k<=j; if j//@.k==0 then iterate j /*divide by primes. */ - end /*k*/ - #= # + 1; @.#= j; s.#= j * j; return j /*next prime; return*/ - end /*j*/ diff --git a/Task/Primorial-numbers/REXX/primorial-numbers-2.rexx b/Task/Primorial-numbers/REXX/primorial-numbers.rexx similarity index 98% rename from Task/Primorial-numbers/REXX/primorial-numbers-2.rexx rename to Task/Primorial-numbers/REXX/primorial-numbers.rexx index a6a829a8bd..9d9a7fbf57 100644 --- a/Task/Primorial-numbers/REXX/primorial-numbers-2.rexx +++ b/Task/Primorial-numbers/REXX/primorial-numbers.rexx @@ -57,7 +57,7 @@ say 'Number of digits by summing log10:' numeric digits 10 a = 0; e = 0 do i = 1 to x - a = a+Log(prim.prime.i) + a = a+Log10(prim.prime.i) f = Xpon(i) if f <> e then do say 'Primorial(10^'f') has' Trunc(a)+1 'digits' diff --git a/Task/Primorial-numbers/XPL0/primorial-numbers.xpl0 b/Task/Primorial-numbers/XPL0/primorial-numbers.xpl0 new file mode 100644 index 0000000000..feab78830a --- /dev/null +++ b/Task/Primorial-numbers/XPL0/primorial-numbers.xpl0 @@ -0,0 +1,41 @@ +func IsPrime(N); \Return 'true' if N >= 3 is prime +int N, D; +[if rem(N/3) = 0 then return N = 3; +D:= 5; +while D*D <= N do + [if rem(N/D) = 0 then return false; + D:= D+2; + if rem(N/D) = 0 then return false; + D:= D+4; + ]; +return true; +]; + +int Prod, Num, Count, Limit; +real Sum; +[IntOut(0, 1); ChOut(0, ^ ); + IntOut(0, 2); ChOut(0, ^ ); +Prod:= 2; Num:= 3; Count:= 1; +loop [if IsPrime(Num) then + [Prod:= Prod*Num; + IntOut(0, Prod); ChOut(0, ^ ); + Count:= Count+1; + if Count >= 9 then quit; + ]; + Num:= Num+2; + ]; +CrLf(0); +Num:= 3; Count:= 1; Sum:= Log(2.); Limit:= 10; +loop [if IsPrime(Num) then + [Sum:= Sum + Log(float(Num)); + Count:= Count+1; + if Count = Limit then + [IntOut(0, fix(Sum-0.5)+1); ChOut(0, ^ ); + if Limit >= 1_000_000 then quit; + Limit:= Limit*10; + ]; + ]; + Num:= Num+2; + ]; +CrLf(0); +] diff --git a/Task/Probabilistic-choice/F-Sharp/probabilistic-choice.fs b/Task/Probabilistic-choice/F-Sharp/probabilistic-choice.fs new file mode 100644 index 0000000000..509ef1ee9a --- /dev/null +++ b/Task/Probabilistic-choice/F-Sharp/probabilistic-choice.fs @@ -0,0 +1,20 @@ +// Probabilistic choice. Nigel Galloway: November 15th., 2024 +type items=Aleph|Beth|Gimel|Daleth|He|Waw|Zayin|Heth +let item=function n when n<5544 ->Aleph + |n when n<10164->Beth + |n when n<14124->Gimel + |n when n<17589->Daleth + |n when n<20669->He + |n when n<23441->Waw + |n when n<25961->Zayin + |_->Heth +let R=System.Random() +let expected=function Aleph ->1000000/5 + |Beth ->1000000/6 + |Gimel ->1000000/7 + |Daleth->1000000/8 + |He ->1000000/9 + |Waw ->1000000/10 + |Zayin ->1000000/11 + |Heth ->(1000000*1759)/27720 +Seq.init 1000000 (fun _->R.Next(0,27720))|>Seq.countBy item|>Seq.iter(fun(n,g)->printfn $"item={n} count={g} expected={expected n}") diff --git a/Task/Probabilistic-choice/Free-Pascal-Lazarus/probabilistic-choice.pas b/Task/Probabilistic-choice/Free-Pascal-Lazarus/probabilistic-choice.pas new file mode 100644 index 0000000000..5b5bceaf43 --- /dev/null +++ b/Task/Probabilistic-choice/Free-Pascal-Lazarus/probabilistic-choice.pas @@ -0,0 +1,61 @@ +program Probablistic; +const + rounds = 1000*1000; + names : array[0..7] of string =('aleph','beth','gimel','daleth','he','waw','zayin','heth'); + quotient = 5*6*7*8*9*10*11; + RezValues: array[0..7] of integer=(5,6,7,8,9,10,11,0); +//remaining heth = 27720/1759 + +function GCD(a, b: Int64): Int64; +var + temp: Int64; +begin + while b <> 0 do + begin + temp := b; + b := a mod b; + a := temp + end; + Exit(a); +end; + +var + cnt : array of Uint32; + i ,z,n,tmp,idx,lmt : NativeInt; + sumTot : NativeUint; +begin + randomize; + z := 0; + n := 1; + For i := 0 to 6 do + begin + z := z*RezValues[i]+n; + n := n*RezValues[i]; + tmp := GCD(z,n); + z := z div tmp; + n := n div tmp; + end; + + //create the values + setlength(cnt,n+1); + For i := 1 to rounds do + inc(cnt[trunc(random()*n)]); + //count occurences in range + writeln('Item':9,'expected':10,'actual':10); + sumTot := 0; + idx := 0; + lmt := 0; + For i := 0 to 6 do + begin + lmt += n DIV RezValues[i]; + tmp := 0; + repeat + inc(tmp,cnt[idx]); + inc(idx); + until idx >= lmt; + sumTot += tmp; + writeln(names[i]:9,1/RezValues[i]:10:6,tmp/rounds:10:6); + end; + //the remaining for heth + writeln(names[7]:9,(n-z)/n:10:6,1-sumTot/rounds:10:6); +end. diff --git a/Task/Program-name/Langur/program-name.langur b/Task/Program-name/Langur/program-name.langur deleted file mode 100644 index b6e3033cd4..0000000000 --- a/Task/Program-name/Langur/program-name.langur +++ /dev/null @@ -1,2 +0,0 @@ -writeln "script: ", _script -writeln "script args: ", _args diff --git a/Task/Proper-divisors/Langur/proper-divisors.langur b/Task/Proper-divisors/Langur/proper-divisors.langur index eec521545d..60bddb48d4 100644 --- a/Task/Proper-divisors/Langur/proper-divisors.langur +++ b/Task/Proper-divisors/Langur/proper-divisors.langur @@ -11,6 +11,8 @@ val listproper = fn(x) { writeln "The proper divisors of the following numbers are :" writeln listproper(10) +exit 0 + var mx = 0 var most = [] for n in 2 .. 20_000 { @@ -22,5 +24,5 @@ for n in 2 .. 20_000 { } } -writeln "The following number(s) <= 20000 have the most proper divisors ({{mx}})" +writeln "The following number(s) <= 20000 have the most proper divisors ({{max}})" writeln most diff --git a/Task/Pseudo-random-numbers-Middle-square-method/M2000-Interpreter/pseudo-random-numbers-middle-square-method.m2000 b/Task/Pseudo-random-numbers-Middle-square-method/M2000-Interpreter/pseudo-random-numbers-middle-square-method.m2000 new file mode 100644 index 0000000000..23210c3717 --- /dev/null +++ b/Task/Pseudo-random-numbers-Middle-square-method/M2000-Interpreter/pseudo-random-numbers-middle-square-method.m2000 @@ -0,0 +1,25 @@ +Module Pseudo_random_numbers { + random = lambda seed = 675248 -> { + string s = str$(seed * seed,"") + while not len(s) = 12 + s = "0" + s + end while + seed = val(mid$(s, 4, 6)) + =seed + } + for i=1 to 5 + print random() + next +} +Pseudo_random_numbers +' same without using strings (we use long long numbers - bit) +Module Pseudo_random_numbers { + random = lambda seed = 675248&& -> { + seed = seed^2 div 1000&& mod 1000000&& + =seed + } + for i=1 to 5 + print random() + next +} +Pseudo_random_numbers diff --git a/Task/Pseudo-random-numbers-Middle-square-method/X86-64-Assembly/pseudo-random-numbers-middle-square-method.x86-64 b/Task/Pseudo-random-numbers-Middle-square-method/X86-64-Assembly/pseudo-random-numbers-middle-square-method.x86-64 new file mode 100644 index 0000000000..00d2569868 --- /dev/null +++ b/Task/Pseudo-random-numbers-Middle-square-method/X86-64-Assembly/pseudo-random-numbers-middle-square-method.x86-64 @@ -0,0 +1,64 @@ +format ELF64 executable 3 +entry begin + +define seed 675248 +define iterations 5 + +segment executable readable +begin: + mov rax, seed + mov rsi, iterations + .loop0: + mul rax + xor rdx, rdx + mov rdi, 1000000000 + div rdi + mov rax, rdx + xor rdx, rdx + mov rdi, 1000 + div rdi + mov rdi, rax + call printq + dec rsi + jnz .loop0 + .end: + mov rax, 60 + xor rdi, rdi + syscall +printq: + push rax + push rsi + sub rsp, 24 + mov byte[rsp + 23], 0x0a + mov r8, 22 + mov rsi, 10 + mov rax, rdi + or rax, rax + jns .loop0 + neg rax + .loop0: + xor rdx, rdx + div rsi + add rdx, '0' + mov byte[rsp + r8], dl + or rax, rax + jz .check + dec r8 + jmp .loop0 + .check: + or rdi, rdi + jns .out0 + dec r8 + mov byte[rsp + r8], '-' + .out0: + mov rax, 1 + mov rdi, 1 + mov rsi, rsp + add rsi, r8 + mov rdx, 24 + sub rdx, r8 + syscall + add rsp, 24 + pop rsi + pop rax + ret diff --git a/Task/Pseudo-random-numbers-Splitmix64/Standard-ML/pseudo-random-numbers-splitmix64.ml b/Task/Pseudo-random-numbers-Splitmix64/Standard-ML/pseudo-random-numbers-splitmix64.ml new file mode 100644 index 0000000000..e92140d2b9 --- /dev/null +++ b/Task/Pseudo-random-numbers-Splitmix64/Standard-ML/pseudo-random-numbers-splitmix64.ml @@ -0,0 +1,98 @@ +structure SplitMix64 = +struct + structure W64 = Word64 + + val randmax = (0wxFFFFFFFFFFFFFFFF : W64.word) + + (* if NONE is passed, seed using the current time *) + fun init NONE = + W64.fromLargeInt (Time.toNanoseconds (Time.now ())) + | init (SOME x) = x + (* takes the state and returns a tuple of the + * new state and the random number *) + fun next instate = + let + val newstate = instate + 0wx9e3779b97f4a7c15 + val z1 = W64.xorb (newstate, W64.>> (newstate, 0w30)) + val z2 = z1 * 0wxbf58476d1ce4e5b9 + val z3 = W64.xorb (z2, W64.>> (z2, 0w27)) + val z4 = z3 * 0wx94d049bb133111eb + in + (newstate, W64.xorb (z4, W64.>> (z4, 0w31))) + end + (* need to use LargeInt to fit the values *) + fun nextInt instate = + let + val (newstate, res) = next instate + val intres = W64.toLargeInt res + in + (newstate, intres) + end + fun nextReal instate = + let + val (newstate, res) = next instate + val realres = Real.fromLargeInt (W64.toLargeInt (res)) + in + (* divide by 2^64 *) + (newstate, realres * (1.0 / 18446744073709551616.0)) + end + (* gets the next number in the range min <= x < max without bias *) + fun nextRange instate (min, max) = + let + val minword = W64.fromInt min + val maxword = W64.fromInt max + val maxfromzero = maxword - minword + val ignored_range = randmax - randmax mod maxword + val (newstate, res) = next instate + in + if res >= ignored_range then nextRange newstate (min, max) + else (newstate, (res mod maxword) + minword) + end +end + +(* produce a list of n random ints using given seed *) +fun getRandIntList (seed, n) = + let + val init = SplitMix64.init seed + fun aux (0, acc, _) = rev acc + | aux (n, acc, state) = + let val (newstate, res) = SplitMix64.nextInt state + in aux (n - 1, res :: acc, newstate) + end + in + aux (n, [], init) + end + +fun testNextReal (seed, n) = + let + val hist = Array.array (n, 0) + val nreal = Real.fromInt n + fun loopFn 0 _ = () + | loopFn n state = + let + val (newstate, res) = SplitMix64.nextReal state + val idx = Real.floor (res * nreal) + val old_count = Array.sub (hist, idx) + in + (Array.update (hist, idx, old_count + 1); loopFn (n - 1) newstate) + end + val () = loopFn 100000 (SplitMix64.init seed) + in + Array.foldri + (fn (i, x, l) => + (String.concat [Int.toString i, ": ", Int.toString x]) :: l) [] hist + end + +fun main () = + let + val five_ints = getRandIntList (0w1234567, 5) + val () = app (print o (fn s => s ^ "\n") o LargeInt.toString) five_ints + val () = print "\n" + val hist_list = testNextReal (0w987654321, 5) + val () = print (String.concatWith ", " hist_list) + val () = print "\n" + in + () + end + +val () = main () diff --git a/Task/Pseudo-random-numbers-Xorshift-star/M2000-Interpreter/pseudo-random-numbers-xorshift-star.m2000 b/Task/Pseudo-random-numbers-Xorshift-star/M2000-Interpreter/pseudo-random-numbers-xorshift-star.m2000 new file mode 100644 index 0000000000..e756842fbc --- /dev/null +++ b/Task/Pseudo-random-numbers-Xorshift-star/M2000-Interpreter/pseudo-random-numbers-xorshift-star.m2000 @@ -0,0 +1,86 @@ +module Pseudo_random_numbers{ + class Xorshift_star{ + private: + Decimal state=int(rnd*0x2000_0000_0000_0000) ' Must be seeded to non-zero initial value + final MAGIC=0x2545F4914F6CDD1D + function xorU64(x, y) { + const dec1=0x1_0000_0000 + x_u=x div dec1 + x_d=x mod dec1 + y_u=y div dec1 + y_d=y mod dec1 + =binary.xor(x_u, y_u)*dec1+binary.xor(x_d, y_d) + } + function ShiftRightU64(x, y) { + boolean skip + const dec1=0x1_0000_0000 + if y>31 then y=y-32:skip=true + y=-abs(y) + x_u=x div dec1 + if skip then + = binary.shift(x_u, y) + else + x_d=x mod dec1 + f1= binary.not(binary.shift(0xFFFF_FFFF, y)) + f2= binary.and(binary.rotate(x_u, y), f1) + = binary.shift(x_u, y)*dec1+binary.shift(x_d, y)+f2 + end if + } + function ShiftLeftU64(x, y) { + boolean skip + y=abs(y) + const dec1=0x1_0000_0000 + if y>31 then y=y-32:skip=true + x_d=x mod dec1 + if skip then + =binary.shift(x_d, y)*dec1 + else + f1= binary.not(binary.shift(0xFFFF_FFFF, y)) + f2= binary.and(binary.rotate(x_d, y), f1)*dec1 + x_u=x div dec1 + = binary.shift(x_u, y)*dec1+binary.shift(x_d, y)+f2 + end if + } + function mul64to32(x, y) { + const dd=0x1_0000_0000 + long long a=x mod dd, b=x div dd + long long a1=y mod dd, b1=y div dd + decimal mm=0 + p1=a*a1 + mm+=p1 + p1=(b*a1+a*b1) mod dd + mm+=p1*dd + =(mm div dd) mod dd + } + public: + module seed(num as decimal) { + .state <= int(abs(num)) + } + function next_int() { + x =.state + x = .xorU64(x, .ShiftRightU64(x, 12)) + x = .xorU64(x, .ShiftLeftU64(x, 25)) + x = .xorU64(x, .ShiftRightU64(x, 27)) + .state <= x + =.mul64to32(x, .MAGIC) + } + function next_float() { + = .next_int() /0x1_0000_0000 + } + } + k=Xorshift_star() + k.seed 1234567 + Print k.next_int() + Print k.next_int() + Print k.next_int() + Print k.next_int() + Print k.next_int() + k.seed 987654321 + dim hist(5) + for i=1 to 100_000:hist(floor(k.next_float()*5))++:next + z=each(hist()) + while z + print z^;": "; array(z) + end while +} +Pseudo_random_numbers diff --git a/Task/Pseudo-random-numbers-Xorshift-star/Quackery/pseudo-random-numbers-xorshift-star.quackery b/Task/Pseudo-random-numbers-Xorshift-star/Quackery/pseudo-random-numbers-xorshift-star.quackery new file mode 100644 index 0000000000..27f15ca184 --- /dev/null +++ b/Task/Pseudo-random-numbers-Xorshift-star/Quackery/pseudo-random-numbers-xorshift-star.quackery @@ -0,0 +1,25 @@ + [ $ "bigrat.qky" loadfile ] now! + + [ ' [ stack ] swap join nested + ' [ dup share + dup 12 >> ^ + dup 25 << 64bits ^ + dup 27 >> ^ + dup rot replace + hex 2545F4914F6CDD1D + * 64bits 32 >> ] join ] is makerand ( --> [ ) + + [ ]'[ 0 peek replace ] is reseed ( x --> ) + + [ [ 32 bit ] constant reduce ] is vrand ( n --> n/d ) + + [ 1234567 makerand ] maker is rand1 ( --> n ) + + 5 times [ rand1 echo cr ] + cr + 987654321 reseed rand1 + 0 5 of + 100000 times + [ rand1 vrand 5 1 v* / + 2dup peek 1+ unrot poke ] + echo diff --git a/Task/Pythagoras-tree/JavaScript/pythagoras-tree-2.js b/Task/Pythagoras-tree/JavaScript/pythagoras-tree-2.js index d523e5bf33..8e9c4abb97 100644 --- a/Task/Pythagoras-tree/JavaScript/pythagoras-tree-2.js +++ b/Task/Pythagoras-tree/JavaScript/pythagoras-tree-2.js @@ -1,14 +1,10 @@ -let base = [[{ x: -200, y: 0 }, { x: 200, y: 0 }]]; -const doc = [...Array(12)].reduce((doc_a, _, lvl) => { - const rg = step => `0${(80 + (lvl - 2) * step).toString(16)}`.slice(-2); - return doc_a + base.splice(0).reduce((ga, [a, b]) => { - const w = (kx, ky) => (kx * (b.x - a.x) + ky * (b.y - a.y)) / 2; - const [c, e, d] = [2, 3, 2].map((j, i) => ({ x: a.x + w(i, j), y: a.y + w(-j, i) })); +const base = [[[-200, 0], [200, 0]],]; +document.documentElement.innerHTML = [...Array(12)].reduce((svg_a, _, lvl) => { + const rg = step => (80 + (lvl - 2) * step) & 255; + return svg_a + base.splice(0).reduce((g_a, [a, b]) => { + const w = (k0, k1) => (k0 * (b[0] - a[0]) + k1 * (b[1] - a[1])) / 2; + const [c, e, d] = [2, 3, 2].map((j, i) => [a[0] + w(i, j), a[1] + w(-j, i)]); base.push([c, e], [e, d]); - return ga + `\n`; - }, `\n`) + '\n'; -}, '\n') + ''; - -const { x, y } = base.flat().reduce((a, p) => ({ x: Math.min(a.x, p.x), y: Math.min(a.y, p.y) })); -const svg = doc.replace('`; + }, ``) + ''; +}, '') + '', ""; diff --git a/Task/Quickselect-algorithm/R/quickselect-algorithm.r b/Task/Quickselect-algorithm/R/quickselect-algorithm.r new file mode 100644 index 0000000000..3080e241a5 --- /dev/null +++ b/Task/Quickselect-algorithm/R/quickselect-algorithm.r @@ -0,0 +1,21 @@ +quickselect <- function(vec, k) { + stopifnot(k > 0, k <= length(vec)) + repeat { + pivot_index <- sample.int(length(vec), 1) + pivot_value <- vec[[pivot_index]] + left <- vec[vec < pivot_value] + right <- vec[vec > pivot_value] + pivot_index <- length(left) + 1 + if (k == pivot_index) { + return(pivot_value) + } else if (k < pivot_index) { + vec <- left + } else { + k <- k - pivot_index + vec <- right + } + } +} + +vec <- c(9, 8, 7, 6, 5, 0, 1, 2, 3, 4) +print(sapply(1:10, quickselect, vec = vec)) diff --git a/Task/Radical-of-an-integer/Arturo/radical-of-an-integer.arturo b/Task/Radical-of-an-integer/Arturo/radical-of-an-integer.arturo new file mode 100644 index 0000000000..34f235ef96 --- /dev/null +++ b/Task/Radical-of-an-integer/Arturo/radical-of-an-integer.arturo @@ -0,0 +1,15 @@ +radical: $[n]-> product unique factors.prime n + +(1..50) | map => radical + | split.every:10 + | map => [join map & 'r -> pad to :string r 4] + | print.lines + +print "" +loop [99999, 499999, 999999] 'r -> + print ["Radical of" r "->" radical r] +print "" + +(1..1000000) | map => [size unique factors.prime &] + | tally + | loop [k,v] -> print [k ":" v] diff --git a/Task/Radical-of-an-integer/Kotlin/radical-of-an-integer.kts b/Task/Radical-of-an-integer/Kotlin/radical-of-an-integer.kts new file mode 100644 index 0000000000..3869cef59d --- /dev/null +++ b/Task/Radical-of-an-integer/Kotlin/radical-of-an-integer.kts @@ -0,0 +1,64 @@ +import java.util.BitSet +import java.util.TreeMap +import kotlin.math.sqrt + +class Radicals(val limit: Int) { + val primes: List + val radicals: IntArray // valid indices: 1..limit + val distinctPrimeFactorCounts: IntArray // valid indices: 2..limit + val distinctPrimeFactorCountDistribution: Map + + init { + // Sieve + val composites = BitSet() + for (i in 2..sqrt(limit.toDouble()).toInt()) { + if (!composites[i]) { + for (j in i * i..limit step i) composites.set(j) + } + } + primes = (2..limit).filterNot(composites::get) + + // Calculate radicals and distinct prime factor counts + distinctPrimeFactorCounts = IntArray(limit + 1) { 0 } + radicals = IntArray(limit + 1) { 1 } + for (p in primes) { + for (i in p..limit step p) { + distinctPrimeFactorCounts[i]++ + radicals[i] *= p + } + } + + distinctPrimeFactorCountDistribution = + distinctPrimeFactorCounts.asList() + .subList(2, distinctPrimeFactorCounts.size) + .groupingBy { it } + .eachCountTo(TreeMap()) + } +} + +fun main() { + with(Radicals(limit = 1_000_000)) { + println("Radicals of first 50 positive integers:") + for (i in 1..41 step 10) { + println((i..i + 9).joinToString(separator = " ") { "%2d".format(radicals[it]) }) + } + println() + + for (n in listOf(99_999, 499_999, 999_999)) { + println("Radical for %6d: %6d".format(n, radicals[n])) + } + println() + + println("Distribution of the first $limit positive integers by numbers of distinct prime factors:") + for ((i, count) in distinctPrimeFactorCountDistribution) { + println("%d: %6d".format(i, count)) + } + println() + + println("Number of primes and powers of primes less than or equal to $limit:") + val count = primes.sumOf { prime -> + generateSequence(limit) { it / prime }.takeWhile { it >= prime }.count() + } + println(count) + } +} diff --git a/Task/Ramanujan-primes-twins/Python/ramanujan-primes-twins.py b/Task/Ramanujan-primes-twins/Python/ramanujan-primes-twins.py new file mode 100644 index 0000000000..31e760dcef --- /dev/null +++ b/Task/Ramanujan-primes-twins/Python/ramanujan-primes-twins.py @@ -0,0 +1,105 @@ +import math + +def ramanujan_maximum(number: int): + return math.ceil(4 * number * math.log(4 * number)) + +def initialise_prime_pi(limit: int): + result = [1] * limit + result[0] = 0 + result[1] = 0 + + for i in range(4, limit, 2): + result[i] = 0 + + p = 3 + square = 9 + + while square < limit: + if result[p] != 0: + q = square + + while q < limit: + result[q] = 0 + q += p << 1 + + square += (p + 1) << 2 + p += 2 + + for i in range(1, len(result)): + result[i] += result[i - 1] + + return result + +def ramanujan_prime(prime_pi: list[int], number: int): + maximum = ramanujan_maximum(number) + + if maximum & 1 == 1: + maximum -= 1 + + index = maximum + + while prime_pi[index] - prime_pi[index // 2] >= number: + index -= 1 + + return index + 1 + +def list_primes_less_than(limit: int): + composite = [False] * limit + n = 3 + n_squared = 9 + + while n_squared <= limit: + if not composite[n]: + k = n_squared + + while k < limit: + composite[k] = True + k += 2 * n + + n_squared += (n + 1) << 2 + n += 2 + + result = [2] + + for i in range(3, limit, 2): + if not composite[i]: + result.append(i) + + return result + +def main(): + limit = 1_000_000 + prime_pi = initialise_prime_pi(ramanujan_maximum(limit) + 1) + millionth_ramanujan_prime = ramanujan_prime(prime_pi, limit) + print("The 1_000_000th Ramanujan prime is", millionth_ramanujan_prime) + + primes = list_primes_less_than(millionth_ramanujan_prime) + ramanujan_prime_indexes = [0] * len(primes) + + for i in range(len(ramanujan_prime_indexes)): + ramanujan_prime_indexes[i] = prime_pi[primes[i]] - prime_pi[primes[i] // 2] + + lower_limit = ramanujan_prime_indexes[len(ramanujan_prime_indexes) - 1] + + for i in range(len(ramanujan_prime_indexes) - 2, -1, -1): + if ramanujan_prime_indexes[i] < lower_limit: + lower_limit = ramanujan_prime_indexes[i] + else: + ramanujan_prime_indexes[i] = 0 + + ramanujan_primes = [] + + for i in range(len(ramanujan_prime_indexes)): + if ramanujan_prime_indexes[i] != 0: + ramanujan_primes.append(primes[i]) + + twins_count = 0 + + for i in range(len(ramanujan_primes) - 1): + if ramanujan_primes[i] + 2 == ramanujan_primes[i + 1]: + twins_count += 1 + + print("There are", twins_count, "twins in the first", limit, "Ramanujan primes.") + +if __name__ == '__main__': + main() diff --git a/Task/Random-number-generator-device-/Atari-BASIC/random-number-generator-device-.basic b/Task/Random-number-generator-device-/Atari-BASIC/random-number-generator-device-.basic new file mode 100644 index 0000000000..5b062d820f --- /dev/null +++ b/Task/Random-number-generator-device-/Atari-BASIC/random-number-generator-device-.basic @@ -0,0 +1,5 @@ +10 X=0 +20 FOR I=0 TO 3 +30 X=X+PEEK(53770)*(256^I) +40 NEXT I +50 PRINT X diff --git a/Task/Random-number-generator-device-/Commodore-BASIC/random-number-generator-device-.basic b/Task/Random-number-generator-device-/Commodore-BASIC/random-number-generator-device-.basic new file mode 100644 index 0000000000..1b70494db1 --- /dev/null +++ b/Task/Random-number-generator-device-/Commodore-BASIC/random-number-generator-device-.basic @@ -0,0 +1,8 @@ +10 POKE 54286,255 +20 POKE 54287,255 +30 POKE 54290,128 +40 X=0 +50 FOR I=0 TO 3 +60 X=X+PEEK(54299)*(256^I) +70 NEXT +80 PRINT X diff --git a/Task/Range-expansion/FutureBasic/range-expansion.basic b/Task/Range-expansion/FutureBasic/range-expansion.basic new file mode 100644 index 0000000000..193ed1191f --- /dev/null +++ b/Task/Range-expansion/FutureBasic/range-expansion.basic @@ -0,0 +1,26 @@ +CFStringRef local fn ExpandRanges( string as CFStringRef ) + CFArrayRef ranges = fn StringComponentsSeparatedByString( string, @"," ) + CFStringRef expanded = @"" + for CFStringRef s in ranges + ScannerRef scanner = fn ScannerWithString( s ) + long first, last + if ( fn ScannerScanInteger( scanner, @first ) ) + if ( len(expanded) ) then expanded = concat(expanded,@", ") + expanded = concat(expanded,@(first)) + end if + if ( !fn ScannerIsAtEnd( scanner ) ) + if ( fn ScannerScanString( scanner, @"-", NULL ) ) + if ( fn ScannerScanInteger( scanner, @last ) ) + for long i = first + 1 to last + if ( len(expanded) ) then expanded = concat(expanded,@", ") + expanded = concat(expanded,@(i)) + next + end if + end if + end if + next +end fn = expanded + +print fn ExpandRanges( @"-6,-3--1,3-5,7-11,14,15,17-20" ) + +HandleEvents diff --git a/Task/Range-extraction/FutureBasic/range-extraction.basic b/Task/Range-extraction/FutureBasic/range-extraction.basic new file mode 100644 index 0000000000..0c69b04582 --- /dev/null +++ b/Task/Range-extraction/FutureBasic/range-extraction.basic @@ -0,0 +1,46 @@ +void local fn DoRangeExtraction + CFArrayRef nums = @[ + @0 , @1 , @2 , @4 , @6 , @7 , @8 , @11, @12, @14, + @15, @16, @17, @18, @19, @20, @21, @22, @23, @24, + @25, @27, @28, @29, @30, @31, @32, @33, @35, @36, + @37, @38, @39] + + CFMutableArrayRef array = fn MutableArrayNew + CFRange range + long prevNum = NSNotFound + + for CFNumberRef num in nums + if ( prevNum == NSNotFound ) + range = fn CFRangeMake(intval(num),1) + else + if ( intval(num) == prevNum + 1 ) + range.length++ + else + MutableArrayAddObject( array, @(range) ) + range = fn CFRangeMake(intval(num),1) + end if + end if + prevNum = intval(num) + next + MutableArrayAddObject( array, @(range) ) + + CFMutableStringRef ranges = fn MutableStringNew + for ValueRef value in array + range = fn ValueRange( value ) + if ( range.length > 2 ) + if ( len(ranges) ) then MutableStringAppendString(ranges,@", ") + MutableStringAppendFormat( ranges, @"%ld-%ld", range.location, range.location + range.length - 1 ) + else + for long i = range.location to range.location + range.length - 1 + if ( len(ranges) ) then MutableStringAppendString(ranges,@", ") + MutableStringAppendFormat( ranges, @"%ld", i ) + next + end if + next + + print ranges +end fn + +fn DoRangeExtraction + +HandleEvents diff --git a/Task/Ranking-methods/Fortran/ranking-methods.f b/Task/Ranking-methods/Fortran/ranking-methods.f new file mode 100644 index 0000000000..99d63bdd8e --- /dev/null +++ b/Task/Ranking-methods/Fortran/ranking-methods.f @@ -0,0 +1,145 @@ +module ranking_methods + implicit none + private + public :: standard_ranking, modified_ranking, dense_ranking, ordinal_ranking, fractional_ranking + +contains + + subroutine standard_ranking(scores, names, ranks) + implicit none + real, intent(in) :: scores(:) + character(len=*), intent(in) :: names(:) + real, allocatable, intent(out) :: ranks(:) + integer :: i, n + + n = size(scores) + allocate(ranks(n)) + ranks(1) = 1.0 + do i = 2, n + ranks(i) = MERGE(ranks(i-1), REAL(i), scores(i) == scores(i-1)) + end do + end subroutine standard_ranking + + subroutine modified_ranking(scores, names, ranks) + implicit none + real, intent(in) :: scores(:) + character(len=*), intent(in) :: names(:) + real, allocatable, intent(out) :: ranks(:) + integer :: i, j, n + + n = size(scores) + allocate(ranks(n)) + do i = 1, n + ranks(i) = real(i) + do j = i+1, n + if (scores(j) == scores(i)) then + ranks(j) = ranks(i) + end if + end do + end do + end subroutine modified_ranking + + subroutine dense_ranking(scores, names, ranks) + implicit none + real, intent(in) :: scores(:) + character(len=*), intent(in) :: names(:) + real, allocatable, intent(out) :: ranks(:) + integer :: i, n + real :: current_rank + + n = size(scores) + allocate(ranks(n)) + current_rank = 1.0 + ranks(1) = current_rank + do i = 2, n + if (scores(i) /= scores(i-1)) then + current_rank = current_rank + 1 + end if + ranks(i) = current_rank + end do + end subroutine dense_ranking + + + subroutine ordinal_ranking(scores, names, ranks) + real, intent(in) :: scores(:) + character(len=*), intent(in) :: names(:) + real, allocatable, intent(out) :: ranks(:) + integer :: i, n + + n = size(scores) + allocate(ranks(n)) + do i = 1, n + ranks(i) = real(i) + end do + end subroutine ordinal_ranking + +subroutine fractional_ranking(scores, names, ranks) + implicit none + real, intent(in) :: scores(:) + character(len=*), intent(in) :: names(:) + real, allocatable, intent(out) :: ranks(:) + integer :: i, j, n + real :: sum_rank + + n = size(scores) + allocate(ranks(n)) + + i = 1 + do while (i <= n) + sum_rank = real(i) + j = i + 1 + do while (j <= n .and. scores(j) == scores(i)) + sum_rank = sum_rank + real(j) + j = j + 1 + end do + ranks(i:j-1) = sum_rank / (j - i) + i = j + end do +end subroutine fractional_ranking + + +program main + use ranking_methods + implicit none + + real, dimension(7) :: scores = [44.0, 42.0, 42.0, 41.0, 41.0, 41.0, 39.0] + character(len=10), dimension(7) :: names = ["Solomon ", "Jason ", "Errol ", & + "Garry ", "Bernard ", "Barry ", "Stephen "] + real, allocatable :: ranks(:) + integer :: i + + print *, "Standard Ranking:" + call standard_ranking(scores, names, ranks) + call print_results(scores, names, ranks) + + print *, "Modified Ranking:" + call modified_ranking(scores, names, ranks) + call print_results(scores, names, ranks) + + print *, "Dense Ranking:" + call dense_ranking(scores, names, ranks) + call print_results(scores, names, ranks) + + print *, "Ordinal Ranking:" + call ordinal_ranking(scores, names, ranks) + call print_results(scores, names, ranks) + + print *, "Fractional Ranking:" + call fractional_ranking(scores, names, ranks) + call print_results(scores, names, ranks) + +contains + + subroutine print_results(scores, names, ranks) + real, intent(in) :: scores(:), ranks(:) + character(len=*), intent(in) :: names(:) + integer :: i + + do i = 1, size(scores) + print '(F5.1, 2X, A10, 2X, F5.1)', scores(i), names(i), ranks(i) + end do + print * + end subroutine print_results + +end program main +end module ranking_methods diff --git a/Task/Read-a-file-line-by-line/Joy/read-a-file-line-by-line.joy b/Task/Read-a-file-line-by-line/Joy/read-a-file-line-by-line.joy new file mode 100644 index 0000000000..7f5196961d --- /dev/null +++ b/Task/Read-a-file-line-by-line/Joy/read-a-file-line-by-line.joy @@ -0,0 +1,9 @@ +(* Reads file input.txt and puts the lines as char in a list *) + +"input.txt" "r" fopen +(* while not end get char and swap the end to get the stream object for fgets *) +[ feof not ] [ fgets swap ] while +(*pop the stream object *) +pop +stack +. diff --git a/Task/Read-a-file-line-by-line/Scheme/read-a-file-line-by-line.scm b/Task/Read-a-file-line-by-line/Scheme/read-a-file-line-by-line-1.scm similarity index 100% rename from Task/Read-a-file-line-by-line/Scheme/read-a-file-line-by-line.scm rename to Task/Read-a-file-line-by-line/Scheme/read-a-file-line-by-line-1.scm diff --git a/Task/Read-a-file-line-by-line/Scheme/read-a-file-line-by-line-2.scm b/Task/Read-a-file-line-by-line/Scheme/read-a-file-line-by-line-2.scm new file mode 100644 index 0000000000..a44d775675 --- /dev/null +++ b/Task/Read-a-file-line-by-line/Scheme/read-a-file-line-by-line-2.scm @@ -0,0 +1,5 @@ +; For R6RS Scheme i.e. Chez Scheme +(define file (open-input-file path)) +(do ((line (get-line file) (get-line file))) ((eof-object? line)) + (display line) + (newline)) diff --git a/Task/Read-a-file-line-by-line/Standard-ML/read-a-file-line-by-line.ml b/Task/Read-a-file-line-by-line/Standard-ML/read-a-file-line-by-line.ml index 87d2f47de3..08fe006787 100644 --- a/Task/Read-a-file-line-by-line/Standard-ML/read-a-file-line-by-line.ml +++ b/Task/Read-a-file-line-by-line/Standard-ML/read-a-file-line-by-line.ml @@ -1,13 +1,10 @@ fun readLines string = let val strm = TextIO.openIn path - fun chomp str = - let - val xstr = String.explode str - val slen = List.length xstr - in - String.implode(List.take(xstr, (slen-1))) - end + (* this would remove all trailing whitespace *) + (* fun chomp str = Substring.string (Substring.dropr Char.isSpace (Substring.full str)) *) + (* but TextIO.inputLine guarantees that the line is newline terminated so this works equally well *) + fun chomp str = Substring.string (Substring.trimr 1 (Substring.full str)) fun collectLines ls s = case TextIO.inputLine s of SOME(l) => collectLines (chomp l::ls) s diff --git a/Task/Read-a-specific-line-from-a-file/M2000-Interpreter/read-a-specific-line-from-a-file.m2000 b/Task/Read-a-specific-line-from-a-file/M2000-Interpreter/read-a-specific-line-from-a-file.m2000 new file mode 100644 index 0000000000..14c9dc7368 --- /dev/null +++ b/Task/Read-a-specific-line-from-a-file/M2000-Interpreter/read-a-specific-line-from-a-file.m2000 @@ -0,0 +1,58 @@ +Module Read_a_specific_line_from_a_file { + select case rnd + case <0.4 + document ExportThis$=format$("1.\n2.\n3.\n4.\n5.\n6.\n\n8.") + case <0.8 + document ExportThis$=format$("1.\n2.\n3.\n4.\n5.\n6.\n7. la cédille (cedilla) – ç\n8.") + case else + document ExportThis$=format$("1.\n2.\n3.\n4.\n5.\n6.") + end select + ' Print len(ExportThis$)=55 + If Doc.par(ExportThis$)>6 then + If len(Paragraph$(ExportThis$, 7))=0 then + print "Empty 7th Line" + else + Print Paragraph$(ExportThis$, 7) + end if + else + Print "There is no 7th line" + end if + ' expot with varius encoding, BOM included/excluded, line seperators. + ' We use here Ansi codepage 1033 + Save.Doc ExportThis$, "Input.txt", 1033 + ' set locale - used from open to convert to UTF16LE (default intenal type) + locale 1033 + ' open used for binary/text ansi/utf16le + open "input.txt" for input as #f + integer m=1 + boolean ok + while not eof(#f) and not ok + line input #f, L$ + if m=7 then + ok=true + if L$="" then + print "Empty 7th Line" + else + Print L$ + end if + end if + m++ + end while + if not ok then Print "There is no 7th line" + close #f + ' Print filelen("Input.txt")=55 + Document ImportDoc$ + Load.Doc ImportDoc$, "Input.txt", 1033 + ' Print len(ImportDoc$)=55 + If Doc.par(ImportDoc$)>6 then + If len(Paragraph$(ImportDoc$, 7))=0 then + print "Empty 7th Line" + else + Print Paragraph$(ImportDoc$, 7) + end if + else + Print "There is no 7th line" + end if +} + +Read_a_specific_line_from_a_file diff --git a/Task/Read-entire-file/Forth/read-entire-file.fth b/Task/Read-entire-file/Forth/read-entire-file-1.fth similarity index 100% rename from Task/Read-entire-file/Forth/read-entire-file.fth rename to Task/Read-entire-file/Forth/read-entire-file-1.fth diff --git a/Task/Read-entire-file/Forth/read-entire-file-2.fth b/Task/Read-entire-file/Forth/read-entire-file-2.fth new file mode 100644 index 0000000000..0b45f69f33 --- /dev/null +++ b/Task/Read-entire-file/Forth/read-entire-file-2.fth @@ -0,0 +1,2 @@ +: read-file "foo.txt" GET-FILE TYPE ; +read-file diff --git a/Task/Read-entire-file/Racket/read-entire-file.rkt b/Task/Read-entire-file/Racket/read-entire-file.rkt index 19b556e463..18a197bb6e 100644 --- a/Task/Read-entire-file/Racket/read-entire-file.rkt +++ b/Task/Read-entire-file/Racket/read-entire-file.rkt @@ -1 +1,2 @@ +(require racket/file) (file->string "foo.txt") diff --git a/Task/Read-entire-file/Zig/read-entire-file-1.zig b/Task/Read-entire-file/Zig/read-entire-file-1.zig index 77aca01305..6ae327f52f 100644 --- a/Task/Read-entire-file/Zig/read-entire-file-1.zig +++ b/Task/Read-entire-file/Zig/read-entire-file-1.zig @@ -1,18 +1,14 @@ const std = @import("std"); -const File = std.fs.File; - -pub fn main() (error{OutOfMemory} || File.OpenError || File.ReadError)!void { +pub fn main() !void { var gpa: std.heap.GeneralPurposeAllocator(.{}) = .{}; defer _ = gpa.deinit(); const allocator = gpa.allocator(); - const cwd = std.fs.cwd(); - - var file = try cwd.openFile("input_file.txt", .{ .mode = .read_only }); + var file = try std.fs.cwd().openFile("input_file.txt", .{}); defer file.close(); - const file_content = try file.readToEndAlloc(allocator, comptime std.math.maxInt(usize)); + const file_content = try file.readToEndAlloc(allocator, (try file.stat()).size); defer allocator.free(file_content); std.debug.print("Read {d} octets. File content:\n", .{file_content.len}); diff --git a/Task/Real-constants-and-functions/REXX/real-constants-and-functions-9.rexx b/Task/Real-constants-and-functions/REXX/real-constants-and-functions-9.rexx new file mode 100644 index 0000000000..7fc4460e78 --- /dev/null +++ b/Task/Real-constants-and-functions/REXX/real-constants-and-functions-9.rexx @@ -0,0 +1,19 @@ +include Settings + +say version; say 'Real constants and functions'; say +numeric digits 16 +say 'e =' e()+0 +say 'pi =' pi()+0 +say 'square root 7 =' sqrt(7)+0 +say 'log 7 base e =' log(7)+0 +say 'log 7 base 10 =' log10(7)+0 +say 'log 7 base 2 =' logxy(7,2)+0 +say 'exponential 7 =' exp(7)+0 +say '1/2^3/4 =' power(1/2,3/4)+0 +say 'floor 4/3 =' floor(4/3) +say 'ceiling 4/3 =' ceil(4/3) +exit + +include Functions +include Constants +include Abend diff --git a/Task/Real-constants-and-functions/Uiua/real-constants-and-functions.uiua b/Task/Real-constants-and-functions/Uiua/real-constants-and-functions.uiua new file mode 100644 index 0000000000..e910174315 --- /dev/null +++ b/Task/Real-constants-and-functions/Uiua/real-constants-and-functions.uiua @@ -0,0 +1,9 @@ +π # pi +√x # sqrt +e # e +ₙe x # natural logarithm +ₙy x # logarithm - x is the number ot take the logarithm of and y is the power to take the log with respect to. +⁅x # absolute value, called "round" in uiua +⌊x # floor +⌈x # ceiling +ⁿy x # power - x is the base and y is the power diff --git a/Task/Recamans-sequence/Haskell/recamans-sequence-2.hs b/Task/Recamans-sequence/Haskell/recamans-sequence-2.hs index b7263ccd28..b1e6f2c5bc 100644 --- a/Task/Recamans-sequence/Haskell/recamans-sequence-2.hs +++ b/Task/Recamans-sequence/Haskell/recamans-sequence-2.hs @@ -1,42 +1,8 @@ -import Data.Set (Set, fromList, insert, isSubsetOf, member, size) -import Data.Bool (bool) - -firstNRecamans :: Int -> [Int] -firstNRecamans n = reverse $ recamanUpto (\(_, i, _) -> n == i) - -firstDuplicateR :: Int -firstDuplicateR = head $ recamanUpto (\(rs, _, set) -> size set /= length rs) - -recamanSuperset :: Set Int -> [Int] -recamanSuperset setInts = - tail $ recamanUpto (\(_, _, setR) -> isSubsetOf setInts setR) - -recamanUpto :: (([Int], Int, Set Int) -> Bool) -> [Int] -recamanUpto p = rs - where - (rs, _, _) = - until - p - (\(rs@(r:_), i, seen) -> - let n = nextR seen i r - in (n : rs, succ i, insert n seen)) - ([0], 1, fromList [0]) - -nextR :: Set Int -> Int -> Int -> Int -nextR seen i r = - let back = r - i - in bool back (r + i) (0 > back || member back seen) - --- TEST --------------------------------------------------------------- -main :: IO () -main = - (putStrLn . unlines) - [ "First 15 Recamans:" - , show $ firstNRecamans 15 - , [] - , "First duplicated Recaman:" - , show firstDuplicateR - , [] - , "Length of Recaman series required to include [0..1000]:" - , (show . length . recamanSuperset) $ fromList [0 .. 1000] - ] +recaman :: Integer -> [Integer] +recaman n = reverse (go 0 0 []) + where + go i a_n xs | i > n = xs + | (am > 0) && (not (any (am ==) xs)) = go (i + 1) am (am : xs) + | otherwise = go (i + 1) ap (ap : xs) + where am = a_n - (i + 1) + ap = a_n + (i + 1) diff --git a/Task/Recamans-sequence/Haskell/recamans-sequence-3.hs b/Task/Recamans-sequence/Haskell/recamans-sequence-3.hs index 01113e4b84..b7263ccd28 100644 --- a/Task/Recamans-sequence/Haskell/recamans-sequence-3.hs +++ b/Task/Recamans-sequence/Haskell/recamans-sequence-3.hs @@ -1,47 +1,42 @@ -import Data.List (find, findIndex, nub) -import Data.Maybe (fromJust) -import Data.Set (Set, fromList, insert, isSubsetOf, member) +import Data.Set (Set, fromList, insert, isSubsetOf, member, size) +import Data.Bool (bool) ---- INFINITE STREAM OF RECAMAN SERIES OF GROWING LENGTH -- -rSeries :: [[Int]] -rSeries = - scanl - ( \rs@(r : _) i -> - let back = r - i - nxt - | 0 > back || elem back rs = r + i - | otherwise = back - in nxt : rs - ) - [0] - [1 ..] +firstNRecamans :: Int -> [Int] +firstNRecamans n = reverse $ recamanUpto (\(_, i, _) -> n == i) ------------ INFINITE STREAM OF RECAMAN-GENERATED --------- ---------------- INTEGER SETS OF GROWING SIZE ------------- -rSets :: [(Set Int, Int)] -rSets = - scanl - ( \(seen, r) i -> - let back = r - i - nxt - | 0 > back || member back seen = r + i - | otherwise = back - in (insert nxt seen, nxt) - ) - (fromList [0], 0) - [1 ..] +firstDuplicateR :: Int +firstDuplicateR = head $ recamanUpto (\(rs, _, set) -> size set /= length rs) ---------------------------- TEST ------------------------- +recamanSuperset :: Set Int -> [Int] +recamanSuperset setInts = + tail $ recamanUpto (\(_, _, setR) -> isSubsetOf setInts setR) + +recamanUpto :: (([Int], Int, Set Int) -> Bool) -> [Int] +recamanUpto p = rs + where + (rs, _, _) = + until + p + (\(rs@(r:_), i, seen) -> + let n = nextR seen i r + in (n : rs, succ i, insert n seen)) + ([0], 1, fromList [0]) + +nextR :: Set Int -> Int -> Int -> Int +nextR seen i r = + let back = r - i + in bool back (r + i) (0 > back || member back seen) + +-- TEST --------------------------------------------------------------- main :: IO () -main = do - let setK = fromList [0 .. 1000] +main = (putStrLn . unlines) - [ "First 15 Recamans:", - show . reverse . fromJust $ find ((15 ==) . length) rSeries, - [], - "First duplicated Recaman:", - show . head . fromJust $ find ((/=) <$> length <*> (length . nub)) rSeries, - [], - "Length of Recaman series required to include [0..1000]:", - show . fromJust $ findIndex (\(setR, _) -> isSubsetOf setK setR) rSets + [ "First 15 Recamans:" + , show $ firstNRecamans 15 + , [] + , "First duplicated Recaman:" + , show firstDuplicateR + , [] + , "Length of Recaman series required to include [0..1000]:" + , (show . length . recamanSuperset) $ fromList [0 .. 1000] ] diff --git a/Task/Recamans-sequence/Haskell/recamans-sequence-4.hs b/Task/Recamans-sequence/Haskell/recamans-sequence-4.hs new file mode 100644 index 0000000000..01113e4b84 --- /dev/null +++ b/Task/Recamans-sequence/Haskell/recamans-sequence-4.hs @@ -0,0 +1,47 @@ +import Data.List (find, findIndex, nub) +import Data.Maybe (fromJust) +import Data.Set (Set, fromList, insert, isSubsetOf, member) + +--- INFINITE STREAM OF RECAMAN SERIES OF GROWING LENGTH -- +rSeries :: [[Int]] +rSeries = + scanl + ( \rs@(r : _) i -> + let back = r - i + nxt + | 0 > back || elem back rs = r + i + | otherwise = back + in nxt : rs + ) + [0] + [1 ..] + +----------- INFINITE STREAM OF RECAMAN-GENERATED --------- +--------------- INTEGER SETS OF GROWING SIZE ------------- +rSets :: [(Set Int, Int)] +rSets = + scanl + ( \(seen, r) i -> + let back = r - i + nxt + | 0 > back || member back seen = r + i + | otherwise = back + in (insert nxt seen, nxt) + ) + (fromList [0], 0) + [1 ..] + +--------------------------- TEST ------------------------- +main :: IO () +main = do + let setK = fromList [0 .. 1000] + (putStrLn . unlines) + [ "First 15 Recamans:", + show . reverse . fromJust $ find ((15 ==) . length) rSeries, + [], + "First duplicated Recaman:", + show . head . fromJust $ find ((/=) <$> length <*> (length . nub)) rSeries, + [], + "Length of Recaman series required to include [0..1000]:", + show . fromJust $ findIndex (\(setR, _) -> isSubsetOf setK setR) rSets + ] diff --git a/Task/Record-sound/Wren/record-sound-1.wren b/Task/Record-sound/Wren/record-sound-1.wren deleted file mode 100644 index 8922c706f5..0000000000 --- a/Task/Record-sound/Wren/record-sound-1.wren +++ /dev/null @@ -1,39 +0,0 @@ -/* Record_sound.wren */ - -class C { - foreign static getInput(maxSize) - - foreign static arecord(args) - - foreign static aplay(name) -} - -var name = "" -while (name == "") { - System.write("Enter output file name (without extension) : ") - name = C.getInput(80) -} -name = name + ".wav" - -var rate = 0 -while (!rate || !rate.isInteger || rate < 2000 || rate > 192000) { - System.write("Enter sampling rate in Hz (2000 to 192000) : ") - rate = Num.fromString(C.getInput(6)) -} -var rateS = rate.toString - -var dur = 0 -while (!dur || dur < 5 || dur > 30) { - System.write("Enter duration in seconds (5 to 30) : ") - dur = Num.fromString(C.getInput(5)) -} -var durS = dur.toString - -System.print("\nOK, start speaking now...") -// Default arguments: -c 1, -t wav. Note only signed 16 bit format supported. -var args = ["-r", rateS, "-f", "S16_LE", "-d", durS, name] -C.arecord(args.join(" ")) - -System.print("\n'%(name)' created on disk and will now be played back...") -C.aplay(name) -System.print("\nPlay-back completed.") diff --git a/Task/Record-sound/Wren/record-sound-2.wren b/Task/Record-sound/Wren/record-sound-2.wren deleted file mode 100644 index 0ad3196c0d..0000000000 --- a/Task/Record-sound/Wren/record-sound-2.wren +++ /dev/null @@ -1,102 +0,0 @@ -#include -#include -#include -#include -#include "wren.h" - -void C_getInput(WrenVM* vm) { - int maxSize = (int)wrenGetSlotDouble(vm, 1) + 2; - char input[maxSize]; - fgets(input, maxSize, stdin); - __fpurge(stdin); - input[strcspn(input, "\n")] = 0; - wrenSetSlotString(vm, 0, (const char*)input); -} - -void C_arecord(WrenVM* vm) { - const char *args = wrenGetSlotString(vm, 1); - char command[strlen(args) + 8]; - strcpy(command, "arecord "); - strcat(command, args); - system(command); -} - -void C_aplay(WrenVM* vm) { - const char *name = wrenGetSlotString(vm, 1); - char command[strlen(name) + 6]; - strcpy(command, "aplay "); - strcat(command, name); - system(command); -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "C") == 0) { - if (isStatic && strcmp(signature, "getInput(_)") == 0) return C_getInput; - if (isStatic && strcmp(signature, "arecord(_)") == 0) return C_arecord; - if (isStatic && strcmp(signature, "aplay(_)") == 0) return C_aplay; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Record_sound.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Record-sound/Wren/record-sound.wren b/Task/Record-sound/Wren/record-sound.wren new file mode 100644 index 0000000000..f7437f90a3 --- /dev/null +++ b/Task/Record-sound/Wren/record-sound.wren @@ -0,0 +1,20 @@ +import "os" for Process +import "./ioutil" for Input + +var name = Input.text("Enter output file name (without extension) : ", 1, 80) +name = name + ".wav" + +var rate = Input.integer("Enter sampling rate in Hz (2000 to 192000) : ", 2000, 192000) +var rateS = rate.toString + +var dur = Input.number("Enter duration in seconds (5 to 30) : ", 5, 30) +var durS = dur.toString + +System.print("\nOK, start speaking now...") +// Default arguments: -c 1, -t wav. Note only signed 16 bit format supported. +var args = ["-r", rateS, "-f", "S16_LE", "-d", durS, name] +Process.exec("arecord", args) + +System.print("\n'%(name)' created on disk and will now be played back...") +Process.exec("aplay %(name)") +System.print("\nPlay-back completed.") diff --git a/Task/Reflection-List-methods/Arturo/reflection-list-methods.arturo b/Task/Reflection-List-methods/Arturo/reflection-list-methods.arturo new file mode 100644 index 0000000000..fe5abc95f4 --- /dev/null +++ b/Task/Reflection-List-methods/Arturo/reflection-list-methods.arturo @@ -0,0 +1,10 @@ +define :person [ + init: constructor [name surname] + + sayHello: method [][ + print ["Hello" \name "!"] + ] +] + +p: to :person ["John" "Doe"]! +print.lines methods p diff --git a/Task/Regular-expressions/Langur/regular-expressions-2.langur b/Task/Regular-expressions/Langur/regular-expressions-2.langur index bd9de4fe0c..9be6f90975 100644 --- a/Task/Regular-expressions/Langur/regular-expressions-2.langur +++ b/Task/Regular-expressions/Langur/regular-expressions-2.langur @@ -1 +1 @@ -if x, y = submatch(re/(abc+).+?(def)/, "somestring") { ... } +if x, y = submatch("somestring", by=re/(abc+).+?(def)/) { ... } diff --git a/Task/Regular-expressions/Langur/regular-expressions-5.langur b/Task/Regular-expressions/Langur/regular-expressions-5.langur index dd3a7ba9f8..01569b08a3 100644 --- a/Task/Regular-expressions/Langur/regular-expressions-5.langur +++ b/Task/Regular-expressions/Langur/regular-expressions-5.langur @@ -1,2 +1,2 @@ -replace("abcdef", re/abc/, "Y") +replace("abcdef", by=re/abc/, with="Y") # result: "Ydef" diff --git a/Task/Resistor-mesh/FutureBasic/resistor-mesh.basic b/Task/Resistor-mesh/FutureBasic/resistor-mesh.basic new file mode 100644 index 0000000000..be6a215e48 --- /dev/null +++ b/Task/Resistor-mesh/FutureBasic/resistor-mesh.basic @@ -0,0 +1,94 @@ +// Rosetta Code Resistor Mesh task +//https://rosettacode.org/wiki/Resistor_mesh +// Translation of Yabasic to FutureBasic + + +window 1,@"Resistor Mesh Task" + +#build ShowMoreWarnings NO +short N=10 +short NN=100 +double A(100,101) + +short NODE=0 +short ROW,COL + +FOR ROW=1 TO N + FOR COL=1 TO N + NODE=NODE+1 + IF ROW>1 + A(NODE,NODE)=A(NODE,NODE)+1 + A(NODE,NODE-N)=-1 + END IF + IF ROW1 + A(NODE,NODE)=A(NODE,NODE)+1 + A(NODE,NODE-1)=-1 + END IF + IF COL0 then break + NEXT + IF I=R+1 + PRINT "No solution!" + END + END IF + FOR K=1 TO R+1 + T = A(J,K) + A(J,K) = A(I,K) + A(I,K) = T + NEXT + Y= (1 / A(J,J)) + FOR K=1 TO R+1 + A(J,K) = Y * A(J,K) + NEXT + FOR I=1 TO R + IF I<>J + Y=-A(I,J) + FOR K=1 TO R+1 + A(I,K)=A(I,K)+ Y*A(J,K) + NEXT + END IF + NEXT +NEXT + +double Resistance + +Resistance = A(ANode,101)-A(BNode,101) + +PRINT +PRINT "Resistance between Nodes" str$(ANode) + " and" + str$(BNode) + " is" + str$(abs(Resistance)) + " Ohms" + + +handleevents diff --git a/Task/Reverse-a-string/Atari-BASIC/reverse-a-string.basic b/Task/Reverse-a-string/Atari-BASIC/reverse-a-string.basic new file mode 100644 index 0000000000..72e3a9129e --- /dev/null +++ b/Task/Reverse-a-string/Atari-BASIC/reverse-a-string.basic @@ -0,0 +1,11 @@ +10 DIM S$(4) +20 S$="asdf" +30 GOSUB 100 +40 PRINT S$,REV$ +50 END +100 X=LEN(S$) +110 DIM REV$(X) +120 FOR I=1 TO X +130 REV$(I)=S$(X-I+1) +140 NEXT I +150 RETURN diff --git a/Task/Reverse-a-string/EasyLang/reverse-a-string.easy b/Task/Reverse-a-string/EasyLang/reverse-a-string.easy index 749257002d..8687375d09 100644 --- a/Task/Reverse-a-string/EasyLang/reverse-a-string.easy +++ b/Task/Reverse-a-string/EasyLang/reverse-a-string.easy @@ -3,6 +3,6 @@ func$ reverse s$ . for i = 1 to len a$[] div 2 swap a$[i] a$[len a$[] - i + 1] . - return strjoin a$[] + return strjoin a$[] "" . print reverse "hello" diff --git a/Task/Roman-numerals-Decode/Wren/roman-numerals-decode.wren b/Task/Roman-numerals-Decode/Wren/roman-numerals-decode-1.wren similarity index 100% rename from Task/Roman-numerals-Decode/Wren/roman-numerals-decode.wren rename to Task/Roman-numerals-Decode/Wren/roman-numerals-decode-1.wren diff --git a/Task/Roman-numerals-Decode/Wren/roman-numerals-decode-2.wren b/Task/Roman-numerals-Decode/Wren/roman-numerals-decode-2.wren new file mode 100644 index 0000000000..c5c7b2b99d --- /dev/null +++ b/Task/Roman-numerals-Decode/Wren/roman-numerals-decode-2.wren @@ -0,0 +1,7 @@ +import "./roman" for Roman +import "./fmt" for Fmt + +var romans = ["I", "III", "IV", "VIII", "XLIX", "CCII", "CDXXXIII", "MCMXC", "MMVIII", "MDCLXVI"] +for (r in romans) { + Fmt.print("$-10s = $d", r, Roman.new(r).toInt) +} diff --git a/Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode.basic b/Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode-1.basic similarity index 100% rename from Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode.basic rename to Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode-1.basic diff --git a/Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode-2.basic b/Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode-2.basic new file mode 100644 index 0000000000..af2e10bad9 --- /dev/null +++ b/Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode-2.basic @@ -0,0 +1,22 @@ + PRINT 1999;" ";FNint_ToRoman(1999) + PRINT 2012;" ";FNint_ToRoman(2012) + PRINT 1666;" ";FNint_ToRoman(1666) + PRINT 3888;" ";FNint_ToRoman(3888) + END + DEFFNint_ToRoman(A%) + IF A%<0:="MINIMUS" + IF A%=0:="NULLA" + IF A%>3999:="MAXIMUS" + A$=STRING$(A% DIV 1000,"M"):A%=A% MOD 1000 + IF A%>899:A$=A$+"CM":A%=A%-900 + IF A%>499:A$=A$+"D" :A%=A%-500 + IF A%>399:A$=A$+"CD":A%=A%-400 + A$=A$+STRING$(A% DIV 100,"C"):A%=A% MOD 100 + IF A%>89:A$=A$+"XC":A%=A%-90 + IF A%>49:A$=A$+"L" :A%=A%-50 + IF A%>39:A$=A$+"XL":A%=A%-40 + A$=A$+STRING$(A% DIV 10,"X"):A%=A% MOD 10 + IF A%>8:A$=A$+"IX":A%=A%-9 + IF A%>4:A$=A$+"V" :A%=A%-5 + IF A%>3:A$=A$+"IV":A%=A%-4 + =A$+STRING$(A%,"I") diff --git a/Task/Roman-numerals-Encode/Draco/roman-numerals-encode.draco b/Task/Roman-numerals-Encode/Draco/roman-numerals-encode.draco new file mode 100644 index 0000000000..59411b5e18 --- /dev/null +++ b/Task/Roman-numerals-Encode/Draco/roman-numerals-encode.draco @@ -0,0 +1,30 @@ +proc toroman(word n; *char buf) *char: + *char parts = "M\e\eCM\eD\e\eCD\eC\e\eXC\eL\e\eXL\eX\e\eIX\eV\e\eIV\eI"; + [13]word sizes = (1000,900,500,400,100,90,50,40,10,9,5,4,1); + channel output text roman; + word part; + + open(roman, buf); + while n > 0 do + part := 0; + while sizes[part]>n do part := part+1 od; + write(roman; parts + 3*part); + n := n - sizes[part] + od; + close(roman); + buf +corp + +proc test(word n) void: + [32]char buf; + writeln(n, ": ", toroman(n, &buf[0])) +corp + +proc main() void: + test(1666); + test(2008); + test(1001); + test(1999); + test(3888); + test(2025) +corp diff --git a/Task/Roman-numerals-Encode/Refal/roman-numerals-encode.refal b/Task/Roman-numerals-Encode/Refal/roman-numerals-encode.refal new file mode 100644 index 0000000000..983c5af98a --- /dev/null +++ b/Task/Roman-numerals-Encode/Refal/roman-numerals-encode.refal @@ -0,0 +1,31 @@ +$ENTRY Go { + = + + + + + ; +}; + +Show { + s.N = ' = ' >; +}; + +Roman { + 0 = ; + s.N, : s.Next e.Part = e.Part ; +}; + +RomanStep { + s.N = >; + s.N (s.Size e.Part) e.Parts, >: '+' = + e.Part; + s.N t.Part e.Parts = ; +}; + +RomanDigits { + = (1000 'M') + ( 900 'CM') ( 500 'D') ( 400 'CD') ( 100 'C') + ( 90 'XC') ( 50 'L') ( 40 'XL') ( 10 'X') + ( 9 'IX') ( 5 'V') ( 4 'IV') ( 1 'I'); +}; diff --git a/Task/Roman-numerals-Encode/Wren/roman-numerals-encode.wren b/Task/Roman-numerals-Encode/Wren/roman-numerals-encode-1.wren similarity index 100% rename from Task/Roman-numerals-Encode/Wren/roman-numerals-encode.wren rename to Task/Roman-numerals-Encode/Wren/roman-numerals-encode-1.wren diff --git a/Task/Roman-numerals-Encode/Wren/roman-numerals-encode-2.wren b/Task/Roman-numerals-Encode/Wren/roman-numerals-encode-2.wren new file mode 100644 index 0000000000..39cf04cf1a --- /dev/null +++ b/Task/Roman-numerals-Encode/Wren/roman-numerals-encode-2.wren @@ -0,0 +1,3 @@ +import "./roman" for Roman + +for (n in [1990, 1666, 2008, 2020]) System.print(Roman.new(n)) diff --git a/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-1.clj b/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-1.clj index 972ea34d90..cf894bf095 100644 --- a/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-1.clj +++ b/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-1.clj @@ -3,7 +3,7 @@ Returns any of nil, a float, or a vector." [a b c] (let [sq-d (Math/sqrt (- (* b b) (* 4 a c))) - f #(/ (% b sq-d) (* 2 a))] + f #(/ (% (- b) sq-d) (* 2 a))] (cond (neg? sq-d) nil (zero? sq-d) (f +) diff --git a/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-2.clj b/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-2.clj index 8ff7eb4a0b..3d2eff5cdc 100644 --- a/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-2.clj +++ b/Task/Roots-of-a-quadratic-function/Clojure/roots-of-a-quadratic-function-2.clj @@ -1,6 +1,6 @@ user=> (quadratic 1.0 1.0 1.0) nil user=> (quadratic 1.0 2.0 1.0) -1.0 +-1.0 user=> (quadratic 1.0 3.0 1.0) -[2.618033988749895 0.3819660112501051] +[-0.3819660112501051 -2.618033988749895] diff --git a/Task/Roots-of-a-quadratic-function/M2000-Interpreter/roots-of-a-quadratic-function.m2000 b/Task/Roots-of-a-quadratic-function/M2000-Interpreter/roots-of-a-quadratic-function.m2000 new file mode 100644 index 0000000000..bedd98f24f --- /dev/null +++ b/Task/Roots-of-a-quadratic-function/M2000-Interpreter/roots-of-a-quadratic-function.m2000 @@ -0,0 +1,69 @@ +Module Roots_of_Quadratic_Function { + declare global m math2 + function global complex(a as double, b as double=0) { + method m, "cxNew", a, b as ret: =ret + } + function quadroots(a as double, b as double, c as double) { + var d = b*b - 4*a*c, a2 = a + a + if d<0 then + var r=-b/a2 + var i=sqrt(-d)/a2 + ="complex", complex(r, i), complex(r, -i), 5 + else.if d==0 then + ="single root", -b/2/a, -b/2/a, 8 + else + var r =if(b<0 -> (-b + sqrt(d)) / a2, (-b - sqrt(d)) / a2) + ="real", r, c/(a*r), 5 + end if + } + flush + data "" , "outputRoots.txt" + while not empty + read filename + open filename for wide output as #f + Disp(quadroots(3, 4, 4/3)) + Disp(quadroots(3, 2, -1)) + Disp(quadroots(3, 2, 1)) + Disp(quadroots(1, -1e9, 1)) + Disp(quadroots(1, -1e70, 1)) + Disp(quadroots(1, -1e100, 1)) + Disp(quadroots(1, -1e200, 1)) + Disp(quadroots(1, -1e300, 1)) + Disp(quadroots(1, 0, 1)) + Disp(quadroots(2, -1, -6)) + Disp(quadroots(3, 4, 5)) + Disp(quadroots(0.5, sqrt(2), 1)) + Disp(quadroots(1, 2, 2)) + close #f + if filename<>"" then win dir$+filename + end while + sub disp(arg as array) + (s, a, b, n)=arg + Print #f, field$(s, 12); + if type$(a)="cxComplex" then disp1(a) else disp2(a) + if type$(b)="cxComplex" then disp1(b) else disp2(b) + Print #f + end sub + sub disp1(a) + local aa="", bb=if$(a|i<0->"-","+") + if a|i<>0 then + if abs(a|i)<>1 then bb+=""+(abs(round(a|i, n))) + bb+="i" + else + bb="" + end if + if a|r=0 then + if a|i=0 then aa="0" + else + aa=""+(round(a|r, n)) + end if + Print #f, " (";aa;bb;")"; + end sub + sub disp2(b) + local boolean k=b<>0 and (abs(b)<1e-6 or abs(b)>1e6) + local res=if$(k-> str$(b,"Scientific"), ""+(round(b, n))) + if instr(res, "INF") then res="inf" + Print #f, " ";res; + end sub +} +Roots_of_Quadratic_Function diff --git a/Task/Roots-of-unity/PascalABC.NET/roots-of-unity.pas b/Task/Roots-of-unity/PascalABC.NET/roots-of-unity.pas new file mode 100644 index 0000000000..5fd98de9cc --- /dev/null +++ b/Task/Roots-of-unity/PascalABC.NET/roots-of-unity.pas @@ -0,0 +1,6 @@ +function RootsOfUnity(n: integer) + := (0..n-1).Select(x -> Complex.FromPolarCoordinates(1, 2 * PI * x / n)); + +begin + RootsOfUnity(3).PrintLines +end. diff --git a/Task/Rosetta-Code-Count-examples/00-TASK.txt b/Task/Rosetta-Code-Count-examples/00-TASK.txt index 688e2be18b..813ffce72e 100644 --- a/Task/Rosetta-Code-Count-examples/00-TASK.txt +++ b/Task/Rosetta-Code-Count-examples/00-TASK.txt @@ -12,5 +12,5 @@ Total: X examples. For a full output, updated periodically, see [[Rosetta Code/Count examples/Full list]]. -You'll need to use the Media Wiki API, which you can find out about locally, [http://rosettacode.org/mw/api.php here], or in Media Wiki's API documentation at, [http://www.mediawiki.org/wiki/API_Query API:Query] +You'll need to use the Media Wiki API, which you can find out about locally, [https://rosettacode.org/w/api.php here], or in Media Wiki's API documentation at, [http://www.mediawiki.org/wiki/API_Query API:Query] diff --git a/Task/Rosetta-Code-Count-examples/Python/rosetta-code-count-examples-1.py b/Task/Rosetta-Code-Count-examples/Python/rosetta-code-count-examples-1.py index ff8f072a6b..72f90b4a08 100644 --- a/Task/Rosetta-Code-Count-examples/Python/rosetta-code-count-examples-1.py +++ b/Task/Rosetta-Code-Count-examples/Python/rosetta-code-count-examples-1.py @@ -2,17 +2,20 @@ from urllib.request import urlopen, Request import xml.dom.minidom r = Request( - 'https://www.rosettacode.org/mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml', - headers={'User-Agent': 'Mozilla/5.0'}) + "https://rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml", + headers={"User-Agent": "Mozilla/5.0"}, +) x = urlopen(r) tasks = [] -for i in xml.dom.minidom.parseString(x.read()).getElementsByTagName('cm'): - t = i.getAttribute('title').replace(' ', '_') - r = Request(f'https://www.rosettacode.org/mw/index.php?title={t}&action=raw', - headers={'User-Agent': 'Mozilla/5.0'}) +for i in xml.dom.minidom.parseString(x.read()).getElementsByTagName("cm"): + t = i.getAttribute("title").replace(" ", "_").replace("+", "%2B") + r = Request( + f"https://rosettacode.org/w/index.php?title={t}&action=raw", + headers={"User-Agent": "Mozilla/5.0"}, + ) y = urlopen(r) - tasks.append( y.read().lower().count(b'{{header|') ) - print(t.replace('_', ' ') + f': {tasks[-1]} examples.') + tasks.append(y.read().lower().count(b"{{header|")) + print(t.replace("_", " ") + f": {tasks[-1]} examples.") -print(f'\nTotal: {sum(tasks)} examples.') +print(f"\nTotal: {sum(tasks)} examples.") diff --git a/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples-1.wren b/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples-1.wren deleted file mode 100644 index 3f98f47135..0000000000 --- a/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples-1.wren +++ /dev/null @@ -1,52 +0,0 @@ -/* Rosetta_Code_Count_examples.wren */ - -import "./pattern" for Pattern - -var CURLOPT_URL = 10002 -var CURLOPT_FOLLOWLOCATION = 52 -var CURLOPT_WRITEFUNCTION = 20011 -var CURLOPT_WRITEDATA = 10001 - -foreign class Buffer { - construct new() {} // C will allocate buffer of a suitable size - - foreign value // returns buffer contents as a string -} - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() - -var getContent = Fn.new { |url| - var buffer = Buffer.new() - curl.easySetOpt(CURLOPT_URL, url) - curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1) - curl.easySetOpt(CURLOPT_WRITEFUNCTION, 0) // write function to be supplied by C - curl.easySetOpt(CURLOPT_WRITEDATA, buffer) - curl.easyPerform() - return buffer.value -} - -var url = "https://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml" -var content = getContent.call(url) -var p = Pattern.new("title/=\"[+1^\"]\"") -var matches = p.findAll(content) -for (m in matches) { - var title = m.capsText[0].replace("'", "'").replace(""", "\"") - var title2 = title.replace(" ", "_").replace("+", "\%252B") - var taskUrl = "https://www.rosettacode.org/w/index.php?title=%(title2)&action=raw" - var taskContent = getContent.call(taskUrl) - var lines = taskContent.split("\n") - var count = lines.count { |line| line.trim().startsWith("=={{header|") } - System.print("%(title) : %(count) examples") -} - -curl.easyCleanup() diff --git a/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples-2.wren b/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples-2.wren deleted file mode 100644 index 59d2fda281..0000000000 --- a/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples-2.wren +++ /dev/null @@ -1,191 +0,0 @@ -/* gcc Rosetta_Code_Count_examples.c -o Rosetta_Code_Count_examples -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -struct MemoryStruct { - char *memory; - size_t size; -}; - -/* C <=> Wren interface functions */ - -static size_t WriteMemoryCallback(void *contents, size_t size, size_t nmemb, void *userp) { - size_t realsize = size * nmemb; - struct MemoryStruct *mem = (struct MemoryStruct *)userp; - - char *ptr = realloc(mem->memory, mem->size + realsize + 1); - if(!ptr) { - /* out of memory! */ - printf("not enough memory (realloc returned NULL)\n"); - return 0; - } - - mem->memory = ptr; - memcpy(&(mem->memory[mem->size]), contents, realsize); - mem->size += realsize; - mem->memory[mem->size] = 0; - return realsize; -} - -void C_bufferAllocate(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenSetSlotNewForeign(vm, 0, 0, sizeof(struct MemoryStruct)); - ms->memory = malloc(1); - ms->size = 0; -} - -void C_bufferFinalize(void* data) { - struct MemoryStruct *ms = (struct MemoryStruct *)data; - free(ms->memory); -} - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_value(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 0); - wrenSetSlotString(vm, 0, ms->memory); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_perform(curl); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - if (opt < 10000) { - long lparam = (long)wrenGetSlotDouble(vm, 2); - curl_easy_setopt(curl, opt, lparam); - } else if (opt < 20000) { - if (opt == CURLOPT_WRITEDATA) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 2); - curl_easy_setopt(curl, opt, (void *)ms); - } else if (opt == CURLOPT_URL) { - const char *url = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, url); - } - } else if (opt < 30000) { - if (opt == CURLOPT_WRITEFUNCTION) { - curl_easy_setopt(curl, opt, &WriteMemoryCallback); - } - } -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - methods.allocate = C_bufferAllocate; - methods.finalize = C_bufferFinalize; - } else if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - if (!isStatic && strcmp(signature, "value") == 0) return C_value; - } else if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -static void loadModuleComplete(WrenVM* vm, const char* module, WrenLoadModuleResult result) { - if( result.source) free((void*)result.source); -} - -WrenLoadModuleResult loadModule(WrenVM* vm, const char* name) { - WrenLoadModuleResult result = {0}; - if (strcmp(name, "random") != 0 && strcmp(name, "meta") != 0) { - result.onComplete = loadModuleComplete; - char fullName[strlen(name) + 6]; - strcpy(fullName, name); - strcat(fullName, ".wren"); - result.source = readFile(fullName); - } - return result; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - config.loadModuleFn = &loadModule; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Rosetta_Code_Count_examples.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples.wren b/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples.wren new file mode 100644 index 0000000000..b984773fdc --- /dev/null +++ b/Task/Rosetta-Code-Count-examples/Wren/rosetta-code-count-examples.wren @@ -0,0 +1,16 @@ +import "os" for Process +import "./pattern" for Pattern + +var url = "https://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml" +var content = Process.read("curl -s -L \"%(url)\"") // url needs quotes as it contains '&' +var p = Pattern.new("title/=\"[+1^\"]\"") +var matches = p.findAll(content) +for (m in matches.take(25)) { // limit to first 25 + var title = m.capsText[0].replace("'", "'").replace(""", "\"") + var title2 = title.replace(" ", "_").replace("+", "\%2B") + var taskUrl = "https://www.rosettacode.org/w/index.php?title=%(title2)&action=raw" + var taskContent = Process.read("curl -s -L \"%(taskUrl)\"") + var lines = taskContent.split("\n") + var count = lines.count { |line| line.trim().startsWith("=={{header|") } + System.print("%(title) : %(count) examples") +} diff --git a/Task/Rosetta-Code-Find-unimplemented-tasks/Arturo/rosetta-code-find-unimplemented-tasks.arturo b/Task/Rosetta-Code-Find-unimplemented-tasks/Arturo/rosetta-code-find-unimplemented-tasks.arturo new file mode 100644 index 0000000000..59a3c92dd4 --- /dev/null +++ b/Task/Rosetta-Code-Find-unimplemented-tasks/Arturo/rosetta-code-find-unimplemented-tasks.arturo @@ -0,0 +1,72 @@ +;------------------------------------------ +; Configuration +;------------------------------------------ + +API_URL: "https://rosettacode.org/w/api.php" + +;------------------------------------------ +; Helper Functions +;------------------------------------------ + +fetchCategory: function [category][ + results: [] + continue: "" + + while ø [ + ; build query parameters + params: #[ + action: "query" + list: "categorymembers" + cmtitle: ~"Category:|category|" + cmlimit: "500" + format: "json" + ] + + ; add continue parameter if we have one + unless empty? continue -> + params\cmcontinue: continue + + ; perform API request + response: request API_URL params + body: read.json response\body + + ; extract page titles and add to results + 'results ++ map body\query\categorymembers 'page -> + page\title + + ; check if we need to continue + switch key? body 'continue + -> continue: body\continue\cmcontinue + -> break + ] + + return results +] + +getUnimplementedTasks: function [language][ + print "Fetching all programming tasks..." + allTasks: fetchCategory "Programming_Tasks" + + print ~"Fetching tasks implemented in |language|..." + languageTasks: fetchCategory language + + print "Finding unimplemented tasks..." + return difference allTasks languageTasks +] + +;------------------------------------------ +; Main Program +;------------------------------------------ + +if standalone? [ + if empty? arg -> + panic "Usage: rosetta-tasks " + + language: capitalize arg\0 + tasks: getUnimplementedTasks language + + print ~"\nFound |size tasks| unimplemented tasks for |language|:\n" + + print.lines sort map tasks 'task -> + "• " ++ task +] diff --git a/Task/Rosetta-Code-Find-unimplemented-tasks/Python/rosetta-code-find-unimplemented-tasks-5.py b/Task/Rosetta-Code-Find-unimplemented-tasks/Python/rosetta-code-find-unimplemented-tasks-5.py index 9263fce0b2..e3d2f26664 100644 --- a/Task/Rosetta-Code-Find-unimplemented-tasks/Python/rosetta-code-find-unimplemented-tasks-5.py +++ b/Task/Rosetta-Code-Find-unimplemented-tasks/Python/rosetta-code-find-unimplemented-tasks-5.py @@ -60,6 +60,10 @@ def category_members(category: str, url: str = URL) -> Iterable[PageInfo]: response.raise_for_status() data = response.json() + if not data.get("query"): + # Empty category + return + for page in data["query"]["pages"]: yield PageInfo(**{k: v for k, v in page.items() if k in PageInfo._fields}) @@ -87,28 +91,37 @@ def omitted_tasks(language: str) -> Set[PageInfo]: return set(category_members(f"Category:{language}/Omit")) -def unimplemented_tasks(lang_tasks: Set[PageInfo], omitted: Set[PageInfo]) -> Set[str]: +def unimplemented_tasks( + lang_tasks: Set[PageInfo], omitted: Set[PageInfo] +) -> Set[PageInfo]: tasks = set(category_members("Category:Programming Tasks")) return tasks.difference(lang_tasks).difference(omitted) def unimplemented_draft_tasks( lang_tasks: Set[PageInfo], omitted: Set[PageInfo] -) -> Set[str]: +) -> Set[PageInfo]: tasks = set(category_members("Category:Draft Programming Tasks")) return tasks.difference(lang_tasks).difference(omitted) def display(title: str, pages: Iterable[PageInfo]) -> None: print(title) - for page in pages: + for page in sorted(pages, key=lambda p: p.title): print(" ", page.title, page.canonicalurl) print("") if __name__ == "__main__": - lang = lang_tasks("Python") - omitted = omitted_tasks("Python") - display("Programming Tasks", unimplemented_tasks(lang, omitted)) - display("Draft Programming Tasks", unimplemented_draft_tasks(lang, omitted)) + import sys + + if len(sys.argv) > 1: + language = sys.argv[1] + else: + language = "Python" + + tasks = lang_tasks(language) + omitted = omitted_tasks(language) + display("Programming Tasks", unimplemented_tasks(tasks, omitted)) + display("Draft Programming Tasks", unimplemented_draft_tasks(tasks, omitted)) display("Omitted Tasks", omitted) diff --git a/Task/Rosetta-Code-Find-unimplemented-tasks/Red/rosetta-code-find-unimplemented-tasks.red b/Task/Rosetta-Code-Find-unimplemented-tasks/Red/rosetta-code-find-unimplemented-tasks.red new file mode 100644 index 0000000000..0e4c1056fd --- /dev/null +++ b/Task/Rosetta-Code-Find-unimplemented-tasks/Red/rosetta-code-find-unimplemented-tasks.red @@ -0,0 +1,35 @@ +Red [] + +arg: system/script/args + +if arg = "" [ + print "Missing command line argument for language" + quit/return 1 +] + +lang: trim/with arg #"'" + +getall: func[category [string!] /local titles cmcontinue page][ + titles: make block! 500 + cmcontinue: none + forever [ + page: load-json read rejoin [ + http://rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category: + enhex category + "&format=json&cmlimit=500" + either cmcontinue = none [""] [rejoin ["&cmcontinue=" enhex cmcontinue]] + ] + foreach member page/query/categorymembers [ + append titles member/title + ] + if page/continue = none [break/return titles] + cmcontinue: page/continue/cmcontinue + ] +] + +lang-tasks: getall lang +programming-tasks: getall "Programming_Tasks" + +foreach task sort exclude programming-tasks lang-tasks [ + print task +] diff --git a/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks-1.wren b/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks-1.wren deleted file mode 100644 index b8cb29c1a0..0000000000 --- a/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks-1.wren +++ /dev/null @@ -1,70 +0,0 @@ -/* Rosetta_Code_Find_unimplemented_tasks.wren */ - -import "./pattern" for Pattern - -var CURLOPT_URL = 10002 -var CURLOPT_FOLLOWLOCATION = 52 -var CURLOPT_WRITEFUNCTION = 20011 -var CURLOPT_WRITEDATA = 10001 - -foreign class Buffer { - construct new() {} // C will allocate buffer of a suitable size - - foreign value // returns buffer contents as a string -} - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() - -var getContent = Fn.new { |url| - var buffer = Buffer.new() - curl.easySetOpt(CURLOPT_URL, url) - curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1) - curl.easySetOpt(CURLOPT_WRITEFUNCTION, 0) // write function to be supplied by C - curl.easySetOpt(CURLOPT_WRITEDATA, buffer) - curl.easyPerform() - return buffer.value -} - -var p1 = Pattern.new("title/=\"[+1^\"]\"") -var p2 = Pattern.new("cmcontinue/=\"[+1^\"]\"") - -var findTasks = Fn.new { |category| - var url = "https://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:%(category)&cmlimit=500&format=xml" - var cmcontinue = "" - var tasks = [] - while (true) { - var content = getContent.call(url + cmcontinue) - var matches1 = p1.findAll(content) - for (m in matches1) { - var title = m.capsText[0].replace("'", "'").replace(""", "\"") - tasks.add(title) - } - var m2 = p2.find(content) - if (m2) cmcontinue = "&cmcontinue=%(m2.capsText[0])" else break - } - return tasks -} - -var tasks1 = findTasks.call("Programming_Tasks") // 'full' tasks only -var tasks2 = findTasks.call("Draft_Programming_Tasks") -var lang = "Wren" -var langTasks = findTasks.call(lang) // includes draft tasks -curl.easyCleanup() -System.print("Unimplemented 'full' tasks in %(lang):") -for (task in tasks1) { - if (!langTasks.contains(task)) System.print(" " + task) -} -System.print("\nUnimplemented 'draft' tasks in %(lang):") -for (task in tasks2) { - if (!langTasks.contains(task)) System.print(" " + task) -} diff --git a/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks-2.wren b/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks-2.wren deleted file mode 100644 index eb9df26983..0000000000 --- a/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks-2.wren +++ /dev/null @@ -1,191 +0,0 @@ -/* gcc Rosetta_Code_Find_unimplemented_tasks.c -o Rosetta_Code_Find_unimplemented_tasks -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -struct MemoryStruct { - char *memory; - size_t size; -}; - -/* C <=> Wren interface functions */ - -static size_t WriteMemoryCallback(void *contents, size_t size, size_t nmemb, void *userp) { - size_t realsize = size * nmemb; - struct MemoryStruct *mem = (struct MemoryStruct *)userp; - - char *ptr = realloc(mem->memory, mem->size + realsize + 1); - if(!ptr) { - /* out of memory! */ - printf("not enough memory (realloc returned NULL)\n"); - return 0; - } - - mem->memory = ptr; - memcpy(&(mem->memory[mem->size]), contents, realsize); - mem->size += realsize; - mem->memory[mem->size] = 0; - return realsize; -} - -void C_bufferAllocate(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenSetSlotNewForeign(vm, 0, 0, sizeof(struct MemoryStruct)); - ms->memory = malloc(1); - ms->size = 0; -} - -void C_bufferFinalize(void* data) { - struct MemoryStruct *ms = (struct MemoryStruct *)data; - free(ms->memory); -} - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_value(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 0); - wrenSetSlotString(vm, 0, ms->memory); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_perform(curl); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - if (opt < 10000) { - long lparam = (long)wrenGetSlotDouble(vm, 2); - curl_easy_setopt(curl, opt, lparam); - } else if (opt < 20000) { - if (opt == CURLOPT_WRITEDATA) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 2); - curl_easy_setopt(curl, opt, (void *)ms); - } else if (opt == CURLOPT_URL) { - const char *url = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, url); - } - } else if (opt < 30000) { - if (opt == CURLOPT_WRITEFUNCTION) { - curl_easy_setopt(curl, opt, &WriteMemoryCallback); - } - } -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - methods.allocate = C_bufferAllocate; - methods.finalize = C_bufferFinalize; - } else if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - if (!isStatic && strcmp(signature, "value") == 0) return C_value; - } else if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -static void loadModuleComplete(WrenVM* vm, const char* module, WrenLoadModuleResult result) { - if( result.source) free((void*)result.source); -} - -WrenLoadModuleResult loadModule(WrenVM* vm, const char* name) { - WrenLoadModuleResult result = {0}; - if (strcmp(name, "random") != 0 && strcmp(name, "meta") != 0) { - result.onComplete = loadModuleComplete; - char fullName[strlen(name) + 6]; - strcpy(fullName, name); - strcat(fullName, ".wren"); - result.source = readFile(fullName); - } - return result; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - config.loadModuleFn = &loadModule; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Rosetta_Code_Find_unimplemented_tasks.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks.wren b/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks.wren new file mode 100644 index 0000000000..7c630edd56 --- /dev/null +++ b/Task/Rosetta-Code-Find-unimplemented-tasks/Wren/rosetta-code-find-unimplemented-tasks.wren @@ -0,0 +1,48 @@ +import "os" for Process +import "timer" for Now +import "./pattern" for Pattern +import "./ioutil" for Input + +var p1 = Pattern.new("title/=\"[+1^\"]\"") +var p2 = Pattern.new("cmcontinue/=\"[+1^\"]\"") + +var findTasks = Fn.new { |category| + var url = "https://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:%(category)&cmlimit=500&format=xml" + var cmcontinue = "" + var tasks = [] + while (true) { + var content = Process.read("curl -s -L \"%(url)%(cmcontinue)\"") + var matches1 = p1.findAll(content) + for (m in matches1) { + var title = m.capsText[0].replace("'", "'").replace(""", "\"") + tasks.add(title) + } + var m2 = p2.find(content) + if (m2) cmcontinue = "&cmcontinue=%(m2.capsText[0])" else break + } + return tasks +} + +var tasks1 = findTasks.call("Programming_Tasks") // 'full' tasks only +var tasks2 = findTasks.call("Draft_Programming_Tasks") +var lang = Input.text("Enter the category name of your language: ", 1) +var langTasks = findTasks.call(lang) // includes draft tasks +System.print("\nResults for %(lang) as at %(Now.date):") +System.print("\nUnimplemented 'full' tasks:") +var count = 0 +for (task in tasks1) { + if (!langTasks.contains(task)) { + System.print(" " + task) + count = count + 1 + } +} +System.print(" Total = %(count)") +count = 0 +System.print("\nUnimplemented 'draft' tasks:") +for (task in tasks2) { + if (!langTasks.contains(task)) { + System.print(" " + task) + count = count + 1 + } +} +System.print(" Total = %(count)") diff --git a/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users-1.wren b/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users-1.wren deleted file mode 100644 index 58de572231..0000000000 --- a/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users-1.wren +++ /dev/null @@ -1,68 +0,0 @@ -/* Rosetta_Code_Rank_languages_by_number_of_users.wren */ - -import "./pattern" for Pattern -import "./fmt" for Fmt - -var CURLOPT_URL = 10002 -var CURLOPT_FOLLOWLOCATION = 52 -var CURLOPT_WRITEFUNCTION = 20011 -var CURLOPT_WRITEDATA = 10001 - -foreign class Buffer { - construct new() {} // C will allocate buffer of a suitable size - - foreign value // returns buffer contents as a string -} - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() - -var getContent = Fn.new { |url| - var buffer = Buffer.new() - curl.easySetOpt(CURLOPT_URL, url) - curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1) - curl.easySetOpt(CURLOPT_WRITEFUNCTION, 0) // write function to be supplied by C - curl.easySetOpt(CURLOPT_WRITEDATA, buffer) - curl.easyPerform() - return buffer.value -} - -var p = Pattern.new(" User\">[+1^<]\u200f\u200e ([#13/d] member~s)") -var url = "https://rosettacode.org/w/index.php?title=Special:Categories&limit=5000" -var content = getContent.call(url) -var matches = p.findAll(content) -var over100s = [] -for (m in matches) { - var numUsers = Num.fromString(m.capsText[1]) - if (numUsers >= 100) { - var language = m.capsText[0][0..-6] - over100s.add([language, numUsers]) - } -} -over100s.sort { |a, b| a[1] > b[1] } -System.print("Languages with at least 100 users as at 3 February, 2024:") -var rank = 0 -var lastScore = 0 -var lastRank = 0 -for (i in 0...over100s.count) { - var pair = over100s[i] - var eq = " " - rank = i + 1 - if (lastScore == pair[1]) { - eq = "=" - rank = lastRank - } else { - lastScore = pair[1] - lastRank = rank - } - Fmt.print("$-2d$s $-11s $d", rank, eq, pair[0], pair[1]) -} diff --git a/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users-2.wren b/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users-2.wren deleted file mode 100644 index 07d8913360..0000000000 --- a/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users-2.wren +++ /dev/null @@ -1,191 +0,0 @@ -/* gcc Rosetta_Code_Rank_languages_by_number_of_users.c -o Rosetta_Code_Rank_languages_by_number_of_users -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -struct MemoryStruct { - char *memory; - size_t size; -}; - -/* C <=> Wren interface functions */ - -static size_t WriteMemoryCallback(void *contents, size_t size, size_t nmemb, void *userp) { - size_t realsize = size * nmemb; - struct MemoryStruct *mem = (struct MemoryStruct *)userp; - - char *ptr = realloc(mem->memory, mem->size + realsize + 1); - if(!ptr) { - /* out of memory! */ - printf("not enough memory (realloc returned NULL)\n"); - return 0; - } - - mem->memory = ptr; - memcpy(&(mem->memory[mem->size]), contents, realsize); - mem->size += realsize; - mem->memory[mem->size] = 0; - return realsize; -} - -void C_bufferAllocate(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenSetSlotNewForeign(vm, 0, 0, sizeof(struct MemoryStruct)); - ms->memory = malloc(1); - ms->size = 0; -} - -void C_bufferFinalize(void* data) { - struct MemoryStruct *ms = (struct MemoryStruct *)data; - free(ms->memory); -} - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_value(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 0); - wrenSetSlotString(vm, 0, ms->memory); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_perform(curl); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - if (opt < 10000) { - long lparam = (long)wrenGetSlotDouble(vm, 2); - curl_easy_setopt(curl, opt, lparam); - } else if (opt < 20000) { - if (opt == CURLOPT_WRITEDATA) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 2); - curl_easy_setopt(curl, opt, (void *)ms); - } else if (opt == CURLOPT_URL) { - const char *url = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, url); - } - } else if (opt < 30000) { - if (opt == CURLOPT_WRITEFUNCTION) { - curl_easy_setopt(curl, opt, &WriteMemoryCallback); - } - } -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - methods.allocate = C_bufferAllocate; - methods.finalize = C_bufferFinalize; - } else if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - if (!isStatic && strcmp(signature, "value") == 0) return C_value; - } else if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -static void loadModuleComplete(WrenVM* vm, const char* module, WrenLoadModuleResult result) { - if( result.source) free((void*)result.source); -} - -WrenLoadModuleResult loadModule(WrenVM* vm, const char* name) { - WrenLoadModuleResult result = {0}; - if (strcmp(name, "random") != 0 && strcmp(name, "meta") != 0) { - result.onComplete = loadModuleComplete; - char fullName[strlen(name) + 6]; - strcpy(fullName, name); - strcat(fullName, ".wren"); - result.source = readFile(fullName); - } - return result; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - config.loadModuleFn = &loadModule; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Rosetta_Code_Rank_languages_by_number_of_users.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users.wren b/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users.wren new file mode 100644 index 0000000000..37250acd07 --- /dev/null +++ b/Task/Rosetta-Code-Rank-languages-by-number-of-users/Wren/rosetta-code-rank-languages-by-number-of-users.wren @@ -0,0 +1,47 @@ +import "os" for Process +import "timer" for Now +import "./xsequence" for XDocument +import "./fmt" for Fmt + +var urlBase = "https://rosettacode.org/w/api.php?action=query&format=xml&generator=categorymembers&gcmtitle=Category:Language\%20users&gcmlimit=500&prop=categoryinfo" + +var over100s = [] +var url = urlBase +while (true) { + var content = Process.read("curl -s -L \"%(url)\"") + var doc = XDocument.parse(content) + for (p in doc.root.element("query").element("pages").elements("page")) { + if (p.attributeValue("ns") == "14") { + var ci = p.element("categoryinfo") + var numUsers = ci.attributeValue("pages", Num, 0) + if (numUsers >= 100) { + var language = p.attributeValue("title")[9..-6] + over100s.add([language, numUsers]) + } + } + } + var cel = doc.root.element("continue") + if (!cel) break + var gcmcont = "&gcmcontinue=%(cel.attribute("gcmcontinue").value)" + var cont = "&continue=%(cel.attribute("continue").value)" + url = urlBase + gcmcont + cont +} +over100s.sort { |a, b| a[1] > b[1] } +var date = "%(Now.day) %(Now.monthName), %(Now.year)" +System.print("Languages with at least 100 users as at %(date):\n") +var rank = 0 +var lastScore = 0 +var lastRank = 0 +for (i in 0...over100s.count) { + var pair = over100s[i] + var eq = " " + rank = i + 1 + if (lastScore == pair[1]) { + eq = "=" + rank = lastRank + } else { + lastScore = pair[1] + lastRank = rank + } + Fmt.print("$-2d$s $-11s $d", rank, eq, pair[0], pair[1]) +} diff --git a/Task/Rosetta-Code-Rank-languages-by-popularity/Visual-Basic-.NET/rosetta-code-rank-languages-by-popularity.vb b/Task/Rosetta-Code-Rank-languages-by-popularity/Visual-Basic-.NET/rosetta-code-rank-languages-by-popularity.vb index 31a07c8a36..56f947b6e8 100644 --- a/Task/Rosetta-Code-Rank-languages-by-popularity/Visual-Basic-.NET/rosetta-code-rank-languages-by-popularity.vb +++ b/Task/Rosetta-Code-Rank-languages-by-popularity/Visual-Basic-.NET/rosetta-code-rank-languages-by-popularity.vb @@ -39,12 +39,22 @@ Module RankLanguagesByPopularity Dim nextPageEx = New RegEx("([^<]+?)[^<]*([^<]+?) * "" Dim wc As New WebClient() - Dim page As String = wc.DownloadString(nextPage) + ' Ensure the WebClient has a User-Agent. + Dim hasAgent As Boolean = False + for hPos As Integer = 0 To wc.Headers.Count - 1 + Dim headerKey As String = wc.Headers.GetKey(hPos) + hasAgent = hasAgent Or headerKey = "User-Agent" + Next hPos + If not hasAgent Then + wc.Headers.Add("User-Agent", "RC_Tasks_Agent") + End If + + Dim page As String = wc.DownloadString(nextPage) nextPage = "" For Each link In nextPageEx.Matches(page) nextPage = basePage & link.Groups(1).Value @@ -60,6 +70,12 @@ Module RankLanguagesByPopularity languages.Add(New LanguageStat(lName, lCount)) End If Next language + + If nextPage <> "" Then + ' Sleep for a while to avoid looking like a DOS attack... + System.Threading.Thread.Sleep(500) + End If + Loop languages.Sort(AddressOf CompareLanguages) diff --git a/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity-1.wren b/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity-1.wren deleted file mode 100644 index 6185dba031..0000000000 --- a/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity-1.wren +++ /dev/null @@ -1,78 +0,0 @@ -/* Rosetta_Code_Rank_languages_by_popularity.wren */ - -import "./pattern" for Pattern -import "./fmt" for Fmt - -var CURLOPT_URL = 10002 -var CURLOPT_FOLLOWLOCATION = 52 -var CURLOPT_WRITEFUNCTION = 20011 -var CURLOPT_WRITEDATA = 10001 - -foreign class Buffer { - construct new() {} // C will allocate buffer of a suitable size - - foreign value // returns buffer contents as a string -} - -foreign class Curl { - construct easyInit() {} - - foreign easySetOpt(opt, param) - - foreign easyPerform() - - foreign easyCleanup() -} - -var curl = Curl.easyInit() - -var getContent = Fn.new { |url| - var buffer = Buffer.new() - curl.easySetOpt(CURLOPT_URL, url) - curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1) - curl.easySetOpt(CURLOPT_WRITEFUNCTION, 0) // write function to be supplied by C - curl.easySetOpt(CURLOPT_WRITEDATA, buffer) - curl.easyPerform() - return buffer.value -} - -var p1 = Pattern.new("> +1^,, [+1^ ] page") -var p2 = Pattern.new("subcatfrom/=[+1^#/#mw-subcategories]\"") - -var findLangs = Fn.new { - var url = "https://rosettacode.org/w/index.php?title=Category:Programming_Languages" - var subcatfrom = "" - var langs = [] - while (true) { - var content = getContent.call(url + subcatfrom) - var matches1 = p1.findAll(content) - for (m in matches1) { - var name = m.capsText[0] - var tasks = Num.fromString(m.capsText[1].replace(",", "")) - langs.add([name, tasks]) - } - var m2 = p2.find(content) - if (m2) subcatfrom = "&subcatfrom=%(m2.capsText[0])" else break - } - return langs -} - -var langs = findLangs.call() -langs.sort { |a, b| a[1] > b[1] } -System.print("Languages with most examples as at 3 February, 2024:") -var rank = 0 -var lastScore = 0 -var lastRank = 0 -for (i in 0...langs.count) { - var pair = langs[i] - var eq = " " - rank = i + 1 - if (lastScore == pair[1]) { - eq = "=" - rank = lastRank - } else { - lastScore = pair[1] - lastRank = rank - } - Fmt.print("$-3d$s $-20s $,5d", rank, eq, pair[0], pair[1]) -} diff --git a/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity-2.wren b/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity-2.wren deleted file mode 100644 index f71329e680..0000000000 --- a/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity-2.wren +++ /dev/null @@ -1,191 +0,0 @@ -/* gcc Rosetta_Code_Rank_languages_by_popularity.c -o Rosetta_Code_Rank_languages_by_popularity -lcurl -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -struct MemoryStruct { - char *memory; - size_t size; -}; - -/* C <=> Wren interface functions */ - -static size_t WriteMemoryCallback(void *contents, size_t size, size_t nmemb, void *userp) { - size_t realsize = size * nmemb; - struct MemoryStruct *mem = (struct MemoryStruct *)userp; - - char *ptr = realloc(mem->memory, mem->size + realsize + 1); - if(!ptr) { - /* out of memory! */ - printf("not enough memory (realloc returned NULL)\n"); - return 0; - } - - mem->memory = ptr; - memcpy(&(mem->memory[mem->size]), contents, realsize); - mem->size += realsize; - mem->memory[mem->size] = 0; - return realsize; -} - -void C_bufferAllocate(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenSetSlotNewForeign(vm, 0, 0, sizeof(struct MemoryStruct)); - ms->memory = malloc(1); - ms->size = 0; -} - -void C_bufferFinalize(void* data) { - struct MemoryStruct *ms = (struct MemoryStruct *)data; - free(ms->memory); -} - -void C_curlAllocate(WrenVM* vm) { - CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*)); - *pcurl = curl_easy_init(); -} - -void C_value(WrenVM* vm) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 0); - wrenSetSlotString(vm, 0, ms->memory); -} - -void C_easyPerform(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_perform(curl); -} - -void C_easyCleanup(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - curl_easy_cleanup(curl); -} - -void C_easySetOpt(WrenVM* vm) { - CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0); - CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1); - if (opt < 10000) { - long lparam = (long)wrenGetSlotDouble(vm, 2); - curl_easy_setopt(curl, opt, lparam); - } else if (opt < 20000) { - if (opt == CURLOPT_WRITEDATA) { - struct MemoryStruct *ms = (struct MemoryStruct *)wrenGetSlotForeign(vm, 2); - curl_easy_setopt(curl, opt, (void *)ms); - } else if (opt == CURLOPT_URL) { - const char *url = wrenGetSlotString(vm, 2); - curl_easy_setopt(curl, opt, url); - } - } else if (opt < 30000) { - if (opt == CURLOPT_WRITEFUNCTION) { - curl_easy_setopt(curl, opt, &WriteMemoryCallback); - } - } -} - -WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) { - WrenForeignClassMethods methods; - methods.allocate = NULL; - methods.finalize = NULL; - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - methods.allocate = C_bufferAllocate; - methods.finalize = C_bufferFinalize; - } else if (strcmp(className, "Curl") == 0) { - methods.allocate = C_curlAllocate; - } - } - return methods; -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Buffer") == 0) { - if (!isStatic && strcmp(signature, "value") == 0) return C_value; - } else if (strcmp(className, "Curl") == 0) { - if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt; - if (!isStatic && strcmp(signature, "easyPerform()") == 0) return C_easyPerform; - if (!isStatic && strcmp(signature, "easyCleanup()") == 0) return C_easyCleanup; - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -static void loadModuleComplete(WrenVM* vm, const char* module, WrenLoadModuleResult result) { - if( result.source) free((void*)result.source); -} - -WrenLoadModuleResult loadModule(WrenVM* vm, const char* name) { - WrenLoadModuleResult result = {0}; - if (strcmp(name, "random") != 0 && strcmp(name, "meta") != 0) { - result.onComplete = loadModuleComplete; - char fullName[strlen(name) + 6]; - strcpy(fullName, name); - strcat(fullName, ".wren"); - result.source = readFile(fullName); - } - return result; -} - -int main(int argc, char **argv) { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignClassFn = &bindForeignClass; - config.bindForeignMethodFn = &bindForeignMethod; - config.loadModuleFn = &loadModule; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Rosetta_Code_Rank_languages_by_popularity.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity.wren b/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity.wren new file mode 100644 index 0000000000..075d0a8de7 --- /dev/null +++ b/Task/Rosetta-Code-Rank-languages-by-popularity/Wren/rosetta-code-rank-languages-by-popularity.wren @@ -0,0 +1,45 @@ +import "os" for Process +import "timer" for Now +import "./xsequence" for XDocument +import "./fmt" for Fmt + +var urlBase = "https://rosettacode.org/w/api.php?action=query&format=xml&generator=categorymembers&gcmtitle=Category:Programming\%20Languages&gcmlimit=500&prop=categoryinfo" + +var results = [] +var url = urlBase +while (true) { + var content = Process.read("curl -s -L \"%(url)\"") + var doc = XDocument.parse(content) + for (p in doc.root.element("query").element("pages").elements("page")) { + if (p.attributeValue("ns") == "14") { + var ci = p.element("categoryinfo") + var numTasks = ci.attributeValue("pages", Num, 0) + var language = p.attributeValue("title")[9..-1] + results.add([language, numTasks]) + } + } + var cel = doc.root.element("continue") + if (!cel) break + var gcmcont = "&gcmcontinue=%(cel.attribute("gcmcontinue").value)" + var cont = "&continue=%(cel.attribute("continue").value)" + url = urlBase + gcmcont + cont +} +results.sort { |a, b| a[1] > b[1] } +var date = "%(Now.day) %(Now.monthName), %(Now.year)" +System.print("Languages with most tasks completed as at %(date):\n") +var rank = 0 +var lastScore = 0 +var lastRank = 0 +for (i in 0..29) { // just show top 30 + var pair = results[i] + var eq = " " + rank = i + 1 + if (lastScore == pair[1]) { + eq = "=" + rank = lastRank + } else { + lastScore = pair[1] + lastRank = rank + } + Fmt.print("$-2d$s $-11s $4d", rank, eq, pair[0], pair[1]) +} diff --git a/Task/Rot-13/YAMLScript/rot-13.ys b/Task/Rot-13/YAMLScript/rot-13.ys index d67c6052fb..96b5bcf73e 100644 --- a/Task/Rot-13/YAMLScript/rot-13.ys +++ b/Task/Rot-13/YAMLScript/rot-13.ys @@ -1,4 +1,4 @@ -!yamlscript/v0 +!YS-v0 defn main(input='Hello, World!'): s =: set(\\A .. \\Z) + (\\a .. \\z) diff --git a/Task/S-expressions/FreeBASIC/s-expressions.basic b/Task/S-expressions/FreeBASIC/s-expressions.basic new file mode 100644 index 0000000000..693f6544f2 --- /dev/null +++ b/Task/S-expressions/FreeBASIC/s-expressions.basic @@ -0,0 +1,132 @@ +Type Token + tokenType As Integer '1=lbr, 2=rbr, 3=string, 4=number, 5=symbol + value As String + numValue As Double +End Type + +Type TokenList + tokens(1000) As Token + cnt As Integer +End Type + +Function isNumber(word As String) As Boolean + For i As Integer = 1 To Len(word) + If (Mid(word, i, 1) < "0" Or Mid(word, i, 1) > "9") And Mid(word, i, 1) <> "." Then Return False + Next + Return True +End Function + +Function ParseSExpr(cad As String) As TokenList + Dim As TokenList tlist + Dim As Integer state = 1 '1=token_start, 2=read_quoted_string, 3=read_string_or_number + Dim As String word = "" + + For i As Integer = 1 To Len(cad) + Select Case state + Case 1 'token_start + Select Case Mid(cad, i, 1) + Case "(" + tlist.tokens(tlist.cnt).tokenType = 1 + tlist.cnt += 1 + Case ")" + tlist.tokens(tlist.cnt).tokenType = 2 + tlist.cnt += 1 + Case " ", Chr(9), Chr(10), Chr(13) + Case """" + state = 2 : word = "" + Case Else + state = 3 : word = Mid(cad, i, 1) + End Select + + Case 2 'read_quoted_string + If Mid(cad, i, 1) = """" Then + tlist.tokens(tlist.cnt).tokenType = 3 + tlist.tokens(tlist.cnt).value = word + tlist.cnt += 1 + state = 1 + Else + word &= Mid(cad, i, 1) + End If + + Case 3 'read_string_or_number + If Instr(" " & Chr(9) & Chr(10) & Chr(13) & ")", Mid(cad, i, 1)) Then + tlist.tokens(tlist.cnt).tokenType = Iif(isNumber(word), 4, 5) + If isNumber(word) Then + tlist.tokens(tlist.cnt).numValue = Val(word) + Else + tlist.tokens(tlist.cnt).value = word + End If + tlist.cnt += 1 + If Mid(cad, i, 1) = ")" Then + tlist.tokens(tlist.cnt).tokenType = 2 + tlist.cnt += 1 + End If + state = 1 + Else + word &= Mid(cad, i, 1) + End If + End Select + Next + Return tlist +End Function + +Function ArrayToString(tlist As TokenList, startIdx As Integer, Byref endIdx As Integer) As String + Dim As String result = "" + Dim As Integer i = startIdx + + If startIdx = 0 Then result = "[" + + While i < tlist.cnt + Select Case tlist.tokens(i).tokenType + Case 1 'lbr + result &= "[" + i += 1 + result &= ArrayToString(tlist, i, i) + Case 2 'rbr + endIdx = i + Return result & "]" + Case 3 'string + result &= """" & tlist.tokens(i).value & """" + Case 4 'number + result &= Rtrim(Str(tlist.tokens(i).numValue)) + Case 5 'symbol + result &= ":" & tlist.tokens(i).value + End Select + If i < tlist.cnt - 1 Andalso tlist.tokens(i+1).tokenType <> 2 Then result &= ", " + i += 1 + Wend + Return result +End Function + +Function ToSExpr(tlist As TokenList) As String + Dim As String result = "" + For i As Integer = 0 To tlist.cnt - 1 + Select Case tlist.tokens(i).tokenType + Case 1: result &= "(" + Case 2: result &= ")" + Case 3: result &= """" & tlist.tokens(i).value & """" + Case 4: result &= Rtrim(Str(tlist.tokens(i).numValue)) + Case 5: result &= tlist.tokens(i).value + End Select + If i < tlist.cnt - 1 Andalso tlist.tokens(i+1).tokenType <> 2 Andalso tlist.tokens(i).tokenType <> 1 Then result &= " " + Next + Return result +End Function + +' Main program +Dim As String inputString = _ +"((data ""quoted data"" 123 4.5)" & Chr(10) & _ +" (data (!@# (4.5) ""(more"" ""data)"")))" + +Print "Original S-Expression:" +Print inputString +Dim As TokenList tokens = ParseSExpr(inputString) + +Print !"\nNative Structure:" +Dim As Integer dummy +Print ArrayToString(tokens, 0, dummy) + +Print !"\nand back to S-Expression:" +Print ToSExpr(tokens) + +Sleep diff --git a/Task/SHA-256/FutureBasic/sha-256.basic b/Task/SHA-256/FutureBasic/sha-256.basic new file mode 100644 index 0000000000..d63eade7d7 --- /dev/null +++ b/Task/SHA-256/FutureBasic/sha-256.basic @@ -0,0 +1,19 @@ +include "NSLog.incl" +include "CommonCrypto/CommonCrypto.incl" + +void local fn DoIt + CFStringRef msg = @"Rosetta code" + ptr rc = fn StringUTF8String( msg ) + unsigned char buf(32) + fn CC_SHA256( rc, fn strlen(rc), @buf(0) ) + CFMutableStringRef res = fn MutableStringWithCapacity(CC_SHA256_DIGEST_LENGTH) + for int i = 0 to CC_SHA256_DIGEST_LENGTH - 1 + MutableStringAppendFormat( res, @"%02x", buf(i) ) + next + NSLog(@"Input:\n%@\n",msg) + NSLog(@"Output:\n%@", res) +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Safe-addition/Wren/safe-addition-2.wren b/Task/Safe-addition/Wren/safe-addition-2.wren deleted file mode 100644 index 56460cb85a..0000000000 --- a/Task/Safe-addition/Wren/safe-addition-2.wren +++ /dev/null @@ -1,85 +0,0 @@ -/* gcc Safe_addition.c -o Safe_addition -lwren -lm */ - -#include -#include -#include -#include -#include "wren.h" - -void Interval_nextAfter(WrenVM* vm) { - double x = wrenGetSlotDouble(vm, 1); - double y = wrenGetSlotDouble(vm, 2); - wrenSetSlotDouble(vm, 0, nextafter(x, y)); -} - -WrenForeignMethodFn bindForeignMethod( - WrenVM* vm, - const char* module, - const char* className, - bool isStatic, - const char* signature) { - if (strcmp(module, "main") == 0) { - if (strcmp(className, "Interval") == 0) { - if (isStatic && strcmp(signature, "nextAfter_(_,_)") == 0) { - return Interval_nextAfter; - } - } - } - return NULL; -} - -static void writeFn(WrenVM* vm, const char* text) { - printf("%s", text); -} - -void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) { - switch (errorType) { - case WREN_ERROR_COMPILE: - printf("[%s line %d] [Error] %s\n", module, line, msg); - break; - case WREN_ERROR_STACK_TRACE: - printf("[%s line %d] in %s\n", module, line, msg); - break; - case WREN_ERROR_RUNTIME: - printf("[Runtime Error] %s\n", msg); - break; - } -} - -char *readFile(const char *fileName) { - FILE *f = fopen(fileName, "r"); - fseek(f, 0, SEEK_END); - long fsize = ftell(f); - rewind(f); - char *script = malloc(fsize + 1); - fread(script, 1, fsize, f); - fclose(f); - script[fsize] = 0; - return script; -} - -int main() { - WrenConfiguration config; - wrenInitConfiguration(&config); - config.writeFn = &writeFn; - config.errorFn = &errorFn; - config.bindForeignMethodFn = &bindForeignMethod; - WrenVM* vm = wrenNewVM(&config); - const char* module = "main"; - const char* fileName = "Safe_addition.wren"; - char *script = readFile(fileName); - WrenInterpretResult result = wrenInterpret(vm, module, script); - switch (result) { - case WREN_RESULT_COMPILE_ERROR: - printf("Compile Error!\n"); - break; - case WREN_RESULT_RUNTIME_ERROR: - printf("Runtime Error!\n"); - break; - case WREN_RESULT_SUCCESS: - break; - } - wrenFreeVM(vm); - free(script); - return 0; -} diff --git a/Task/Safe-addition/Wren/safe-addition-1.wren b/Task/Safe-addition/Wren/safe-addition.wren similarity index 59% rename from Task/Safe-addition/Wren/safe-addition-1.wren rename to Task/Safe-addition/Wren/safe-addition.wren index 70ab7e5f1e..e6b21f84db 100644 --- a/Task/Safe-addition/Wren/safe-addition-1.wren +++ b/Task/Safe-addition/Wren/safe-addition.wren @@ -1,4 +1,6 @@ -/* Safe_addition.wren */ +import "numeric" for Float +import "io" for Stdfmt + class Interval { construct new(lower, upper) { if (lower.type != Num || upper.type != Num) { @@ -11,13 +13,15 @@ class Interval { lower { _lower } upper { _upper } - static stepAway(x) { new(nextAfter_(x, -1/0), nextAfter_(x, 1/0)) } + static stepAway(x) { new(Float.prev(x), Float.next(x)) } static safeAdd(x, y) { stepAway(x + y) } - foreign static nextAfter_(x, y) // the code for this is written in C - - toString { "[%(_lower), %(_upper)]" } + toString { + var ls = Stdfmt.writef("$f", _lower, null, 0, 16) + var us = Stdfmt.writef("$f", _upper, null, 0, 16) + return "[%(ls), %(us)]" + } } var a = 1.2 diff --git a/Task/Semordnilap/AWK/semordnilap.awk b/Task/Semordnilap/AWK/semordnilap-1.awk similarity index 100% rename from Task/Semordnilap/AWK/semordnilap.awk rename to Task/Semordnilap/AWK/semordnilap-1.awk diff --git a/Task/Semordnilap/AWK/semordnilap-2.awk b/Task/Semordnilap/AWK/semordnilap-2.awk new file mode 100644 index 0000000000..96f14162e1 --- /dev/null +++ b/Task/Semordnilap/AWK/semordnilap-2.awk @@ -0,0 +1,15 @@ +{ wrd = $0 + rwrd = "" + for (i=length(wrd); i>0; --i) + rwrd = rwrd substr(wrd,i,1) + if (rwrd == wrd) + palindromes += 1 + else if ( seen[rwrd] ) { + if (++pairs < 7) + print wrd " " rwrd + } else + seen[wrd] = wrd +} +END { + print pairs " pairs, " palindromes " palindromes." +} diff --git a/Task/Semordnilap/Crystal/semordnilap.cr b/Task/Semordnilap/Crystal/semordnilap.cr index 512ed6150b..7271233a72 100644 --- a/Task/Semordnilap/Crystal/semordnilap.cr +++ b/Task/Semordnilap/Crystal/semordnilap.cr @@ -1,17 +1,8 @@ -require "set" - -UNIXDICT = File.read("unixdict.txt").lines - -def word?(word : String) - UNIXDICT.includes?(word) -end - -# is it a word and is it a word backwards? -semordnilap = UNIXDICT.select { |word| word?(word) && word?(word.reverse) } - -# consolidate pairs like [bad, dab] == [dab, bad] -final_results = semordnilap.map { |word| [word, word.reverse].to_set }.uniq - -# sets of N=1 mean the word is identical backwards -# print out the size, and 5 random pairs -puts final_results.size, final_results.sample(5) +words = File.read("unixdict.txt").each_line.to_set +semordnilap = words.compact_map {|word| + reversed = word.reverse + if word < reversed && words.includes? reversed + { word, reversed } + end +} +p semordnilap.size, semordnilap.sample(5) diff --git a/Task/Semordnilap/EasyLang/semordnilap.easy b/Task/Semordnilap/EasyLang/semordnilap.easy index 9b1e0b0489..0409c84756 100644 --- a/Task/Semordnilap/EasyLang/semordnilap.easy +++ b/Task/Semordnilap/EasyLang/semordnilap.easy @@ -8,7 +8,7 @@ func$ reverse s$ . for i = 1 to len a$[] div 2 swap a$[i] a$[len a$[] - i + 1] . - return strjoin a$[] + return strjoin a$[] "" . func search s$ . max = len w$[] + 1 diff --git a/Task/Semordnilap/FutureBasic/semordnilap.basic b/Task/Semordnilap/FutureBasic/semordnilap.basic new file mode 100644 index 0000000000..a074dfbc8c --- /dev/null +++ b/Task/Semordnilap/FutureBasic/semordnilap.basic @@ -0,0 +1,38 @@ +#plist NSAppTransportSecurity @{NSAllowsArbitraryLoads:YES} + +local fn Dictionary as CFArrayRef + CFURLRef url = fn URLWithString( @"http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" ) + CFStringRef string = fn StringWithContentsOfURL( url, NSASCIIStringEncoding, NULL ) +end fn = fn StringComponentsSeparatedByCharactersInSet( string, fn CharacterSetNewlineSet ) + +local fn ReverseString( inString as CFStringRef ) as CFStringRef + CFMutableStringRef outString = fn MutableStringNew + for long index = len(inString) - 1 to 0 step -1 + MutableStringAppendString( outString, mid(inString,index,1) ) + next +end fn = outString + +void local fn Doit + CFMutableArrayRef pairs = fn MutableArrayNew + CFArrayRef words = fn Dictionary + NSUInteger count = len(words), i, index + for i = 0 to count - 2 + CFStringRef wd1 = words[i] + CFStringRef wd2 = fn ReverseString( wd1 ) + index = fn ArrayIndexOfObjectInRange( words, wd2, fn CFRangeMake( i+1, count-(i+1) ) ) + if ( index != NSNotFound ) then MutableArrayAddObject( pairs, @{@"wd1":wd1,@"wd2":wd2} ) + next + + text ,,,,, 60 + for i = 1 to 5 + count = len(pairs) + index = rnd(count)-1 + CFDictionaryRef dict = pairs[index] + print dict[@"wd1"],dict[@"wd2"] + MutableArrayRemoveObjectAtIndex( pairs, index ) + next +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Sequence-of-primes-by-trial-division/EDSAC-order-code/sequence-of-primes-by-trial-division.edsac b/Task/Sequence-of-primes-by-trial-division/EDSAC-order-code/sequence-of-primes-by-trial-division.edsac index ff3d80b08f..804567152c 100644 --- a/Task/Sequence-of-primes-by-trial-division/EDSAC-order-code/sequence-of-primes-by-trial-division.edsac +++ b/Task/Sequence-of-primes-by-trial-division/EDSAC-order-code/sequence-of-primes-by-trial-division.edsac @@ -2,8 +2,9 @@ [EDSAC program, Initial Orders 2.] [Division is done implicitly by the use of wheels. One wheel for each possible prime divisor, up to an editable limit.] +[2024-12-25 Fixed bug in print subroutine (did not affect RC output)] - T51K [G parameter: print subroutine, 54 locations.] + T51K [G parameter: print subroutine, 52 locations.] P56F [must be even address] T47K [M parameter: main routine.] P110F [must be even address] @@ -149,11 +150,11 @@ [Modified library subroutine P7.] [Prints signed integer; up to 10 digits, left-justified.] [Input: 0D = integer,] -[54 locations. Load at even address. Workspace 4D.] +[52 locations. Load at even address. Workspace 4D.] E25KTG - GKA3FT42@A49@T31@ADE10@T31@A48@T31@SDTDH44#@NDYFLDT4DS43@ - TFH17@S17@A43@G23@UFS43@T1FV4DAFG50@SFLDUFXFOFFFSFL4FT4D - A49@T31@A1FA43@G20@XFP1024FP610D@524D!FO46@O26@XFSFL8FT4DE39@ + GKA3FT42@A47@T31@ADE10@T31@A46@T31@SDTDH44#@NDYFLDT4DS43@TF + H17@S17@A43@G23@UFS43@T1FV4DAFG48@SFLDUFXFOFFFSFL4FT4DA47@ + T31@A1FA43@G20@XFT44#ZPFT43ZP1024FP610D@524DO26@XFSFL8FT4DE39@ [========================= M parameter again ===============================] E25KTM diff --git a/Task/Set-right-adjacent-bits/EasyLang/set-right-adjacent-bits.easy b/Task/Set-right-adjacent-bits/EasyLang/set-right-adjacent-bits.easy index 5cf6eead30..92b6e3a8ac 100644 --- a/Task/Set-right-adjacent-bits/EasyLang/set-right-adjacent-bits.easy +++ b/Task/Set-right-adjacent-bits/EasyLang/set-right-adjacent-bits.easy @@ -10,7 +10,7 @@ proc adjacent txt$ n . . . . . - res$ = strjoin res$[] + res$ = strjoin res$[] "" print "result: " & res$ print "" . diff --git a/Task/Shoelace-formula-for-polygonal-area/00-TASK.txt b/Task/Shoelace-formula-for-polygonal-area/00-TASK.txt index 397e6728c7..04bc4791ee 100644 --- a/Task/Shoelace-formula-for-polygonal-area/00-TASK.txt +++ b/Task/Shoelace-formula-for-polygonal-area/00-TASK.txt @@ -1,3 +1,4 @@ + {{task}} Given the n + 1 vertices x[0], y[0] .. x[N], y[N] of a simple polygon described in a clockwise direction, then the polygon's area can be calculated by: 
 abs( (sum(x[0]*y[1] + ... x[n-1]*y[n]) + x[N]*y[0]) -
diff --git a/Task/Shoelace-formula-for-polygonal-area/EDSAC-order-code/shoelace-formula-for-polygonal-area.edsac b/Task/Shoelace-formula-for-polygonal-area/EDSAC-order-code/shoelace-formula-for-polygonal-area.edsac
new file mode 100644
index 0000000000..0905deae5e
--- /dev/null
+++ b/Task/Shoelace-formula-for-polygonal-area/EDSAC-order-code/shoelace-formula-for-polygonal-area.edsac
@@ -0,0 +1,98 @@
+[Shoelace formula for Rosetta Code website.
+EDSAC program, Initial Orders 2]
+[Arrange the storage]
+          T45K P150F      [H, library subroutine R4 to read signed integer]
+          T46K P56F       [N, library subroutiine P7 to print positive integer]
+          T47K P200F      [M, main routine]
+[--------------------------------------------------------------------------
+ Library subroutine M3, prints header at load time and is then overwritten.
+ This header is 'AREA = ' and leaves the teleprinter in figures mode.]
+      PFGKIFAFRDLFUFOFE@A6FG@E8FEZPF
+      *AREA!#V!..PZ
+[--------------------------------------------------------------------------
+ Main routine]
+          E25K TM GK
+    [0]   PF PF     [sum, then shifted absolute sum]
+    [2]   PF        [x{0}]
+    [3]   PF        [y{0}]
+    [4]   PF        [x_curr, current x-coordinate]
+    [5]   PF        [x_prev, previous x-coordinate]
+    [6]   PF        [y-coordinate, gets copied to multiplier register]
+    [7]   PF        [positive count of vertices, then negative loop counter]
+    [8]   PD        [17-bit constant 1]
+    [9]   MF        [decimal point (in figures mode)]
+   [10]   @F        [carriage return]
+   [11]   &F        [line feed]
+   [12]   K4096F    [null]
+
+[In this program, it's assumed that input values are 17-bit signed integers,
+   so that the value from library subroutine R4 is returned in 0F.
+ Note that R4 changes the multiplier register.
+ Enter here with acc = 0]
+   [13]   A13@ GH         [0F := count of vertices, right justified]
+          AF LD T7@       [store count, shifted to address field]
+        [First vertex is read outside the loop]
+   [18]   A18@ GH         [0F := x{0}]
+          AF U2@ T5@      [store in x{0} and x_prev]
+   [23]   A23@ GH         [0F := y{0}]
+          AF U3@ T6@      [store in y{0} and y_mr]
+          T#@             [initialize sum to 0]
+          S7@             [acc := negative count of vertices]
+          A2F             [allow for first vertex being outside the loop]
+        [Head of loop]
+   [31]   T7@             [update negative count of vertices]
+   [32]   A32@ GH         [0F := x coordinate]
+          AF T4@          [store in x_curr]
+          H6@             [y coordinate to multiplier register]
+          A#@ N4@ T#@     [sum := sum - x_curr*y_mr]
+   [40]   A40@ GH         [0F := y-coordinate]
+          AF T6@ H6@      [store in y_mr and multiplier register]
+          A#@ V5@ T#@     [sum := sum + x_prev*y_mr]
+          A4@ T5@         [x_prev := x_curr]
+          A7@ A2F         [inc negative count of vertices]
+          G31@            [if still < 0, loop back]
+       [All vertices have been read, finish off. Here acc = 0.]
+          A#@ N2@         [acc := sum - x{0}*y{n}]
+          H3@ V5@         [acc := acc + x{n}*y{0}]
+          E60@ TD SD      [if acc < 0 then negate it]
+   [60]
+       [Here acc = abs(final sum). Since coordinates are scaled by 2^-16,
+        the sum is scaled by 2^-32. Shift 2 right to scale by 2^-34,
+        the scaling for a 35-bit integer. Finally shift 1 more right
+        to get the area, which is half an integer.]
+          R1F U#@         [shift 2 right, save result (= 2*area)]
+          RD TD           [0D := floor(area) for print routine]
+   [64]   A64@ GN O9@     [print floor(area) and decimal point]
+          H8@             [mult. reg. := 17-bit 1]
+          C@ S8@          [test 2*area for even or odd]
+          G73@            [if even, jump to print '0']
+          O31@ E74@       [else print '5' and skip next]
+   [73]   O8@             [print '0']
+   [74]   O10@ O11@       [print carriage return, line feed]
+          O12@            [print null to flush printer buffer]
+          ZF              [halt the machine]
+[================== H parameter: Library subroutine R4 ==================]
+[Input of one signed integer, returned in 0D.]
+[22 locations.]
+          E25K TH GK
+    GKA3FT21@T4DH6@E11@P5DJFT6FVDL4FA4DTDI4FA4FS5@G7@S5@G20@SDTDT6FEF
+[================== N parameter: Library subroutine P7 ==================]
+[Prints long strictly positive integer;]
+[10 characters, right justified, padded left with spaces.]
+[Even address; 35 storage locations; working position 4D.]
+          E25K TN GK
+    GKA3FT26@H28#@NDYFLDT4DS27@TFH8@S8@T1FV4DAFG31@SFLDUFOFFFSFL4F
+    T4DA1FA27@G11@XFT28#ZPFT27ZP1024FP610D@524D!FO30@SFL8FE22@
+[======================= M parameter again =============================]
+          E25K TM GK
+          E13Z            [define entry address]
+          PF              [acc = 0 on entry]
+[-----------------------------------------------------------------------
+ Signed integers to be read by subroutine R4 (sign comes _after_ value).
+ Values are: count, x{0}, y{0}, x{1}, y{1}, ...
+ The data could be on a separate tape, so that the program could be used to
+   find the area of many polygons. Cf. Wilkes, Wheeler & Gill, 1951, p. 47.]
+5+3+4+5+11+12+8+9+5+5+6+ [area = 30.0]
+[5+60003-60004-60005-60011-60012-60008-60009-60005-60005-60006-] [30.0]
+[5+15000+20000+25000+55000+60000+40000+45000+25000+25000+30000+] [750000000.0]
+[3+10+20+11+20+10+21+] [.5]
diff --git a/Task/Shoelace-formula-for-polygonal-area/Julia/shoelace-formula-for-polygonal-area.jl b/Task/Shoelace-formula-for-polygonal-area/Julia/shoelace-formula-for-polygonal-area.jl
index 20e2d29adf..a0e02ebe27 100644
--- a/Task/Shoelace-formula-for-polygonal-area/Julia/shoelace-formula-for-polygonal-area.jl
+++ b/Task/Shoelace-formula-for-polygonal-area/Julia/shoelace-formula-for-polygonal-area.jl
@@ -2,8 +2,8 @@
 Assumes x,y points go around the polygon in one direction.
 """
 shoelacearea(x, y) =
-    abs(sum(i * j for (i, j) in zip(x, append!(y[2:end], y[1]))) -
-        sum(i * j for (i, j) in zip(append!(x[2:end], x[1]), y))) / 2
+			abs(sum([i * j for (i, j) in zip(x, append!(y[2:end], y[1]))]) -
+				sum([i * j for (i, j) in zip(append!(x[2:end], x[1]), y)])) / 2
 
 x, y = [3, 5, 12, 9, 5], [4, 11, 8, 5, 6]
 @show x y shoelacearea(x, y)
diff --git a/Task/Show-ASCII-table/Zig/show-ascii-table.zig b/Task/Show-ASCII-table/Zig/show-ascii-table.zig
index 58b0f9a085..76ded1aed0 100644
--- a/Task/Show-ASCII-table/Zig/show-ascii-table.zig
+++ b/Task/Show-ASCII-table/Zig/show-ascii-table.zig
@@ -1,9 +1,10 @@
-const print = @import("std").debug.print;
+const std = @import("std");
+const print = std.debug.print;
 pub fn main() void {
-  var i: u8 = 33;
-  print(" 32: Spc", .{});
-  while (i < 127) : (i += 1) {
-    print("{:03}: {c}  ", .{ i, i });
+
+  print("032: Spc ", .{});
+  for(33..127) |i| {
+    print("{:03}: {c:<4}", .{ i, std.math.cast(u8, i).? });
     if (@mod(i, 6) == 1) {
       print("\n", .{});
     }
diff --git a/Task/Sierpinski-arrowhead-curve/ALGOL-68/sierpinski-arrowhead-curve.alg b/Task/Sierpinski-arrowhead-curve/ALGOL-68/sierpinski-arrowhead-curve.alg
index d71e509742..7cb9b9e3a0 100644
--- a/Task/Sierpinski-arrowhead-curve/ALGOL-68/sierpinski-arrowhead-curve.alg
+++ b/Task/Sierpinski-arrowhead-curve/ALGOL-68/sierpinski-arrowhead-curve.alg
@@ -53,7 +53,7 @@ BEGIN # Sierpinski Arrowhead Curve in SVG                                    #
 
             put( svg file, ( "'/>", newline, "", newline ) );
             close( svg file )
-         FI # sierpinski square # ;
+         FI # sierpinski arrowhead curve # ;
 
     sierpinski arrowhead curve( "sierpinski_arrowhead.svg", 1200, 12, 6, 200, 700 )
 
diff --git a/Task/Sierpinski-carpet/FutureBasic/sierpinski-carpet.basic b/Task/Sierpinski-carpet/FutureBasic/sierpinski-carpet.basic
new file mode 100644
index 0000000000..df454464ab
--- /dev/null
+++ b/Task/Sierpinski-carpet/FutureBasic/sierpinski-carpet.basic
@@ -0,0 +1,25 @@
+local fn IsInCarpet( x as NSUInteger, y as NSUInteger ) as BOOL
+  while ( x != 0 && y != 0 )
+    if ( x % 3 == 1 && y % 3 == 1 ) then return NO
+    y /= 3 : x /= 3
+  wend
+end fn = YES
+
+void local fn SierpinskiCarpet( n as NSUInteger )
+  NSUInteger i, j, k = fn pow(3,n) - 1
+  pen -1
+  for i = 0 to k
+    for j = 0 to k
+      ColorRef col = fn ColorOrange
+      if ( fn IsInCarpet(i,j) )
+        col = fn ColorRed
+      end if
+      rect fill (i * 10, j * 10, 10, 10 ), col
+    next
+  next
+end fn
+
+window 1, @"Sierpinski Carpet", (0,0,270,270), NSWindowStyleMaskTitled
+fn SierpinskiCarpet(3)
+
+HandleEvents
diff --git a/Task/Sierpinski-pentagon/Ada/sierpinski-pentagon.ada b/Task/Sierpinski-pentagon/Ada/sierpinski-pentagon.ada
new file mode 100644
index 0000000000..29b48ba909
--- /dev/null
+++ b/Task/Sierpinski-pentagon/Ada/sierpinski-pentagon.ada
@@ -0,0 +1,45 @@
+pragma Ada_2022;
+with Ada.Numerics;  use Ada.Numerics;
+with Ada.Numerics.Discrete_Random;
+with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
+with Easy_Graphics; use Easy_Graphics;
+
+procedure Sierpinski_Pentagon is
+   Img : Easy_Image := New_Image ((1, 1), (512, 512), WHITE);
+
+   procedure Chaos_Game (Image        : in out Easy_Image;
+                         Vertex_Count : Positive;
+                         Radius       : Float;
+                         Iters        : Positive) is
+      type Vertex_Array is array (1 .. Vertex_Count) of Point;
+      Vertices : Vertex_Array;
+      subtype Vertex_Range is Integer range 1 .. Vertex_Count;
+      package Rand_V is new Ada.Numerics.Discrete_Random (Vertex_Range);
+      use Rand_V;
+      Gen : Generator;
+      Half_X  : constant Integer := X_Last (Image) / 2;
+      Half_Y  : constant Integer := Y_Last (Image) / 2;
+      Half_Pi : constant Float   := Float (Pi) / 2.0;
+      Two_Pi  : constant Float   := Float (Pi) * 2.0;
+      V       : Integer;
+      X       : Integer := Half_X;
+      Y       : Integer := Half_Y;
+   begin
+      for V in 1 .. Vertex_Count loop
+         Vertices (V).X := Half_X + Integer (Float (Half_X) *
+                           Cos (Half_Pi + (Float (V - 1)) * Two_Pi / Float (Vertex_Count)));
+         Vertices (V).Y := Half_Y - Integer (Float (Half_Y) *
+                           Sin (Half_Pi + (Float (V - 1)) * Two_Pi / Float (Vertex_Count)));
+      end loop;
+      for I in 1 .. Iters loop
+         V := Random (Gen);
+         X := X + Integer (Radius * Float (Vertices (V).X - X));
+         Y := Y + Integer (Radius * Float (Vertices (V).Y - Y));
+         Plot (Image, (X, Y), BLACK);
+      end loop;
+   end Chaos_Game;
+
+begin
+   Chaos_Game (Img, 5, 1.0 / ((1.0 + Sqrt (5.0)) / 2.0), 1_000_000);
+   Write_GIF (Img, "sierpinski_pentagon.gif");
+end Sierpinski_Pentagon;
diff --git a/Task/Sierpinski-pentagon/D/sierpinski-pentagon.d b/Task/Sierpinski-pentagon/D/sierpinski-pentagon.d
index dee83b683a..c5d2d0877c 100644
--- a/Task/Sierpinski-pentagon/D/sierpinski-pentagon.d
+++ b/Task/Sierpinski-pentagon/D/sierpinski-pentagon.d
@@ -89,7 +89,7 @@ struct Point {
     }
 }
 
-/// Mock turtle implementation sufficiant to handle "drawing" the pentagons
+/// Mock turtle implementation sufficient to handle "drawing" the pentagons
 class Turtle {
     /////////////////////////////////
     private:
diff --git a/Task/Sierpinski-square-curve/ALGOL-68/sierpinski-square-curve.alg b/Task/Sierpinski-square-curve/ALGOL-68/sierpinski-square-curve.alg
index 685c1f0d6c..c7ecec5bdc 100644
--- a/Task/Sierpinski-square-curve/ALGOL-68/sierpinski-square-curve.alg
+++ b/Task/Sierpinski-square-curve/ALGOL-68/sierpinski-square-curve.alg
@@ -53,7 +53,7 @@ BEGIN # Sierpinski Square Curve in SVG - SVG generation translated from the  #
 
             put( svg file, ( "'/>", newline, "", newline ) );
             close( svg file )
-         FI # sierpinski square # ;
+         FI # sierpinski square curve # ;
 
     sierpinski square curve( "sierpinski_square.svg", 635, 5, 5 )
 
diff --git a/Task/Sierpinski-triangle-Graphical/ALGOL-68/sierpinski-triangle-graphical.alg b/Task/Sierpinski-triangle-Graphical/ALGOL-68/sierpinski-triangle-graphical.alg
index 329a8843ce..b81d938f63 100644
--- a/Task/Sierpinski-triangle-Graphical/ALGOL-68/sierpinski-triangle-graphical.alg
+++ b/Task/Sierpinski-triangle-Graphical/ALGOL-68/sierpinski-triangle-graphical.alg
@@ -53,7 +53,7 @@ BEGIN # Sierpinski Triangle Curve in SVG                                     #
 
             put( svg file, ( "'/>", newline, "", newline ) );
             close( svg file )
-         FI # sierpinski square # ;
+         FI # sierpinski triangle curve # ;
 
     sierpinski triangle curve( "sierpinski_triangle.svg", 1200, 12, 5, 200, 400 )
 
diff --git a/Task/Sieve-of-Eratosthenes/K/sieve-of-eratosthenes.k b/Task/Sieve-of-Eratosthenes/K/sieve-of-eratosthenes.k
new file mode 100644
index 0000000000..3735a28d9a
--- /dev/null
+++ b/Task/Sieve-of-Eratosthenes/K/sieve-of-eratosthenes.k
@@ -0,0 +1,10 @@
+n:100
+limit: _%n+1 // until square root +1
+iter:(2_!limit),limit  // to be iterated over inclusive limit
+numbers: (!n),n // array with numbers until n (inclusive)
+sieve: {2_((&0=x!)numbers)} // sieve function first two omitted
+dummy: { {yy:x; $[ ( (yy!x) ~ 0 ); numbers[x]:0 ;]}'sieve x}'|iter // iter must be reversed
+// this sets multiples in the array numbers to zero, if the modulus is zero
+// each x in iter is checked with '
+dummy: dummy   // to supress output
+1_(0<)#numbers // filter out bigger than zero
diff --git a/Task/Sieve-of-Eratosthenes/Langur/sieve-of-eratosthenes.langur b/Task/Sieve-of-Eratosthenes/Langur/sieve-of-eratosthenes.langur
index ed2a4bd2b4..18ed97992a 100644
--- a/Task/Sieve-of-Eratosthenes/Langur/sieve-of-eratosthenes.langur
+++ b/Task/Sieve-of-Eratosthenes/Langur/sieve-of-eratosthenes.langur
@@ -12,7 +12,7 @@ val sieve = fn(limit) {
         }
     }
 
-    filter fn n:not composite[n], series(limit-1)
+    filter series(limit-1), by=fn n:not composite[n]
 }
 
 writeln sieve(100)
diff --git a/Task/Sieve-of-Eratosthenes/Odin/sieve-of-eratosthenes.odin b/Task/Sieve-of-Eratosthenes/Odin/sieve-of-eratosthenes.odin
new file mode 100644
index 0000000000..e3834b9432
--- /dev/null
+++ b/Task/Sieve-of-Eratosthenes/Odin/sieve-of-eratosthenes.odin
@@ -0,0 +1,36 @@
+package main
+
+import "core:fmt"
+import "core:math"
+
+
+main :: proc() {
+
+    n :: 120
+    // outer loop with square root as limit
+    limit := i32(math.round_f16(math.sqrt_f16(n)))
+
+    array : [n]i32
+    // fill array with values
+    for i:=1;iA is any m by n matrix, square or rectangular. Its rank is r. We will diagonalize this A, but not by X^{−1}AX.
+A is any m by n matrix, square or rectangular. Its rank is r. We will diagonalize this A, but not by X^{-1} A X.
 The eigenvectors in X have three big problems: They are usually not orthogonal, there
-are not always enough eigenvectors, and Ax = λx requires A to be a square matrix. The
+are not always enough eigenvectors, and Ax = \lambda x requires A to be a square matrix. The
 singular vectors of A solve all those problems in a perfect way.   
 
 [https://math.mit.edu/classes/18.095/2016IAP/lec2/SVD_Notes.pdf The Singular Value Decomposition (SVD)]   
 
-According to the web page above, for any rectangular matrix A, we can decomposite it as A=UΣV^T
+According to the web page above, for any rectangular matrix A, we can decomposite it as A=U\Sigma V^T
 
 ''' Task Description'''   
 
@@ -13,7 +13,7 @@ Firstly, input two numbers "m" and "n".
 
 Then, input a square/rectangular matrix A^{m\times n}.   
 
-Finally, output U,Σ,V with respect to A.
+Finally, output U,~\Sigma,\ V with respect to A.
 
 ''' Example '''   
 
diff --git a/Task/Singular-value-decomposition/FreeBASIC/singular-value-decomposition.basic b/Task/Singular-value-decomposition/FreeBASIC/singular-value-decomposition.basic
index 51cc7b262a..81928efde4 100644
--- a/Task/Singular-value-decomposition/FreeBASIC/singular-value-decomposition.basic
+++ b/Task/Singular-value-decomposition/FreeBASIC/singular-value-decomposition.basic
@@ -1,4 +1,4 @@
-#include once "g:\FreeBASIC\inc\gsl\gsl_linalg.bi"
+#include once "inc\gsl\gsl_linalg.bi"
 
 Sub MatrixPrint(r As Integer, c As Integer, m() As Double)
     For i As Integer = 0 To r - 1
diff --git a/Task/Sisyphus-sequence/FreeBASIC/sisyphus-sequence.basic b/Task/Sisyphus-sequence/FreeBASIC/sisyphus-sequence.basic
new file mode 100644
index 0000000000..d8d2253733
--- /dev/null
+++ b/Task/Sisyphus-sequence/FreeBASIC/sisyphus-sequence.basic
@@ -0,0 +1,83 @@
+'#include "isprime.bas"
+
+Function getNthPrime(n As Integer) As Longint
+    If n <= 0 Then Return 0
+
+    Dim As Integer cnt = 0
+    Dim As Longint num = 1
+
+    While cnt < n
+        num += 1
+        If isPrime(num) Then cnt += 1
+    Wend
+
+    Return num
+End Function
+
+Function findMax(arr() As Integer) As Integer
+    Dim As Integer maxVal = arr(0)
+    For i As Integer = 1 To Ubound(arr)
+        If arr(i) > maxVal Then maxVal = arr(i)
+    Next
+    Return maxVal
+End Function
+
+' Main program
+Const As Longint limit = 1e6
+Dim As Double sisyphus(100)
+Dim As Integer under250(250)
+Dim As Integer i, m, np = 0
+Dim As Longint specific = 1000
+Dim As Longint cnt = 1
+Dim As Double nextVal = 1
+
+sisyphus(0) = 1
+under250(1) = 1
+
+Do
+    If (nextVal Mod 2) = 0 Then
+        nextVal /= 2
+    Else
+        np += 1
+        nextVal += getNthPrime(np)
+    End If
+
+    If nextVal <= 250 Then under250(nextVal) += 1
+
+    cnt += 1
+    If cnt <= 100 Then
+        sisyphus(cnt-1) = nextVal
+        If cnt = 100 Then
+            Print "The first 100 members of the Sisyphus sequence are:"
+            For i = 0 To 99
+                Print Using "####"; sisyphus(i);
+                If (i + 1) Mod 10 = 0 Then Print
+            Next
+            Print
+        End If
+    Elseif cnt = specific Then
+        Print Using "###,###,###,###"; cnt;
+        Print "th member is: ";
+        Print Using "###,###,###,###"; nextVal;
+        Print " and highest prime needed: ";
+        Print Using "###,###,###"; getNthPrime(np)
+
+        If cnt = limit Then
+            m = findMax(under250())
+            Print !"\nNumbers under 250 that do not occur in first "; cnt; " terms:"
+            For i = 1 To 250
+                If under250(i) = 0 Then Print i; " ";
+            Next
+            Print
+            Print !"\nNumbers under 250 that occur the most in first "; cnt; " terms:"
+            For i = 1 To 250
+                If under250(i) = m Then Print i; " ";
+            Next
+            Print " all occur "; m; " times."
+            Exit Do
+        End If
+        specific *= 10
+    End If
+Loop
+
+Sleep
diff --git a/Task/Sisyphus-sequence/Zig/sisyphus-sequence.zig b/Task/Sisyphus-sequence/Zig/sisyphus-sequence.zig
new file mode 100644
index 0000000000..0b7db13562
--- /dev/null
+++ b/Task/Sisyphus-sequence/Zig/sisyphus-sequence.zig
@@ -0,0 +1,162 @@
+const primesieve = @cImport({
+    @cInclude("primesieve.h");
+});
+const std = @import("std");
+const mem = std.mem;
+
+pub fn main() !void {
+    var t0 = try std.time.Timer.start();
+    // ------------------------------------------------------- stdout
+    const stdout = std.io.getStdOut().writer();
+    // ---------------------------------------------------- allocator
+    var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator);
+    defer arena.deinit();
+    const allocator = arena.allocator();
+    // --------------------------------------------------------------
+    var counter = try Counter.init(allocator);
+    defer counter.deinit();
+
+    var sisyphus = try SisyphusSequenceGenerator.init();
+    defer sisyphus.deinit();
+
+    var number: u64 = undefined;
+    for (0..10) |_| {
+        for (0..10) |_| {
+            number = try sisyphus.next();
+            try counter.add(number);
+            try stdout.print(" {d:3}", .{number});
+        }
+        try stdout.writeByte('\n');
+    }
+    try stdout.writeByte('\n');
+
+    for ([_]usize{ 1_000, 10_000, 100_000, 1_000_000, 10_000_000, 100_000_000 }) |n| {
+        while (counter.count != n) {
+            number = try sisyphus.next();
+            try counter.add(number);
+        }
+        try stdout.print(
+            "{d:10}th member is {d:10} and highest prime needed is {d:9}\n",
+            .{ n, number, sisyphus.prime },
+        );
+    }
+    {
+        try stdout.writeAll("\nThese numbers under 250 do not occur in the first 100,000,000 terms:\n");
+        const missing = try counter.getMissing(allocator);
+        defer allocator.free(missing);
+
+        var sep: []const u8 = "";
+        for (missing) |n| {
+            try stdout.print("{s}{d}", .{ sep, n });
+            sep = ", ";
+        }
+        try stdout.writeByte('\n');
+    }
+    {
+        try stdout.writeAll("\nThese numbers under 250 occur the most in the first 100,000,000 terms:\n");
+        const most = try counter.getMost(allocator);
+        defer allocator.free(most.numbers);
+
+        var sep: []const u8 = "";
+        for (most.numbers) |n| {
+            try stdout.print("{s}{d}", .{ sep, n });
+            sep = ", ";
+        }
+        try stdout.print(" all occur {d} times.\n", .{most.max});
+    }
+    var count = counter.count; // Only need the count, not the found hashmap. Ditch counter.
+    while (true) {
+        number = try sisyphus.next();
+        count += 1;
+        if (number == 36) {
+            try stdout.print(
+                "\nMember {d} is {d} and highest prime needed is {d}\n",
+                .{ count, number, sisyphus.prime },
+            );
+            break;
+        }
+    }
+    try stdout.print("\nProcessed in {}\n", .{std.fmt.fmtDuration(t0.read())});
+}
+
+const SisyphusSequenceGeneratorError = error{
+    PrimeSieveError,
+};
+
+const SisyphusSequenceGenerator = struct {
+    it: primesieve.primesieve_iterator = undefined,
+    next_: u64 = 1,
+    prime: u64 = 0,
+
+    fn init() !SisyphusSequenceGenerator {
+        var si = SisyphusSequenceGenerator{};
+        primesieve.primesieve_init(&si.it);
+        return si;
+    }
+    fn deinit(self: *SisyphusSequenceGenerator) void {
+        primesieve.primesieve_free_iterator(&self.it);
+    }
+    fn next(self: *SisyphusSequenceGenerator) SisyphusSequenceGeneratorError!u64 {
+        const n = self.next_;
+        if (self.next_ % 2 == 0) {
+            self.next_ /= 2;
+        } else {
+            self.prime = primesieve.primesieve_next_prime(&self.it);
+            if (self.it.is_error != 0 or self.prime == primesieve.PRIMESIEVE_ERROR)
+                return SisyphusSequenceGeneratorError.PrimeSieveError;
+            self.next_ += self.prime;
+        }
+        return n;
+    }
+};
+
+const Counter = struct {
+    found: std.AutoHashMap(u64, usize),
+    count: usize = 0,
+
+    fn init(allocator: mem.Allocator) !Counter {
+        var found = std.AutoHashMap(u64, usize).init(allocator);
+        try found.ensureTotalCapacity(250);
+        for (1..250) |n|
+            try found.put(@as(u64, n), 0);
+        return Counter{ .found = found };
+    }
+    fn deinit(self: *Counter) void {
+        self.found.deinit();
+    }
+    fn add(self: *Counter, n: u64) !void {
+        self.count += 1;
+        if (n < 250)
+            self.found.getEntry(n).?.value_ptr.* += 1;
+    }
+    /// Caller owns returned slice memory.
+    fn getMissing(self: *const Counter, allocator: mem.Allocator) ![]u64 {
+        var missing_array = std.ArrayList(u64).init(allocator);
+        var it = self.found.iterator();
+        while (it.next()) |entry| {
+            if (entry.value_ptr.* == 0)
+                try missing_array.append(entry.key_ptr.*);
+        }
+        const missing = try missing_array.toOwnedSlice();
+        mem.sort(u64, missing, {}, std.sort.asc(u64));
+        return missing;
+    }
+    /// Caller owns returned 'numbers' slice memory.
+    fn getMost(self: *const Counter, allocator: mem.Allocator) !struct { numbers: []u64, max: usize } {
+        // Find the maximum count (there may be more than one at this value)
+        var value_it = self.found.valueIterator();
+        var max: usize = 0;
+        while (value_it.next()) |count|
+            max = @max(max, count.*);
+
+        var most_array = std.ArrayList(u64).init(allocator);
+        var it = self.found.iterator();
+        while (it.next()) |entry| {
+            if (entry.value_ptr.* == max)
+                try most_array.append(entry.key_ptr.*);
+        }
+        const most = try most_array.toOwnedSlice();
+        mem.sort(u64, most, {}, std.sort.asc(u64));
+        return .{ .numbers = most, .max = max };
+    }
+};
diff --git a/Task/Sleep/Quackery/sleep.quackery b/Task/Sleep/Quackery/sleep.quackery
new file mode 100644
index 0000000000..63bbf56a18
--- /dev/null
+++ b/Task/Sleep/Quackery/sleep.quackery
@@ -0,0 +1,7 @@
+  [ $ \import time
+time.sleep(from_stack())\
+    python ]              is sleep ( seconds --> )
+
+  say "Sleeping..."
+  10 sleep
+  say "Awake!"
diff --git a/Task/Sleep/Standard-ML/sleep-1.ml b/Task/Sleep/Standard-ML/sleep-1.ml
new file mode 100644
index 0000000000..ad62f83d2b
--- /dev/null
+++ b/Task/Sleep/Standard-ML/sleep-1.ml
@@ -0,0 +1,12 @@
+fun doSleep () =
+  let
+    val maybeline = TextIO.inputLine TextIO.stdIn
+    val line = if isSome maybeline then valOf maybeline else raise Fail "Enter a number of seconds"
+    val maybesecs = Real.fromString line
+    val secs = if isSome maybesecs then valOf maybesecs else raise Fail "Bad number entered"
+    val () = print "Sleeping...\n"
+    val () = OS.Process.sleep (Time.fromReal secs)
+    val () = print "Awake!\n"
+  in
+    ()
+  end
diff --git a/Task/Sleep/Standard-ML/sleep-2.ml b/Task/Sleep/Standard-ML/sleep-2.ml
new file mode 100644
index 0000000000..b535620c46
--- /dev/null
+++ b/Task/Sleep/Standard-ML/sleep-2.ml
@@ -0,0 +1,2 @@
+(* load the above function in the REPL and then: *)
+PolyML.export("doSleep.o", doSleep);
diff --git a/Task/Sleep/Standard-ML/sleep.ml b/Task/Sleep/Standard-ML/sleep.ml
deleted file mode 100644
index dc947357b6..0000000000
--- a/Task/Sleep/Standard-ML/sleep.ml
+++ /dev/null
@@ -1,8 +0,0 @@
-(TextIO.print "input a number of seconds please: ";
-let val seconds = valOf (Int.fromString (valOf (TextIO.inputLine TextIO.stdIn))) in
-  TextIO.print "Sleeping...\n";
-  OS.Process.sleep (Time.fromReal seconds);  (* it takes a Time.time data structure as arg,
-                                               but in my implementation it seems to round down to the nearest second.
-                                               I dunno why; it doesn't say anything about this in the documentation *)
-  TextIO.print "Awake!\n"
-end)
diff --git a/Task/Smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k/Ada/smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k.ada b/Task/Smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k/Ada/smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k.ada
new file mode 100644
index 0000000000..691e6d45dd
--- /dev/null
+++ b/Task/Smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k/Ada/smallest-number-k-such-that-k+2^m-is-composite-for-all-m-less-than-k.ada
@@ -0,0 +1,40 @@
+-- Rosetta Code Task written in Ada
+-- Smallest number k such that k+2^m is composite for all m less than k
+-- https://rosettacode.org/wiki/Smallest_number_k_such_that_k%2B2%5Em_is_composite_for_all_m_less_than_k
+-- loosely translated from the Python solution
+-- uses Unbounded_Unsigneds from Simple Components
+-- January 2025, R. B. E. (with significant support from the author of the Simple Components Ada Package)
+
+with Ada.Text_IO;                 use Ada.Text_IO;
+with Unbounded_Unsigneds;         use Unbounded_Unsigneds;
+with Unbounded_Unsigneds.Primes;  use Unbounded_Unsigneds.Primes;
+
+procedure Smallest_k is
+
+   function Is_A033919 (K : Bit_Count) return Boolean is
+      N : Unbounded_Unsigned;
+   begin
+      for M in 1..K loop
+         Power_Of_Two (M, N);
+         Add (N, Half_Word (K));
+         if Is_Prime (N, 15) /= Composite then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Is_A033919;
+
+   Numbers_Found : Natural := 0;
+   Max_Numbers_to_Calculate : constant Positive := 5;
+   I : Bit_Count := 3;
+begin
+   loop
+      if Is_A033919 (I) then
+         Numbers_Found := Numbers_Found + 1;
+         Put (Bit_Count'Image (I));
+      end if;
+      exit when Numbers_Found = Max_Numbers_to_Calculate;
+      I := I + 2;
+   end loop;
+   New_Line;
+end Smallest_k;
diff --git a/Task/Sort-a-list-of-object-identifiers/FreeBASIC/sort-a-list-of-object-identifiers.basic b/Task/Sort-a-list-of-object-identifiers/FreeBASIC/sort-a-list-of-object-identifiers.basic
new file mode 100644
index 0000000000..e21c5c205a
--- /dev/null
+++ b/Task/Sort-a-list-of-object-identifiers/FreeBASIC/sort-a-list-of-object-identifiers.basic
@@ -0,0 +1,64 @@
+Function formatOID(oid As String) As String
+    Dim As String result = ""
+    Dim As String segment = ""
+    Dim As Integer i = 1, lenOID = Len(oid)
+
+	While i <= lenOID
+        If Mid(oid, i, 1) = "." Then
+            result &= Space(5 - Len(segment)) & segment & "."
+            segment = ""
+        Else
+            segment &= Mid(oid, i, 1)
+        End If
+        i += 1
+    Wend
+    result &= Space(5 - Len(segment)) & segment
+    Return result
+End Function
+
+Sub quickSort(arr() As String, first As Integer, last As Integer)
+    If first >= last Then Exit Sub
+
+    Dim As Integer i = first, j = last
+    Dim As String pivot = arr((first + last) \ 2)
+
+    Do
+        While arr(i) < pivot: i += 1: Wend
+        While arr(j) > pivot: j -= 1: Wend
+
+        If i <= j Then
+            Swap arr(i), arr(j)
+            i += 1
+            j -= 1
+        End If
+    Loop Until i > j
+
+    If first < j Then quickSort(arr(), first, j)
+    If i < last Then quickSort(arr(), i, last)
+End Sub
+
+' Main program
+Dim As Integer i, j
+Dim As String oids(5) = { _
+"1.3.6.1.4.1.11.2.17.19.3.4.0.10", _
+"1.3.6.1.4.1.11.2.17.5.2.0.79", _
+"1.3.6.1.4.1.11.2.17.19.3.4.0.4", _
+"1.3.6.1.4.1.11150.3.4.0.1", _
+"1.3.6.1.4.1.11.2.17.19.3.4.0.1", _
+"1.3.6.1.4.1.11150.3.4.0" }
+
+For i = 0 To Ubound(oids)
+    oids(i) = formatOID(oids(i))
+Next
+
+quickSort(oids(), 0, Ubound(oids))
+
+For i = 0 To Ubound(oids)
+    Dim As String tmp = ""
+    For j = 1 To Len(oids(i))
+        If Mid(oids(i), j, 1) <> " " Then tmp &= Mid(oids(i), j, 1)
+    Next
+    Print tmp
+Next
+
+Sleep
diff --git a/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-3.rexx b/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-3.rexx
index 35e8662e81..0df1385350 100644
--- a/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-3.rexx
+++ b/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-3.rexx
@@ -1,6 +1,7 @@
+-- Module Quicksort21.inc - Build 30 Jan 2025
+-- Fast stem sort
+
 default [label]=Quicksort21 [table]=table. [key1]=key1. [key2]=key2. [data1]=data1. [lt]=< [eq]== [gt]=>
--- Sorting procedure - Build 7 Sep 2024
--- (C) Paul van den Eertwegh 2024
 
 [label]:
 -- Sort a stem on 2 key columns, syncing 1 data column
diff --git a/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-4.rexx b/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-4.rexx
index 6d56931334..b12abc5667 100644
--- a/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-4.rexx
+++ b/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures-4.rexx
@@ -1,23 +1,24 @@
+-- Module Quicksort.inc - Build 30 Jan 2025
+-- Generic stem sort
+
 default [label]=Quicksort [lt]=< [eq]== [gt]=>
--- Sorting procedure - Build 7 Sep 2024
--- (C) Paul van den Eertwegh 2024
 
 [label]:
 -- Sort a stem on 1 or more key columns, syncing 0 or more data columns
 procedure expose (table)
 arg table,keys,data
 -- Collect keys
-kn = words(keys)
+kn = Words(keys)
 do x = 1 to kn
-   key.x = word(keys,x)
+   key.x = Word(keys,x)
 end
 -- Collect data
-dn = words(data)
+dn = Words(data)
 do x = 1 to dn
-   data.x = word(data,x)
+   data.x = Word(data,x)
 end
 -- Sort
-n = value(table||0); s = 1; sl.1 = 1; sr.1 = n
+n = Value(table||0); s = 1; sl.1 = 1; sr.1 = n
 do until s = 0
    l = sl.s; r = sr.s; s = s-1
    do until l >= r
@@ -25,14 +26,14 @@ do until s = 0
       if r-l < 20 then do
          do i = l+1 to r
             do x = 1 to kn
-               k.x = value(table||key.x||i)
+               k.x = Value(table||key.x||i)
             end
             do x = 1 to dn
-               d.x = value(table||data.x||i)
+               d.x = Value(table||data.x||i)
             end
             do j=i-1 to l by -1
                do x = 1 to kn
-                  a = value(table||key.x||j)
+                  a = Value(table||key.x||j)
                   if a [gt] k.x then
                      leave x
                   if a [eq] k.x then
@@ -42,11 +43,11 @@ do until s = 0
                end
                k = j+1
                do x = 1 to kn
-                  t = value(table||key.x||j)
+                  t = Value(table||key.x||j)
                   call value table||key.x||k,t
                end
                do x = 1 to dn
-                  t = value(table||data.x||j)
+                  t = Value(table||data.x||j)
                   call value table||data.x||k,t
                end
             end
@@ -66,14 +67,14 @@ do until s = 0
 -- Find optimized pivot
          m = (l+r)%2
          do x = 1 to kn
-            a = value(table||key.x||l); b = value(table||key.x||m)
+            a = Value(table||key.x||l); b = Value(table||key.x||m)
             if a [gt] b then do
                do y = 1 to kn
-                  t = value(table||key.y||l); u = value(table||key.y||m)
+                  t = Value(table||key.y||l); u = Value(table||key.y||m)
                   call value table||key.y||l,u; call value table||key.y||m,t
                end
                do y = 1 to dn
-                  t = value(table||data.y||l); u = value(table||data.y||m)
+                  t = Value(table||data.y||l); u = Value(table||data.y||m)
                   call value table||data.y||l,u; call value table||data.y||m,t
                end
                leave
@@ -82,14 +83,14 @@ do until s = 0
                leave
          end
          do x = 1 to kn
-            a = value(table||key.x||l); b = value(table||key.x||r)
+            a = Value(table||key.x||l); b = Value(table||key.x||r)
             if a [gt] b then do
                do y = 1 to kn
-                  t = value(table||key.y||l); u = value(table||key.y||r)
+                  t = Value(table||key.y||l); u = Value(table||key.y||r)
                   call value table||key.y||l,u; call value table||key.y||r,t
                end
                do y = 1 to dn
-                  t = value(table||data.y||l); u = value(table||data.y||r)
+                  t = Value(table||data.y||l); u = Value(table||data.y||r)
                   call value table||data.y||l,u; call value table||data.y||r,t
                end
                leave
@@ -98,14 +99,14 @@ do until s = 0
                leave
          end
          do x = 1 to kn
-            a = value(table||key.x||m); b = value(table||key.x||r)
+            a = Value(table||key.x||m); b = Value(table||key.x||r)
             if a [gt] b then do
                do y = 1 to kn
-                  t = value(table||key.y||m); u = value(table||key.y||r)
+                  t = Value(table||key.y||m); u = Value(table||key.y||r)
                   call value table||key.y||m,u; call value table||key.y||r,t
                end
                do y = 1 to dn
-                  t = value(table||data.y||m); u = value(table||data.y||r)
+                  t = Value(table||data.y||m); u = Value(table||data.y||r)
                   call value table||data.y||m,u; call value table||data.y||r,t
                end
                leave
@@ -116,12 +117,12 @@ do until s = 0
 -- Rearrange rows in partition
          i = l; j = r
          do x = 1 to kn
-            p.x = value(table||key.x||m)
+            p.x = Value(table||key.x||m)
          end
          do until i > j
             do i = i
                do x = 1 to kn
-                  a = value(table||key.x||i)
+                  a = Value(table||key.x||i)
                   if a [lt] p.x then
                      leave x
                   if a [eq] p.x then
@@ -132,7 +133,7 @@ do until s = 0
             end
             do j = j by -1
                do x = 1 to kn
-                  a = value(table||key.x||j)
+                  a = Value(table||key.x||j)
                   if a [gt] p.x then
                      leave x
                   if a [eq] p.x then
@@ -143,11 +144,11 @@ do until s = 0
             end
             if i <= j then do
                do x = 1 to kn
-                  t = value(table||key.x||i); u = value(table||key.x||j)
+                  t = Value(table||key.x||i); u = Value(table||key.x||j)
                   call value table||key.x||i,u; call value table||key.x||j,t
                end
                do x = 1 to dn
-                  t = value(table||data.x||i); u = value(table||data.x||j)
+                  t = Value(table||data.x||i); u = Value(table||data.x||j)
                   call value table||data.x||i,u; call value table||data.x||j,t
                end
                i = i+1; j = j-1
diff --git a/Task/Sort-an-integer-array/Joy/sort-an-integer-array.joy b/Task/Sort-an-integer-array/Joy/sort-an-integer-array.joy
new file mode 100644
index 0000000000..e9e6912162
--- /dev/null
+++ b/Task/Sort-an-integer-array/Joy/sort-an-integer-array.joy
@@ -0,0 +1,5 @@
+    1 3 2 4
+   stack dup.
+   [4 2 3 1]
+   qsort.
+   [1 2 3 4]
diff --git a/Task/Sort-an-integer-array/M2000-Interpreter/sort-an-integer-array.m2000 b/Task/Sort-an-integer-array/M2000-Interpreter/sort-an-integer-array.m2000
new file mode 100644
index 0000000000..8a4cd71eca
--- /dev/null
+++ b/Task/Sort-an-integer-array/M2000-Interpreter/sort-an-integer-array.m2000
@@ -0,0 +1,21 @@
+module Sort_an_integer_array{
+	const n=10
+	// s() for feeding array
+	s=lambda n=1 (x)->{=x-n:n++}
+	dim a(1 to n) as long long< len inp$[]
+      linpos = -1
+      return
+   .
+   lin$ = inp$[linpos]
+   linind = 0
+   for c$ in strchars lin$
+      if istab = -1
+         if c$ = " "
+            istab = 0
+         elif c$ = "\t"
+            stdind = 1
+            istab = 1
+         .
+      .
+      if c$ <> " " and c$ <> "\t"
+         if stdind = -1 and linind > 0 : stdind = linind
+         break 1
+      .
+      if istab = 0 and c$ = " " or istab = 1 and c$ = "\t"
+         linind += 1
+      else
+         print "mix of tab and space - line " & linpos
+         linpos = -1
+         return
+      .
+   .
+.
+func$[] outline .
+   curind = linind
+   repeat
+      #
+      until linpos = -1 or linind < curind
+      if linind = curind
+         r$[][] &= [ lin$ ]
+      elif linind = curind + stdind
+         h$[] = outline
+         for h$ in h$[] : r$[$][] &= h$
+      else
+         if linpos <> -1 : print "indentation error - line " & linpos
+         linpos = -1
+      .
+      nextline
+   .
+   sort r$[][]
+   for i to len r$[][]
+      for r$ in r$[i][] : r$[] &= r$
+   .
+   if linpos <> -1 : linpos -= 1
+   return r$[]
+.
+proc run dir . .
+   sortdir = dir
+   call init
+   nextline
+   for s$ in outline : print s$
+   print ""
+.
+run 1
+run -1
+#
+input_data
+zeta
+    beta
+    gamma
+        lambda
+        kappa
+        mu
+    delta
+alpha
+    theta
+    iota
+    epsilon
diff --git a/Task/Sort-an-outline-at-every-level/FreeBASIC/sort-an-outline-at-every-level.basic b/Task/Sort-an-outline-at-every-level/FreeBASIC/sort-an-outline-at-every-level.basic
new file mode 100644
index 0000000000..be7503a61b
--- /dev/null
+++ b/Task/Sort-an-outline-at-every-level/FreeBASIC/sort-an-outline-at-every-level.basic
@@ -0,0 +1,293 @@
+Type StringArray
+    Dim elements(Any) As String
+    Dim cnt As Integer
+
+    Declare Sub annadir(value As String)
+    Declare Function join(delimiter As String) As String
+End Type
+
+Sub StringArray.annadir(value As String)
+    this.cnt += 1
+    Redim Preserve this.elements(this.cnt - 1)
+    this.elements(this.cnt - 1) = value
+End Sub
+
+Function StringArray.join(delimiter As String) As String
+    Dim result As String = ""
+    For i As Integer = 0 To this.cnt - 1
+        If i > 0 Then result &= delimiter
+        result &= this.elements(i)
+    Next
+    Return result
+End Function
+
+Function Replace(text As String, find As String, replaceWith As String) As String
+    Dim result As String = text
+    Dim posic As Integer = Instr(result, find)
+
+    While posic > 0
+        result = Left(result, posic - 1) & replaceWith & Mid(result, posic + Len(find))
+        posic = Instr(posic + Len(replaceWith), result, find)
+    Wend
+
+    Return result
+End Function
+
+Function trimLeft(text As String, chars As String) As String
+    Dim i As Integer = 1
+    While i <= Len(text) Andalso Instr(chars, Mid(text, i, 1)) > 0
+        i += 1
+    Wend
+    Return Mid(text, i)
+End Function
+
+Function trimRight(text As String, chars As String) As String
+    Dim i As Integer = Len(text)
+    While i > 0 Andalso Instr(chars, Mid(text, i, 1)) > 0
+        i -= 1
+    Wend
+    Return Left(text, i)
+End Function
+
+Sub sortedOutline(originalOutline() As String, ascending As Boolean)
+    Dim As String indent = "", del = Chr(127), sep = Chr(0)
+    Dim As Integer outlineCount = Ubound(originalOutline) + 1
+    Dim As StringArray messages, nodes
+    Dim As Integer i, j
+
+    Dim As String outline(outlineCount - 1)
+    ' Copy original array
+    For i = 0 To outlineCount - 1
+        outline(i) = originalOutline(i)
+    Next
+
+    ' Check first line indentation
+    If trimLeft(outline(0), " " + Chr(9)) <> outline(0) Then
+        Print "    outline structure is unclear"
+        Exit Sub
+    End If
+
+    ' Process indentation
+    For i = 1 To outlineCount - 1
+        Dim As String linea = outline(i)
+        Dim As Integer lc = Len(linea)
+
+        If Left(linea, 2) = "  " Orelse Left(linea, 1) = Chr(9) Then
+            Dim As String trimmedLine = trimLeft(linea, " " + Chr(9))
+            Dim As String currIndent = Left(linea, lc - Len(trimmedLine))
+
+            If indent = "" Then
+                indent = currIndent
+            Else
+                Dim As Boolean correctionNeeded = False
+
+                If (Instr(currIndent, Chr(9)) > 0 Andalso Instr(indent, Chr(9)) = 0) Orelse _
+                    (Instr(currIndent, Chr(9)) = 0 Andalso Instr(indent, Chr(9)) > 0) Then
+                    messages.annadir(indent + "corrected inconsistent whitespace use at line '" + linea + "'")
+                    correctionNeeded = True
+                Elseif (Len(currIndent) Mod Len(indent)) <> 0 Then
+                    messages.annadir(indent + "corrected inconsistent indent width at line '" + linea + "'")
+                    correctionNeeded = True
+                End If
+
+                If correctionNeeded Then
+                    Dim As Integer mult = Int((Len(currIndent) + Len(indent)/2) / Len(indent))
+                    Dim As String newIndent = ""
+                    For j = 1 To mult
+                        newIndent &= indent
+                    Next
+                    outline(i) = newIndent & trimmedLine
+                End If
+            End If
+        End If
+    Next
+
+    ' Create levels array
+    Dim As Integer levels(outlineCount - 1)
+    levels(0) = 1
+    Dim As Integer level = 1
+    Dim As String margin = ""
+
+    Do
+        Dim As Boolean allProcessed = True
+        For i = 0 To outlineCount - 1
+            If levels(i) = 0 Then
+                allProcessed = False
+                Exit For
+            End If
+        Next
+        If allProcessed Then Exit Do
+
+        Dim As Integer mc = Len(margin)
+        For i = 1 To outlineCount - 1
+            If levels(i) = 0 Then
+                If Left(outline(i), mc) = margin Andalso _
+                    Mid(outline(i), mc + 1, 1) <> " " Andalso _
+                    Mid(outline(i), mc + 1, 1) <> Chr(9) Then
+                    levels(i) = level
+                End If
+            End If
+        Next
+        margin += indent
+        level += 1
+    Loop
+
+    ' Sort the outline
+    Dim As String lines(outlineCount - 1)
+    lines(0) = outline(0)
+
+    For i = 1 To outlineCount - 1
+        If levels(i) > levels(i-1) Then
+            If nodes.cnt = 0 Then
+                nodes.annadir(outline(i-1))
+            Else
+                nodes.annadir(sep + outline(i-1))
+            End If
+        Elseif levels(i) < levels(i-1) Then
+            j = levels(i-1) - levels(i)
+            nodes.cnt -= j
+            Redim Preserve nodes.elements(nodes.cnt - 1)
+        End If
+
+        If nodes.cnt > 0 Then
+            lines(i) = nodes.join("") & sep & outline(i)
+        Else
+            lines(i) = outline(i)
+        End If
+    Next
+
+    ' Sort lines
+    If ascending Then
+        For i = 0 To outlineCount - 2
+            For j = i + 1 To outlineCount - 1
+                If lines(i) > lines(j) Then Swap lines(i), lines(j)
+            Next
+        Next
+    Else
+        Dim As Integer maxLen = Len(lines(0))
+        For i = 1 To outlineCount - 1
+            If Len(lines(i)) > maxLen Then maxLen = Len(lines(i))
+        Next
+
+        For i = 0 To outlineCount - 1
+            lines(i) = lines(i) & String(maxLen - Len(lines(i)), del)
+        Next
+
+        For i = 0 To outlineCount - 2
+            For j = i + 1 To outlineCount - 1
+                If lines(i) < lines(j) Then Swap lines(i), lines(j)
+            Next
+        Next
+    End If
+
+    ' Process final lines
+    For i = 0 To outlineCount - 1
+        Dim As String parts()
+        Dim As Integer partCount = 0
+        Dim As String tmp = lines(i)
+
+        ' Split by separator
+        Do
+            Dim As Integer posic = Instr(tmp, sep)
+            If posic = 0 Then
+                partCount += 1
+                Redim Preserve parts(partCount - 1)
+                parts(partCount - 1) = tmp
+                Exit Do
+            End If
+            partCount += 1
+            Redim Preserve parts(partCount - 1)
+            parts(partCount - 1) = Left(tmp, posic - 1)
+            tmp = Mid(tmp, posic + 1)
+        Loop
+
+        lines(i) = parts(partCount - 1)
+        If Not ascending Then lines(i) = trimRight(lines(i), del)
+    Next
+
+    ' Print messages if any
+    If messages.cnt > 0 Then
+        Print messages.join(!"\n")
+        Print
+    End If
+
+    ' Print result
+    For i = 0 To outlineCount - 1
+        Print lines(i)
+    Next
+End Sub
+
+' Main program with test cases
+Dim outline(10) As String
+outline(0) = "zeta"
+outline(1) = "    beta"
+outline(2) = "    gamma"
+outline(3) = "        lambda"
+outline(4) = "        kappa"
+outline(5) = "        mu"
+outline(6) = "    delta"
+outline(7) = "alpha"
+outline(8) = "    theta"
+outline(9) = "    iota"
+outline(10) = "    epsilon"
+
+Print "Four space indented outline, ascending sort:"
+sortedOutline(outline(), True)
+
+Print !"\nFour space indented outline, descending sort:"
+sortedOutline(outline(), False)
+
+' Create outline2 (tab version)
+Dim outline2(10) As String
+For i As Integer = 0 To 10
+    outline2(i) = Replace(outline(i), "    ", Chr(9))
+Next
+
+' Create outline3
+Dim outline3(10) As String
+outline3(0) = "alpha"
+outline3(1) = "    epsilon"
+outline3(2) = "        iota"
+outline3(3) = "    theta"
+outline3(4) = "zeta"
+outline3(5) = "    beta"
+outline3(6) = "    delta"
+outline3(7) = "    gamma"
+outline3(8) = "    " + Chr(9) + "   kappa"
+outline3(9) = "        lambda"
+outline3(10) = "        mu"
+
+' Create outline4
+Dim outline4(10) As String
+outline4(0) = "zeta"
+outline4(1) = "    beta"
+outline4(2) = "   gamma"
+outline4(3) = "        lambda"
+outline4(4) = "         kappa"
+outline4(5) = "        mu"
+outline4(6) = "    delta"
+outline4(7) = "alpha"
+outline4(8) = "    theta"
+outline4(9) = "    iota"
+outline4(10) = "    epsilon"
+
+' Add these test cases after the first two Print calls
+Print !"\nTab indented outline, ascending sort:"
+sortedOutline(outline2(), True)
+
+Print !"\nTab indented outline, descending sort:"
+sortedOutline(outline2(), False)
+
+Print !"\nFirst unspecified outline, ascending sort:"
+sortedOutline(outline3(), True)
+
+Print !"\nFirst unspecified outline, descending sort:"
+sortedOutline(outline3(), False)
+
+Print !"\nSecond unspecified outline, ascending sort:"
+sortedOutline(outline4(), True)
+
+Print !"\nSecond unspecified outline, descending sort:"
+sortedOutline(outline4(), False)
+
+Sleep
diff --git a/Task/Sort-an-outline-at-every-level/M2000-Interpreter/sort-an-outline-at-every-level.m2000 b/Task/Sort-an-outline-at-every-level/M2000-Interpreter/sort-an-outline-at-every-level.m2000
new file mode 100644
index 0000000000..0b95477083
--- /dev/null
+++ b/Task/Sort-an-outline-at-every-level/M2000-Interpreter/sort-an-outline-at-every-level.m2000
@@ -0,0 +1,137 @@
+MODULE Sort_an_outline_at_every_level {
+	CLASS PACK {
+		PAD$
+		HEAD=QUEUE
+	CLASS:
+		MODULE PACK (.PAD$) {
+		}
+	}
+	FUNCTION CREATETREE(A$){
+		CONST I$=CHR$(9)+CHR$(32)
+		L=1
+		PR=PACK()
+		A=QUEUE
+		F=QUEUE
+		LN=0
+		DIM LINE$()
+		LINE$()=PIECE$(A$, CHR$(13)+CHR$(10))
+		MAX=LEN(LINE$())
+		INTEGER NORM[0]=1
+		FOR I=0 TO MAX-2
+			FOR M=1 TO LEN(LINE$(I))
+				IF INSTR(I$, MID$(LINE$(I),M, 1))=0 THEN EXIT FOR
+			NEXT
+			IF L=M THEN
+				IF NOT EMPTY THEN READ PREV$, PR: APPEND A, PREV$:=PR
+				PUSH PACK(LEFT$(LINE$(I), M-1)), MID$(LINE$(I), M)
+			ELSE.IF L{
+		}
+		TRAVERSAL(A)
+		PRINT "ASCENDING ORDER"
+		JOB=LAMBDA (Z)->{SORT ASCENDING Z}
+		TRAVERSAL(A)
+		PRINT "DESCENDING ORDER"
+		JOB=LAMBDA (Z)->{SORT DESCENDING Z}
+		TRAVERSAL(A)
+		PRINT "PRESS ANY KEY"
+		PUSH KEY$
+		DROP
+	END SUB
+	SUB TRAVERSAL(A)
+		CALL JOB(A)
+		LOCAL W=EACH(A)
+		LOCAL M=PACK()
+		WHILE W
+			M=EVAL(W)
+			// USING -2 TO PROCESS TABS.
+			PRINT #-2, M.PAD$+EVAL$(W!)
+			TRAVERSAL(M.HEAD)
+		END WHILE
+	END SUB
+}
+Sort_an_outline_at_every_level
diff --git a/Task/Sort-disjoint-sublist/FutureBasic/sort-disjoint-sublist.basic b/Task/Sort-disjoint-sublist/FutureBasic/sort-disjoint-sublist.basic
new file mode 100644
index 0000000000..52f4831947
--- /dev/null
+++ b/Task/Sort-disjoint-sublist/FutureBasic/sort-disjoint-sublist.basic
@@ -0,0 +1,21 @@
+void local fn DoIt
+  int i, values(7) = {7,6,5,4,3,2,1,0}, indices(2) = {6,1,7}
+
+  print @"Before sort:"
+  for i = 0 to 7
+    print values(i);@" ";
+  next
+
+  for i = 0 to 1
+    if ( values(indices(i)) > values(indices(i+1)) ) then swap values(indices(i)),values(indices(i+1))
+  next
+
+  print @"\n\nAfter sort:"
+  for i = 0 to 7
+    print values(i);@" ";
+  next
+end fn
+
+fn DoIt
+
+HandleEvents
diff --git a/Task/Sort-three-variables/EDSAC-order-code/sort-three-variables.edsac b/Task/Sort-three-variables/EDSAC-order-code/sort-three-variables.edsac
index d5c531fc63..293eac726c 100644
--- a/Task/Sort-three-variables/EDSAC-order-code/sort-three-variables.edsac
+++ b/Task/Sort-three-variables/EDSAC-order-code/sort-three-variables.edsac
@@ -1,47 +1,81 @@
 [Sort three variables, for Rosetta Code.
- EDSAC, Initial Orders 2]
-[---------------------------------------------------------------------------
- Sorts three 35-bit variables x, y, x, stored at 0#V, 2#V, 4#V respectively.
+ EDSAC, Initial Orders 2.
+--------------------------------------------------------------------------------
+ Sorts three variables x, y, x, stored in consecutive 35-bit locations.
  Uses the algortihm:
     if x > z then swap( x,z)
     if y > z then swap( y,z)
     if x > y then swap( x,y)
  At most two swaps are carried out in any particular case.
- ----------------------------------------------------------------------------]
+ On EDSAC, whether a variable is an integer or a fixed-point real is a matter
+   of interpretation. The integer N has the same bit-pattern as the fixed-point
+   real N*(2^-34). In this program, variables are regarded as integers.
+ NB Integers are here compared by subtraction and noting the sign of the result.
+   It's assumed that the subtraction doesn't overflow the accumulator.
+   This will be OK if the absolute values of the integers are less than 2^33.
+ ------------------------------------------------------------------------------]
 [Arrange the storage]
-            T47K P96F  [M parameter: main routine]
-            T55K P128F [V parameter: variables to be sorted]
+          T55K P56F       [V parameter: variables to be sorted]
+          T46K P62F       [N parameter: print subroutine]
+          T47K P120F      [M parameter: main routine]
 
 [Compressed form of library subroutine R2.
  Reads integers at load time and is then overwritten.]
-            GKT20FVDL8FA40DUDTFI40FA40FS39FG@S2FG23FA5@T5@E4@E13Z
-            T#V     [tell R2 where to store integers]
-[EDIT: List of 35-bit integers separated by 'F', list terminated by '#TZ'.]
-987654321F500000000F123456789#TZ
+          E25K TN  [will be overwritten by the following print subroutine]
+          GKT20FVDL8FA40DUDTFI40FA40FS39FG@S2FG23FA5@T5@E4@E13Z
+          T#V      [tell R2 where to store integers]
+[List of 35-bit integers separated by 'F', list terminated by '#TZ'.
+-12 is entered as -12 + 2^35. Uncomment the desired starting order.]
+ [34359738356F0F77444#TZ]
+ [34359738356F77444F0#TZ]
+ [0F34359738356F77444#TZ]
+ [0F77444F34359738356#TZ]
+  77444F34359738356F0#TZ
+ [77444F0F34359738356#TZ]
+
+[Modified version of library subroutine P7.
+ Prints signed integer left-justified. Integer is passed in 0D.]
+  GKA3FT42@A47@T31@ADE10@T31@A46@T31@SDTDH44#@NDYFLDT4DS43@
+  TFH17@S17@A43@G23@UFS43@T1FV4DAFG48@SFLDUFXFOFFFSFL4FT4DA47@
+  T31@A1FA43@G20@XFT44#ZPFT43ZP1024FP610D@524DO26@XFSFL8FT4DE39@
 
 [Main routine]
-            E25K TM GK
-      [0]   A4#V S#V  [accumulator := z - x]
-            E8@       [skip the swap if x <= z]
-            TD        [0D := z - x]
-            A#V U4#V  [z := x]
-            AD        [acc := old z]
-            T#V       [x := old z]
-      [8]   TF        [clear acc]
-            A4#V S2#V [acc := z - y]
-            E17@      [skip the swap if y <= z]
-            TD        [0D := z - y]
-            A2#V U4#V [z := y]
-            AD        [acc := old z]
-            T2#V      [y := old z]
-     [17]   TF        [clear acc]
-            A2#V S#V  [acc := y - x]
-            E26@      [skip the swap if x <= y]
-            TD        [0D := y - x]
-            A#V U2#V  [y := x]
-            AD        [acc := old y]
-            T#V       [x := old y]
-     [26]   ZF        [halt the machine]
-            EZ        [define entry point]
-            PF        [acc = 0 on entry]
+          E25K TM GK
+    [0]   #F              [figures shift]
+    [1]   NF              [comma (in figures mode)]
+    [2]   !F              [space]
+    [3]   @F              [carriage return]
+    [4]   &F              [line feed]
+    [5]   K4096F          [null]
+       [Enter here with accumulator = 0]
+    [6]   A4#V S#V        [acc := z - x]
+          E14@            [skip the swap if x <= z]
+          TD              [0D := z - x]
+          A#V U4#V        [z := x]
+          AD              [acc := old z]
+          T#V             [x := old z]
+   [14]   TF              [clear acc]
+          A4#V S2#V       [acc := z - y]
+          E23@            [skip the swap if y <= z]
+          TD              [0D := z - y]
+          A2#V U4#V       [z := y]
+          AD              [acc := old z]
+          T2#V            [y := old z]
+   [23]   TF              [clear acc]
+          A2#V S#V        [acc := y - x]
+          E32@            [skip the swap if x <= y]
+          TD              [0D := y - x]
+          A#V U2#V        [y := x]
+          AD              [acc := old y]
+          T#V             [x := old y]
+   [32]   TF              [clear acc]
+       [Print variables after sorting]
+          O@              [set teleprinter to figures mode]
+          A#V TD A36@ GN O1@ O2@  [print 1st variable plus comma, space]
+          A2#V TD A42@ GN O1@ O2@ [print 2nd variable plus comma, space]
+          A4#V TD A48@ GN O3@ O4@ [print 3rd variable plus CR, LF]
+          O5@             [print null to flush teleprinter buffer]
+          ZF              [halt the machine]
+          E6Z             [define entry point]
+          PF              [accumulator = 0 on entry]
 [end]
diff --git a/Task/Sorting-algorithms-Merge-sort/OoRexx/sorting-algorithms-merge-sort.rexx b/Task/Sorting-algorithms-Merge-sort/OoRexx/sorting-algorithms-merge-sort.rexx
new file mode 100644
index 0000000000..1d53ca4fa2
--- /dev/null
+++ b/Task/Sorting-algorithms-Merge-sort/OoRexx/sorting-algorithms-merge-sort.rexx
@@ -0,0 +1,56 @@
+/******************************************************************
+* Translated from REXX Version 1a
+* with a little help from a friend:-)
+******************************************************************/
+Call Init
+Call show 'Array:'
+arr=mergeSort(arr)
+Say ''
+Call show 'Sorted:'
+Exit
+mergesort: Procedure
+  Use Arg a
+  If a~items=1 Then Return a
+  mid=a~items%2+1
+  l1=a~section(1,mid-1)
+  l2=a~section(mid)
+  l1 = mergesort( l1 )
+  l2 = mergesort( l2 )
+  Return merge( l1, l2 )
+
+merge: Procedure
+  Use Arg a,b
+  c=.array~new
+  Do while a~items>0 & b~items>0
+    if  a[1] > b[1] Then Do
+       c~append(b[1])
+       b=b~section(2)
+       End
+    Else Do
+       c~append(a[1])
+       a=a~section(2)
+       End
+   end
+   c~appendAll(a)
+   c~appendAll(b)
+   Return c
+
+init:
+  arr=.array~new
+  arr~append('---The seven deadly sins---')
+  arr~append('===========================')
+  arr~append('pride')
+  arr~append('avarice')
+  arr~append('wrath')
+  arr~append('envy')
+  arr~append('gluttony')
+  arr~append('sloth')
+  arr~append('lust')
+  Return
+
+show:
+  Say arg(1)
+  Do elem over arr
+    Say elem
+    End
+  Return
diff --git a/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-1.rexx b/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-1.rexx
index 266d49875a..3b65c4ed6f 100644
--- a/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-1.rexx
+++ b/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-1.rexx
@@ -1,40 +1,48 @@
-/*REXX pgm sorts a stemmed array (numbers and/or chars) using the  merge─sort algorithm.*/
-call init                                        /*sinfully initialize the   @   array. */
-call show      'before sort'                     /*show the   "before"  array elements. */
-                            say copies('▒', 75)  /*display a separator line to the term.*/
-call merge          #                            /*invoke the  merge sort  for the array*/
-call show      ' after sort'                     /*show the    "after"  array elements. */
-exit 0                                           /*stick a fork in it,  we're all done. */
-/*──────────────────────────────────────────────────────────────────────────────────────*/
-init: @.=;    @.1= '---The seven deadly sins---'  ;    @.4= "avarice"  ;   @.7= 'gluttony'
-              @.2= '==========================='  ;    @.5= "wrath"    ;   @.8= 'sloth'
-              @.3= 'pride'                        ;    @.6= "envy"     ;   @.9= 'lust'
-      do #=1  until @.#==''; end;   #= #-1;   return      /*#:  # of entries in @ array.*/
-/*──────────────────────────────────────────────────────────────────────────────────────*/
-show: do j=1  for #; say right('element',20) right(j,length(#)) arg(1)":" @.j; end; return
-/*──────────────────────────────────────────────────────────────────────────────────────*/
-merge: procedure expose @. !.;   parse arg n, L;   if L==''  then do;  !.=;  L= 1;  end
-          if n==1  then return;     h= L + 1
-          if n==2  then do; if @.L>@.h  then do; _=@.h; @.h=@.L; @.L=_; end; return;  end
-          m= n % 2                                     /* [↑]  handle case of two items.*/
-          call merge  n-m, L+m                         /*divide items  to the left   ···*/
-          call merger m,   L,   1                      /*   "     "     "  "  right  ···*/
-          i= 1;                     j= L + m
-                     do k=L  while k word(b,1) Then Do  -- numeric or mixed ascending
+* if  word(a,1) >> word(b,1) Then Do -- string ascending
+* if  word(a,1) < word(b,1) Then Do  -- numeric or mixed descending
+* if  word(a,1) << word(b,1) Then Do -- string descending
+* you may perform the usual sorts.
+***********************************************************************/
+Parse Arg list
+If list='' Then
+  unsortedList ='890 481 272 628 353 513 654 138 474 531'
+Else
+  unsortedList = list
+sortedList = mergeSort(unsortedList)
+say 'list  ='unsortedList
+say 'sorted='space(sortedList)
+Exit
+mergesort: Procedure
+  Parse Arg a
+   if words(a)=1 Then return a
+   mid=words(a)%2+1
+   l1=subword(a,1,mid-1)
+   l2=subword(a,mid)
+      l1 = mergesort( l1 )
+      l2 = mergesort( l2 )
+      return merge( l1, l2 )
+merge: Procedure
+  Parse Arg a,b
+  c=''
+  Do while words(a)>0 & words(b)>0
+    if  word(a,1) > word(b,1) Then Do
+       c=c word(b,1)
+       b=subword(b,2)
+       End
+    Else Do
+       c=c word(a,1)
+       a=subword(a,2)
+       End
+   end
+   c=c a
+   c=c b
+   return c
diff --git a/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-2.rexx b/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-2.rexx
index 954c469b17..1b3594903e 100644
--- a/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-2.rexx
+++ b/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-2.rexx
@@ -1,67 +1,70 @@
-Main:
-call Generate
-call Show
-call Mergesort 1,n
-call Show
-exit
-
-Generate:
-call Random,,12345
-n = 10
-do i = 1 to n
-   stem.i = Random()
-end
-stem.0 = n
-return
-
-Show:
-do i = 1 to n
-   say right(i,2) right(stem.i,3)
-end
-say
-return
-
-Mergesort:
-procedure expose stem. work.
-arg b,e
-if e-b < 1 then
-   return
-if e-b = 1 then do
-   if stem.b > stem.e then do
-      t = stem.b; stem.b = stem.e; stem.e = t
+/***********************************************************************
+* Translating blanks in the array's elements lets me use Version 1
+***********************************************************************/
+Call Init
+unsortedList=''
+Do i=1 To arr.0
+  If pos('00'x,arr.i)>0 Then Do
+    'Sorry, array elements must not contain ''00''x characters'
+    Exit
+    End
+  unsortedList=unsortedList translate(arr.i,'00'x,' ')
+  End
+say 'Array :'
+Call show
+sortedList = mergeSort(unsortedList)
+Do i=1 To arr.0
+  arr.i=translate(word(sortedList,i),' ','00'x)
+  End
+Say ''
+Say 'Sorted:'
+Call show
+Exit
+show:
+  Do i=1 To arr.0
+    Say 'arr.'i'='arr.i
+    End
+  Return
+mergesort: Procedure
+  Parse Arg a
+  If words(a)=1 Then Return a
+  mid=words(a)%2+1
+  l1=subword(a,1,mid-1)
+  l2=subword(a,mid)
+  l1 = mergesort( l1 )
+  l2 = mergesort( l2 )
+  Return merge( l1, l2 )
+merge: Procedure
+  Parse Arg a,b
+  c=''
+  Do while words(a)>0 & words(b)>0
+    If  word(a,1) > word(b,1) Then Do
+       c=c word(b,1)
+       b=subword(b,2)
+       End
+    Else Do
+       c=c word(a,1)
+       a=subword(a,2)
+       End
    end
-   return
-end
-m = (b+e)%2
-call Mergesort b,m
-call Mergesort m+1,e
-call Merger b,m,e
-return
+   c=c a
+   c=c b
+   Return c
 
-Merger:
-procedure expose stem. work.
-arg b,m,e
-i = b; j = m+1; k = b
-do while i <= m | j <= e
-   select
-      when i <= m & j <= e then do
-         if stem.i <= stem.j then do
-            work.k = stem.i; i = i+1
-         end
-         else do
-            work.k = stem.j; j = j+1
-         end
-         k = k+1
-      end
-      when i<=m then do
-         work.k = stem.i; i = i+1; k = k+1
-      end
-      otherwise do
-         work.k = stem.j; j = j+1; k = k+1
-      end
-   end
-end
-do i = b to e
-   stem.i = work.i
-end
-return
+init:
+  arr.=0
+  Call store '---The seven deadly sins---'
+  Call store '==========================='
+  Call store 'pride'
+  Call store 'avarice'
+  Call store 'wrath'
+  Call store 'envy'
+  Call store 'gluttony'
+  Call store 'sloth'
+  Call store 'lust'
+  Return
+store:
+  z=arr.0+1
+  arr.z=arg(1)
+  arr.0=z
+  Return
diff --git a/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-3.rexx b/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-3.rexx
new file mode 100644
index 0000000000..954c469b17
--- /dev/null
+++ b/Task/Sorting-algorithms-Merge-sort/REXX/sorting-algorithms-merge-sort-3.rexx
@@ -0,0 +1,67 @@
+Main:
+call Generate
+call Show
+call Mergesort 1,n
+call Show
+exit
+
+Generate:
+call Random,,12345
+n = 10
+do i = 1 to n
+   stem.i = Random()
+end
+stem.0 = n
+return
+
+Show:
+do i = 1 to n
+   say right(i,2) right(stem.i,3)
+end
+say
+return
+
+Mergesort:
+procedure expose stem. work.
+arg b,e
+if e-b < 1 then
+   return
+if e-b = 1 then do
+   if stem.b > stem.e then do
+      t = stem.b; stem.b = stem.e; stem.e = t
+   end
+   return
+end
+m = (b+e)%2
+call Mergesort b,m
+call Mergesort m+1,e
+call Merger b,m,e
+return
+
+Merger:
+procedure expose stem. work.
+arg b,m,e
+i = b; j = m+1; k = b
+do while i <= m | j <= e
+   select
+      when i <= m & j <= e then do
+         if stem.i <= stem.j then do
+            work.k = stem.i; i = i+1
+         end
+         else do
+            work.k = stem.j; j = j+1
+         end
+         k = k+1
+      end
+      when i<=m then do
+         work.k = stem.i; i = i+1; k = k+1
+      end
+      otherwise do
+         work.k = stem.j; j = j+1; k = k+1
+      end
+   end
+end
+do i = b to e
+   stem.i = work.i
+end
+return
diff --git a/Task/Sorting-algorithms-Merge-sort/ZED/sorting-algorithms-merge-sort.zed b/Task/Sorting-algorithms-Merge-sort/ZED/sorting-algorithms-merge-sort.zed
index ef24e8c56b..a4dd852c14 100644
--- a/Task/Sorting-algorithms-Merge-sort/ZED/sorting-algorithms-merge-sort.zed
+++ b/Task/Sorting-algorithms-Merge-sort/ZED/sorting-algorithms-merge-sort.zed
@@ -1,86 +1,107 @@
 (append) list1 list2
-comment:
+=========
 #true
 (003) "append" list1 list2
 
 (car) pair
-comment:
+=========
 #true
 (002) "car" pair
 
+(cadr) pair
+=========
+#true
+(002) "cadr" pair
+
 (cdr) pair
-comment:
+=========
 #true
 (002) "cdr" pair
 
+(cddr) pair
+=========
+#true
+(002) "cddr" pair
+
 (cons) one two
-comment:
+=========
 #true
 (003) "cons" one two
 
+(list1a) item
+=========
+#true
+(002) "list" item
+
 (map) function list
-comment:
+=========
 #true
 (003) "map" function list
 
 (merge) comparator list1 list2
-comment:
+CONTINUE WITH COLLECT ARGUMENT
 #true
-(merge1) comparator list1 list2 nil
+(merge01) comparator list1 list2 nil
 
-(merge1) comparator list1 list2 collect
-comment:
+(merge01) comparator list1 list2 collect
+LIST2 EXHAUSTED -> MERGED
 (null?) list2
 (append) (reverse) collect list1
 
-(merge1) comparator list1 list2 collect
-comment:
+(merge01) comparator list1 list2 collect
+LIST1 EXHAUSTED -> MERGED
 (null?) list1
 (append) (reverse) collect list2
 
-(merge1) comparator list1 list2 collect
-comment:
+(merge01) comparator list1 list2 collect
+TAKE FROM LIST2 (HANDLES ONE CASE)
 (003) comparator (car) list2 (car) list1
-(merge1) comparator list1 (cdr) list2 (cons) (car) list2 collect
+(merge01) comparator
+  list1
+  (cdr) list2
+  (cons) (car) list2 collect
 
-(merge1) comparator list1 list2 collect
-comment:
+(merge01) comparator list1 list2 collect
+TAKE FROM LIST1 (HANDLES TWO CASES)
 #true
-(merge1) comparator (cdr) list1 list2 (cons) (car) list1 collect
+(merge01) comparator
+  (cdr) list1
+  list2
+  (cons) (car) list1 collect
 
 (null?) value
-comment:
+=========
 #true
 (002) "null?" value
 
 (reverse) list
-comment:
+=========
 #true
 (002) "reverse" list
 
 (sort) comparator jumble
-comment:
+PREPARE JUMBLE AND PERFORM MERGE PASSES -> EXTRACT
 #true
-(car) (sort11) comparator (sort1) jumble
+(car) (sort02) comparator (sort01) jumble
 
-(sort1) jumble
-comment:
+(sort01) jumble
+PREPARED JUMBLE
 #true
-(map) "list" jumble
+(map) list1a jumble
 
-(sort11) comparator jumble
-comment:
+(sort02) comparator jumble
+WHEN ZERO LISTS THEN NIL
 (null?) jumble
 nil
 
-(sort11) comparator jumble
-comment:
+(sort02) comparator jumble
+WHEN ONE LIST THEN ALREADY SORTED
 (null?) (cdr) jumble
 jumble
 
-(sort11) comparator jumble
-comment:
+(sort02) comparator jumble
+REPEATEDLY MERGE ALONG LENGTH
 #true
-(sort11) comparator
-         (cons) (merge) comparator (car) jumble (002) "cadr" jumble
-                (sort11) comparator (002) "cddr" jumble
+(sort02) comparator
+  (cons) (merge) comparator (car) jumble (cadr) jumble
+    (sort02) comparator (cddr) jumble
diff --git a/Task/Sorting-algorithms-Pancake-sort/Forth/sorting-algorithms-pancake-sort.fth b/Task/Sorting-algorithms-Pancake-sort/Forth/sorting-algorithms-pancake-sort.fth
new file mode 100644
index 0000000000..35ab48a346
--- /dev/null
+++ b/Task/Sorting-algorithms-Pancake-sort/Forth/sorting-algorithms-pancake-sort.fth
@@ -0,0 +1,56 @@
+\ swap the values stored at two memory locations
+: exchange ( addr1 addr2 -- )
+  2dup @ >r @ swap ! r> swap ! ;
+
+\ reverse an array of cells in place
+: reverse ( addr u -- )
+  1- cells over +
+  begin
+    2dup <
+  while
+    2dup exchange
+    swap cell+ swap
+    1 cells -
+  repeat 2drop ;
+
+\ index of the largest value in an array of cells
+: max-index ( addr u -- u )
+  0 -rot 0 ?do
+    2dup swap cells + @
+    over i cells + @
+    < if nip i swap then
+  loop drop ;
+
+\ sorts an array of cells in place
+: pancake-sort ( addr u -- )
+  begin
+    dup 1 >
+  while
+    2dup max-index 1+
+    2dup <> if
+      dup 1 > if
+        >r over r> reverse
+      else
+        drop
+      then
+      2dup reverse
+    else
+      drop
+    then
+    1-
+  repeat 2drop ;
+
+\ print an array of cells
+: print-array ( addr u -- )
+  ." [" 0 ?do
+    i 0> if ." , " then
+    dup i cells + @ 1 .r
+  loop drop ." ]" ;
+
+create test-array 6 , 7 , 2 , 1 , 8 , 9 , 5 , 3 , 4 ,
+." Before sorting: "
+test-array 9 print-array cr
+test-array 9 pancake-sort
+." After sorting: "
+test-array 9 print-array cr
+bye
diff --git a/Task/Sorting-algorithms-Quicksort/Quackery/sorting-algorithms-quicksort.quackery b/Task/Sorting-algorithms-Quicksort/Quackery/sorting-algorithms-quicksort.quackery
index 4155c0f3c8..20e2c83133 100644
--- a/Task/Sorting-algorithms-Quicksort/Quackery/sorting-algorithms-quicksort.quackery
+++ b/Task/Sorting-algorithms-Quicksort/Quackery/sorting-algorithms-quicksort.quackery
@@ -6,8 +6,6 @@
 
 [ - -1 1 clamp 1+ ]            is <=>       ( n n --> n )
 
-[ tuck take join swap put ]    is append    ( x s -->   )
-
 [ dup size 2 < if done
   [] less put
   [] same put
@@ -15,8 +13,8 @@
   behead swap witheach
     [ 2dup swap <=>
       [ table less same more ]
-      append ]
-  same append
+      gather ]
+  same gather
   less take recurse
   same take join
   more take recurse join ]     is quicksort (   [ --> [ )
diff --git a/Task/Sorting-algorithms-Radix-sort/Fortran/sorting-algorithms-radix-sort.f b/Task/Sorting-algorithms-Radix-sort/Fortran/sorting-algorithms-radix-sort.f
index 85bdd73c2b..1cf519a11e 100644
--- a/Task/Sorting-algorithms-Radix-sort/Fortran/sorting-algorithms-radix-sort.f
+++ b/Task/Sorting-algorithms-Radix-sort/Fortran/sorting-algorithms-radix-sort.f
@@ -294,161 +294,115 @@
 !***************************************************************************
 !                            End of Superfast LSD sort
 !***************************************************************************
-*=======================================================================
-* RSORT - sort a list of integers by the Radix Sort algorithm
-* Public domain.  This program may be used by any person for any purpose.
-* Origin:  Herman Hollerith, 1887
-*
-*___Name____Type______In/Out____Description_____________________________
-*   IX(N)   Integer   Both      Array to be sorted in increasing order
-*   IW(N)   Integer   Neither   Workspace
-*   N       Integer   In        Length of array
-*
-* ASSUMPTIONS:  Bits in an INTEGER is an even number.
-*               Integers are represented by twos complement.
-*
-* NOTE THAT:  Radix sorting has an advantage when the input is known
-*             to be less than some value, so that only a few bits need
-*             to be compared.  This routine looks at all the bits,
-*             and is thus slower than Quicksort.
-*=======================================================================
-      SUBROUTINE RSORT (IX, IW, N)
-       IMPLICIT NONE
-       INTEGER IX, IW, N
-       DIMENSION IX(N), IW(N)
+!
+! Performs a MSD radi sort using bits.
+! It sorts only using the bit size of the largest and smallest numbers
+! So, on small numbers < 128, it's faster than a Quicksort for very large numbers > 20 bits
+! It's slower.
+! Author: Peter Kelly
+! No claim is made on the code and no warranty implied.
+module msd_bit_sort_module
+    implicit none
+    private
+    public :: msd_bit_sort
 
-       INTEGER I,                        ! count bits
-     $         ILIM,                     ! bits in an integer
-     $         J,                        ! count array elements
-     $         P1OLD, P0OLD, P1, P0,     ! indices to ones and zeros
-     $         SWAP
-       LOGICAL ODD                       ! even or odd bit position
+contains
+    ! Transform signed integer to make it comparable
+    PURE FUNCTION transform_for_sort(x) RESULT(transformed)
+        INTEGER, INTENT(IN) :: x
+        INTEGER :: transformed
 
-*      IF (N < 2) RETURN      ! validate
-*
-        ILIM = Bit_size(i)    !Get the fixed number of bits
-*=======================================================================
-* Alternate between putting data into IW and into IX
-*=======================================================================
-       P1 = N+1
-       P0 = N                ! read from 1, N on first pass thru
-       ODD = .FALSE.
-       DO I = 0, ILIM-2
-         P1OLD = P1
-         P0OLD = P0         ! save the value from previous bit
-         P1 = N+1
-         P0 = 0                 ! start a fresh count for next bit
-
-         IF (ODD) THEN
-           DO J = 1, P0OLD, +1             ! copy data from the zeros
-             IF ( BTEST(IW(J), I) ) THEN
-               P1 = P1 - 1
-               IX(P1) = IW(J)
-             ELSE
-               P0 = P0 + 1
-               IX(P0) = IW(J)
-             END IF
-           END DO
-           DO J = N, P1OLD, -1             ! copy data from the ones
-             IF ( BTEST(IW(J), I) ) THEN
-               P1 = P1 - 1
-               IX(P1) = IW(J)
-             ELSE
-               P0 = P0 + 1
-              IX(P0) = IW(J)
-             END IF
-           END DO
-
-         ELSE
-           DO J = 1, P0OLD, +1             ! copy data from the zeros
-             IF ( BTEST(IX(J), I) ) THEN
-               P1 = P1 - 1
-               IW(P1) = IX(J)
-              ELSE
-               P0 = P0 + 1
-               IW(P0) = IX(J)
-             END IF
-           END DO
-           DO J = N, P1OLD, -1            ! copy data from the ones
-             IF ( BTEST(IX(J), I) ) THEN
-               P1 = P1 - 1
-               IW(P1) = IX(J)
-             ELSE
-               P0 = P0 + 1
-               IW(P0) = IX(J)
-             END IF
-          END DO
-         END IF  ! even or odd i
-
-         ODD = .NOT. ODD
-       END DO  ! next i
-
-*=======================================================================
-*        the sign bit
-*=======================================================================
-       P1OLD = P1
-       P0OLD = P0
-       P1 = N+1
-       P0 = 0
-
-*          if sign bit is set, send to the zero end
-       DO J = 1, P0OLD, +1
-         IF ( BTEST(IW(J), ILIM-1) ) THEN
-           P0 = P0 + 1
-           IX(P0) = IW(J)
-         ELSE
-           P1 = P1 - 1
-           IX(P1) = IW(J)
-         END IF
-       END DO
-       DO J = N, P1OLD, -1
-         IF ( BTEST(IW(J), ILIM-1) ) THEN
-           P0 = P0 + 1
-           IX(P0) = IW(J)
-         ELSE
-           P1 = P1 - 1
-           IX(P1) = IW(J)
-         END IF
-       END DO
-
-*=======================================================================
-*       Reverse the order of the greater value partition
-*=======================================================================
-       P1OLD = P1
-       DO J = N, (P1OLD+N)/2+1, -1
-         SWAP = IX(J)
-         IX(J) = IX(P1)
-         IX(P1) = SWAP
-         P1 = P1 + 1
-       END DO
-       RETURN
-      END ! of RSORT
+        ! XOR with sign bit to make negative numbers sortable
+        ! This inverts the bit representation for negative numbers
+        transformed = IEOR(x, ISHFT(-1, BIT_SIZE(x)-1))
+    END FUNCTION transform_for_sort
 
 
-***********************************************************************
-*         test program
-***********************************************************************
-      PROGRAM t_sort
-       IMPLICIT NONE
-       INTEGER I, N
-       PARAMETER (N = 11)
-       INTEGER IX(N), IW(N)
-       LOGICAL OK
+    RECURSIVE SUBROUTINE msd_bit_sort_internal(arr, left, right, bit)
+        INTEGER, INTENT(INOUT) :: arr(:)
+        INTEGER, INTENT(IN) :: left, right, bit
+        INTEGER :: i, j, temp
+        INTEGER :: transformed_i, transformed_j
 
-       DATA IX / 2, 24, 45, 0, 66, 75, 170, -802, -90, 1066, 666 /
+        ! Base case
+        IF (left >= right .OR. bit < 0) RETURN
 
-       PRINT *, 'before: ', IX
-       CALL RSORT (IX, IW, N)
-       PRINT *, 'after: ', IX
+        i = left
+        j = right
 
-*              compare
-       OK = .TRUE.
-       DO I = 1, N-1
-         IF (IX(I) > IX(I+1)) OK = .FALSE.
-       END DO
-       IF (OK) THEN
-         PRINT *, 't_sort: successful test'
-       ELSE
-         PRINT *, 't_sort: failure!'
-       END IF
-      END ! of test program
+        DO WHILE (i <= j)
+            ! Find elements to swap
+            DO WHILE (i <= j)
+                transformed_i = transform_for_sort(arr(i))
+                transformed_j = transform_for_sort(arr(j))
+
+                ! Partition based on transformed values
+                IF (BTEST(transformed_i, bit) .AND. .NOT. BTEST(transformed_j, bit)) THEN
+                    ! Swap needed
+                    temp = arr(i)
+                    arr(i) = arr(j)
+                    arr(j) = temp
+                    EXIT
+                END IF
+
+                ! Move pointers
+                IF (.NOT. BTEST(transformed_i, bit)) i = i + 1
+                IF (BTEST(transformed_j, bit)) j = j - 1
+            END DO
+
+            ! Adjust pointers
+            IF (i < j) THEN
+                i = i + 1
+                j = j - 1
+            END IF
+        END DO
+
+        ! Recursively sort sub-arrays
+        IF (left < j) THEN
+            CALL msd_bit_sort_internal(arr, left, j, bit-1)
+        END IF
+        IF (i < right) THEN
+            CALL msd_bit_sort_internal(arr, i, right, bit-1)
+        END IF
+    END SUBROUTINE msd_bit_sort_internal
+
+    SUBROUTINE msd_bit_sort(arr)
+        INTEGER, INTENT(INOUT) :: arr(:)
+        INTEGER :: max_bit, n, mini, maxi
+
+        n = SIZE(arr)
+        IF (n < 2) RETURN
+
+        ! Find most significant bit
+        mini = MINVAL(arr)
+        maxi = MAXVAL(arr)
+        max_bit = MAX(BIT_SIZE(arr(1)) - LEADZ(IEOR(mini, maxi)) - 1, 0)
+
+        ! Perform the recursive bit sort
+        CALL msd_bit_sort_internal(arr, 1, n, max_bit)
+    END SUBROUTINE msd_bit_sort
+    end module msd_bit_sort_module
+!
+    program bit_sort_test_harness
+    use msd_bit_sort_module
+    implicit none
+
+    INTEGER, PARAMETER :: ARRAY_SIZE = 2**23
+    INTEGER :: test_array(ARRAY_SIZE)
+    real :: holder(ARRAY_SIZE)
+    INTEGER :: xx,yy,rate
+    call random_number(holder)
+    holder = holder -0.33333
+    test_array = int(holder*1000000.0)
+    ! Initialize with some test values
+
+    PRINT *, "Original Array:"
+    PRINT *, test_array(1:10)
+    call system_clock(count=xx,count_rate=rate)
+    CALL msd_bit_sort(test_array)
+    call system_clock(count=yy)
+    print*,'sort time = ',(real(yy-xx)/rate)
+    PRINT *, "Sorted Array:"
+    PRINT *, test_array(1:5),test_array(array_size-5:)
+
+end program bit_sort_test_harness
diff --git a/Task/Sorting-algorithms-Radix-sort/FreeBASIC/sorting-algorithms-radix-sort.basic b/Task/Sorting-algorithms-Radix-sort/FreeBASIC/sorting-algorithms-radix-sort.basic
new file mode 100644
index 0000000000..5757cb4bb4
--- /dev/null
+++ b/Task/Sorting-algorithms-Radix-sort/FreeBASIC/sorting-algorithms-radix-sort.basic
@@ -0,0 +1,93 @@
+Sub countSort(rs() As Long, expo As Long)
+    Dim As Long lb = Lbound(rs), ub = Ubound(rs)
+    Dim As Long i, t
+    Dim As Long salida(lb To ub), conteo(0 To 9)
+
+    For i = lb To ub
+        t = (rs(i) \ expo) Mod 10
+        conteo(t) += 1
+    Next
+
+    For i = 1 To 9
+        conteo(i) += conteo(i-1)
+    Next
+
+    For i = ub To lb Step -1
+        t = (rs(i) \ expo) Mod 10
+        salida(lb + conteo(t) - 1) = rs(i)
+        conteo(t) -= 1
+    Next
+
+    For i = lb To ub
+        rs(i) = salida(i)
+    Next
+End Sub
+
+Sub radixSort(rs() As Long)
+    Dim As Long lb = Lbound(rs), ub = Ubound(rs)
+
+    ' Find minimum value
+    Dim As Long i, minVal = rs(lb)
+    For i = lb + 1 To ub
+        If rs(i) < minVal Then minVal = rs(i)
+    Next
+
+    ' If negative numbers exist, shift array to positive
+    If minVal < 0 Then
+        For i = lb To ub
+            rs(i) -= minVal
+        Next
+    End If
+
+    ' Find maximum value
+    Dim As Long maxVal = rs(lb)
+    For i = lb + 1 To ub
+        If rs(i) > maxVal Then maxVal = rs(i)
+    Next
+
+    ' Do counting sort for every digit
+    Dim As Long expo = 1
+    While (maxVal \ expo) > 0
+        countSort(rs(), expo)
+        expo *= 10
+    Wend
+
+    ' If we shifted for negatives, shift back
+    If minVal < 0 Then
+        For i = lb To ub
+            rs(i) += minVal
+        Next
+    End If
+End Sub
+
+Sub printArray(rs() As Long)
+    Dim As Long lb = Lbound(rs), ub = Ubound(rs)
+    Print "[ ";
+    For i As Long = lb To ub
+        Print rs(i);
+        If i < ub Then Print ", ";
+    Next
+    Print " ]"
+End Sub
+
+'--- Main Program ---
+Dim As Long i, array(-7 To 7)
+Dim As Long a = Lbound(array), b = Ubound(array)
+
+Randomize Timer
+For i = a To b : array(i) = i : Next i
+
+For i = a To b ' little shuffle
+    Swap array(i), array(Int(Rnd * (b - a + 1)) + a)
+Next i
+
+Print "unsort ";
+For i = a To b : Print Using "####"; array(i); : Next i
+
+radixSort(array())  ' sort the array
+
+Print !"\n  sort ";
+For i = a To b : Print Using "####"; array(i); : Next i
+Print
+
+Sleep
diff --git a/Task/Sorting-algorithms-Shell-sort/Free-Pascal-Lazarus/sorting-algorithms-shell-sort.pas b/Task/Sorting-algorithms-Shell-sort/Free-Pascal-Lazarus/sorting-algorithms-shell-sort.pas
new file mode 100644
index 0000000000..3508fc9b27
--- /dev/null
+++ b/Task/Sorting-algorithms-Shell-sort/Free-Pascal-Lazarus/sorting-algorithms-shell-sort.pas
@@ -0,0 +1,25 @@
+procedure ShellSort(var a: array of extended);
+var
+  i, j, h, n: integer;
+  v: extended;
+begin
+  n := length(a);
+  h := 1;
+  repeat
+    h := 3 * h + 1
+  until h > n;
+  repeat
+    h := h div 3;
+    for i := h to n - 1 do
+    begin
+      v := a[i];
+      j := i;
+      while (j >= h) and (a[j - h] > v) do
+      begin
+        a[j] := a[j - h];
+        j := j - h;
+      end;
+      a[j] := v;
+    end
+  until h = 1;
+end;
diff --git a/Task/Sorting-algorithms-Shell-sort/Object-Pascal/sorting-algorithms-shell-sort.pas b/Task/Sorting-algorithms-Shell-sort/Object-Pascal/sorting-algorithms-shell-sort.pas
new file mode 100644
index 0000000000..6e675ed5f2
--- /dev/null
+++ b/Task/Sorting-algorithms-Shell-sort/Object-Pascal/sorting-algorithms-shell-sort.pas
@@ -0,0 +1,29 @@
+procedure ShellSort(var a: array of extended);
+  { Sorts a vector of arbitrary length }
+  { Requirement: Support for open arrays by Object Pascal compiler }
+  { otherwise please use the algorithm for Pascal, which is less flexible, }
+  { but also supported by Object Pascal }
+var
+  i, j, h, n: integer;
+  v: extended;
+begin
+  n := length(a);
+  h := 1;
+  repeat
+    h := 3 * h + 1
+  until h > n;
+  repeat
+    h := h div 3;
+    for i := h to n - 1 do
+    begin
+      v := a[i];
+      j := i;
+      while (j >= h) and (a[j - h] > v) do
+      begin
+        a[j] := a[j - h];
+        j := j - h;
+      end;
+      a[j] := v;
+    end
+  until h = 1;
+end;
diff --git a/Task/Special-characters/Ring/special-characters.ring b/Task/Special-characters/Ring/special-characters.ring
new file mode 100644
index 0000000000..ed87b635df
--- /dev/null
+++ b/Task/Special-characters/Ring/special-characters.ring
@@ -0,0 +1,9 @@
+load "stdlib.ring"
+
+see "Special characters in Ring:" + nl
+for n = 1 to 255
+    ch = char(n)
+    if isSpecial(ch)
+       see ch + nl
+    ok
+next
diff --git a/Task/Spelling-of-ordinal-numbers/Arturo/spelling-of-ordinal-numbers.arturo b/Task/Spelling-of-ordinal-numbers/Arturo/spelling-of-ordinal-numbers.arturo
new file mode 100644
index 0000000000..d04f2259d6
--- /dev/null
+++ b/Task/Spelling-of-ordinal-numbers/Arturo/spelling-of-ordinal-numbers.arturo
@@ -0,0 +1,71 @@
+small: [
+    "zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten"
+    "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
+    "eighteen" "nineteen"
+]
+
+tens: [
+    "wrong" "wrong" "twenty" "thirty" "forty"
+    "fifty" "sixty" "seventy" "eighty" "ninety"
+]
+
+prefixes: ["m" "b" "tr" "quadr" "quint" "sext" "sept" "oct" "non" "dec"]
+big: ["" "thousand"] ++ map prefixes 'p -> p ++ "illion"
+
+getOrdinal: function [numstr][
+    return when.has:numstr [
+        [|suffix? "one"] -> replace numstr {/one$/} {first}
+        [|suffix? "two"] -> replace numstr {/two$/} {second}
+        [|suffix? "three"] -> replace numstr {/three$/} {third}
+        [|suffix? "four"] -> replace numstr {/four$/} {forth}
+        [|suffix? "five"] -> replace numstr {/five$/} {fifth}
+        [|suffix? "y"] -> replace numstr {/y$/} {ieth}
+        true -> numstr ++ "th"
+    ]
+]
+
+wordify: function [number :integer][
+    if number < 0 ->
+        return "negative " ++ neg number
+
+    if number < 20 ->
+        return small\[number]
+
+    if number < 100 [
+        [d m]: divmod number 10
+        return tens\[d] ++ (zero? m)? -> "" -> "-" ++ wordify m
+    ]
+
+    if number < 1000 [
+        [d m]: divmod number 100
+        return (~{|small\[d]| hundred}) ++ (zero? m)? -> "" -> " and " ++ wordify m
+    ]
+
+    chunks: []
+    n: number
+    while [not? zero? n][
+        [n remainder]: divmod n 1000
+        'chunks ++ remainder
+    ]
+
+    if (size chunks) > size big ->
+        return "integer value too large"
+
+    words: []
+    loop.with:'i chunks 'ch [
+        scale: big\[i]
+        unless zero? ch [
+            chunkStr: wordify ch
+            'words ++ (empty? scale)? -> chunkStr
+                                      -> ~"|chunkStr| |scale|"
+        ]
+    ]
+
+    return join.with:", " reverse words
+]
+
+loop @[
+    0,1,4,5,10,15,18,25,83,140,300,678,1024,
+    45039,123456,91740274651983
+] 'num ->
+    print [pad to :string num 15, join.with: "\n"++ (repeat " " 16) split.lines wordwrap.at: 40 getOrdinal wordify num]
diff --git a/Task/Spiral-matrix/FutureBasic/spiral-matrix.basic b/Task/Spiral-matrix/FutureBasic/spiral-matrix.basic
new file mode 100644
index 0000000000..db594ba86b
--- /dev/null
+++ b/Task/Spiral-matrix/FutureBasic/spiral-matrix.basic
@@ -0,0 +1,41 @@
+void local fn SpiralMatrix( size as int )
+  int t = 0, b = size - 1, l = 0, r = size - 1
+  int value = 0, i, j
+
+  while ( t <= b && l <= r) {
+    for i = l to r
+      mda(t,i) = value++
+    next
+    t++
+
+    for i = t to b
+      mda(i,r) = value++
+    next
+    r--
+
+    if ( t <= b )
+      for i = r to l step -1
+        mda(b,i) = value++
+      next
+      b--
+    end if
+
+    if ( l <= r )
+      for i = b to t step -1
+        mda(i,l) = value++
+      next
+      l++
+    end if
+  wend
+
+  for i = 0 to size -1
+    for j = 0 to size - 1
+      printf @"%2d \b",mda_integer(i,j)
+    next
+    print
+  next
+end fn
+
+fn SpiralMatrix( 5 )
+
+HandleEvents
diff --git a/Task/Square-free-integers/ALGOL-60/square-free-integers.alg b/Task/Square-free-integers/ALGOL-60/square-free-integers.alg
new file mode 100644
index 0000000000..ff8477f7ca
--- /dev/null
+++ b/Task/Square-free-integers/ALGOL-60/square-free-integers.alg
@@ -0,0 +1,60 @@
+begin
+
+comment - return n mod m;
+integer procedure mod(n, m);
+   value n, m; integer n, m;
+begin
+  mod := n - entier(n/m) * m;
+end;
+
+comment - return true if n has no square divisors other than 1;
+boolean procedure sqfree(n);
+  value n; integer n;
+begin
+  integer i, sq;
+  boolean sqf;
+  comment - quick exit for most common square;
+  if mod(n,4) = 0 then sqf := false else sqf := true;
+  i := 3;
+  for sq := i * i while (sq <= n) and sqf do
+    begin
+      if mod(n, sq) = 0 then sqf := false;
+      i := i + 2;
+    end;
+  sqfree := sqf;
+end;
+
+comment - report number of square-free integers up to limit;
+procedure report(limit);
+  value limit; integer limit;
+begin
+  integer i, count;;
+  outstring(1,"Square-free integers up to");
+  outinteger(1,limit);
+  outstring(1,": ");
+  count := 0;
+  for i := 1 step 1 until limit do
+    if sqfree(i) then count := count + 1;
+  outinteger(1,count);
+  outstring(1,"\n");
+end;
+
+integer i, count;
+count := 0;
+outstring(1,"Square free integers up to 145:\n");
+for i := 1 step 1 until 145 do
+  if sqfree(i) then
+    begin
+      outinteger(1,i);
+      count := count + 1;
+      if mod(count, 10) = 0 then outstring(1,"\n");
+    end;
+outinteger(1,count);
+outstring(1," were found\n");
+
+report(100);
+report(1000);
+report(10000);
+report(100000);
+
+end
diff --git a/Task/Square-free-integers/ALGOL-W/square-free-integers.alg b/Task/Square-free-integers/ALGOL-W/square-free-integers.alg
new file mode 100644
index 0000000000..692a734ade
--- /dev/null
+++ b/Task/Square-free-integers/ALGOL-W/square-free-integers.alg
@@ -0,0 +1,117 @@
+begin
+    % count/show some square free numbers                                           %
+    % a number is square free if not divisible by any square and so not divisible   %
+    % by any squared prime                                                          %
+    % to satisfy the task we need to know the primes up to root 1 000 000 000 145   %
+    % and the square free numbers up to 1 000 000                                   %
+    long real oneTrillion;
+    integer   primeMax, sfMax;
+    oneTrillion := 1'6 * 1'6;
+    primeMax    := entier( longsqrt( oneTrillion + 145 ) ) + 1;
+    sfMax       := 1000000;
+    begin
+        logical array prime     ( 1 :: primeMax );
+        logical array squareFree( 1 :: sfMax    );
+
+        % returns true if n is square free, false otherwise                         %
+        %         n is long real to allow for values up to 2^53                     %
+        %         the values of n must be non-negative integers <= 2^53             %
+        logical procedure isSquareFree ( long real value n ) ;
+                if n <= sfMax then squareFree( entier( n ) )
+                else begin % n is larger than the sieve - use trial division        %
+                    integer maxFactor, f;
+                    logical isSF;
+                    maxFactor := entier( longsqrt( n ) ) + 1;
+                    isSF      := true;
+                    f         := 1;
+                    while begin f := f + 1;
+                                f <= maxFactor and isSF
+                          end
+                    do    begin
+                              if prime( f ) then begin
+                                  long real nOverFF, n10, p10;
+                                  nOverFF := n / ( f * f );
+                                  % as we are using long real to handle integers    %
+                                  % larger than 2^32, we can't use rem              %
+                                  % instead we subtract powers of ten from nOverFF  %
+                                  % until nOverFF is < 1, if it is 0 then f * f     %
+                                  % exactly divides n...                            %
+                                  p10 :=  1;
+                                  n10 := 10;
+                                  while n10 < nOverFF do begin
+                                      p10 := n10;
+                                      n10 := n10 * 10
+                                  end while_n10_lt_nOverFF ;
+                                  while p10 >= 1 do begin
+                                      while nOverFF >= p10 do nOverFF := nOverFF - p10;
+                                      p10 := p10 / 10
+                                  end while_p10_ge_1 ;
+                                  isSF    := nOverFF not = 0
+                              end if_isPrime__f
+                    end while_isSf ;
+                    isSF
+                end isSquareFree ;
+        % returns the count of squareFree numbers between m and n (inclusive)      %
+        integer procedure countSquareFree ( integer value m, n ) ;
+                begin
+                    integer count;
+                    count := 0;
+                    for i := m until n do if squareFree( i ) then count := count + 1;
+                    count
+                end countSquareFree ;
+
+        % sieve the primes                                                          %
+        for i := 1 until primeMax do prime( i ) := true;
+        for i := 1 until sfMax    do squareFree( i ) := true;
+        for s := 2 until entier( sqrt( primeMax ) ) do begin
+            if prime( s ) then begin
+                for p := s * s step s until primeMax do prime( p ) := false
+            end if_prime__s
+        end for_s ;
+        % sieve the square free integers                                            %
+        for s := 2 until entier( sqrt( sfMax ) ) do begin
+            if prime( s ) then begin
+                integer q;
+                q := s * s;
+                for p := q step q until sfMax do squareFree( p ) := false
+            end if_prime__s
+        end for_s ;
+
+        begin % task requirements                                                   %
+            integer count, sf100, sf1000, sf10000, sf100000, sf1000000;
+            % show square free numbers from 1 -> 145                                %
+            write( "Square free numbers from 1 to 145:" );write();
+            count := 0;
+            for i := 1 until 145 do begin
+                if isSquareFree( i ) then begin
+                    writeon( i_w := 4, s_w := 0, i );
+                    count := count + 1;
+                    if count rem 20 = 0 then write()
+                end if_isSquareFree__i
+            end for_i ;
+            write();
+            % show square free numbers from 1 trillion -> one trillion + 145        %
+            write( "Square free numbers from 1 000 000 000 000 to 1 000 000 000 145:" );write();
+            count := 0;
+            for i := 0 until 145 do begin
+                if isSquareFree( oneTrillion + i ) then begin
+                    writeon( r_format := "A", r_w := 14, r_d := 0, oneTrillion + i );
+                    count := count + 1;
+                    if count rem 5 = 0 then write()
+                end if_isSquareFree__oneTrillion_plus_i
+            end for_i ;
+            write();
+            % show counts of square free numbers                                    %
+            sf100     :=            countSquareFree(      1,     100 );
+            sf1000    := sf100    + countSquareFree(    101,    1000 );
+            sf10000   := sf1000   + countSquareFree(   1001,   10000 );
+            sf100000  := sf10000  + countSquareFree(  10001,  100000 );
+            sf1000000 := sf100000 + countSquareFree( 100001, 1000000 );
+            write( i_w := 6, s_w := 0, "square free numbers between 1 and     100: ", sf100     );
+            write( i_w := 6, s_w := 0, "square free numbers between 1 and    1000: ", sf1000    );
+            write( i_w := 6, s_w := 0, "square free numbers between 1 and   10000: ", sf10000   );
+            write( i_w := 6, s_w := 0, "square free numbers between 1 and  100000: ", sf100000  );
+            write( i_w := 6, s_w := 0, "square free numbers between 1 and 1000000: ", sf1000000 )
+        end
+    end
+end.
diff --git a/Task/Square-free-integers/EasyLang/square-free-integers.easy b/Task/Square-free-integers/EasyLang/square-free-integers.easy
new file mode 100644
index 0000000000..72647835ea
--- /dev/null
+++ b/Task/Square-free-integers/EasyLang/square-free-integers.easy
@@ -0,0 +1,27 @@
+fastfunc square_free n .
+   root = 2
+   while root <= sqrt n
+      if n mod (root * root) = 0 : return 0
+      root += 1
+   .
+   return 1
+.
+proc run lo hi show . .
+   print "From " & lo & " to " & hi & ":"
+   for i = lo to hi
+      if square_free i = 1
+         cnt += 1
+         if show = 1 : write i & " "
+      .
+   .
+   if show = 0 : write cnt & " numbers"
+   print ""
+   print ""
+.
+run 1 145 1
+run 1000000000000 1000000000145 1
+run 1 100 0
+run 1 1000 0
+run 1 10000 0
+run 1 100000 0
+run 1 1000000 0
diff --git a/Task/Square-free-integers/Forth/square-free-integers.fth b/Task/Square-free-integers/Forth/square-free-integers.fth
index dc42a00c9c..4c52193f05 100644
--- a/Task/Square-free-integers/Forth/square-free-integers.fth
+++ b/Task/Square-free-integers/Forth/square-free-integers.fth
@@ -4,17 +4,12 @@
   begin
     2dup dup * >=
   while
-    0 >r
-    begin
-      2dup mod 0=
-    while
-      r> 1+ dup 1 > if
-        2drop drop false exit
-      then
-      >r
+    2dup mod 0= if
       tuck / swap
-    repeat
-    rdrop
+      2dup mod 0= if
+        2drop false exit
+      then
+    then
     2 +
   repeat
   2drop true ;
diff --git a/Task/Square-free-integers/PL-I-80/square-free-integers.pli b/Task/Square-free-integers/PL-I-80/square-free-integers.pli
new file mode 100644
index 0000000000..d58642d4b3
--- /dev/null
+++ b/Task/Square-free-integers/PL-I-80/square-free-integers.pli
@@ -0,0 +1,53 @@
+SquareFreeDemo: proc options (main);
+
+    %replace
+       false by '0'b,
+       true by '1'b;
+
+    dcl (i, found) fixed bin;
+
+    put skip list ('Square-free integers from 1 to 145');
+    put skip;
+    found = 0;
+    do i = 1 to 145;
+        if (square_free(i)) then
+            do;
+                put edit (i) (f(4));
+                found = found + 1;
+		if (mod(found, 16) = 0) then put skip;
+            end;
+    end;
+    put skip edit (found, ' were found') (f(3), a);
+
+    call report_number_found(100);
+    call report_number_found(1000);
+    call report_number_found(10000);
+
+    stop;
+
+/* report number of square-free integers from 1 to limit */
+report_number_found: proc(limit);
+   dcl (limit, i, found);
+   put skip edit ('Number of square-free integers from 1 to',
+      limit, ':') (a, f(6), a);
+   found = 0;
+   do i = 1 to limit;
+      if (square_free(i)) then found = found + 1;
+   end;
+   put edit (found) (f(5));
+end report_number_found;
+
+/* return true if n has no square divisors other than 1 */
+square_free: proc (n) returns (bit(1));
+    dcl (n, i, sq) fixed bin;
+    i = 2;
+    sq = i * i;
+    do while (sq <= n);
+	if (mod(n, sq) = 0) then return (false);
+        i = i + 1;
+        sq = i * i;
+    end;
+    return (true);
+end square_free;
+
+end SquareFreeDemo;
diff --git a/Task/Square-free-integers/Quackery/square-free-integers.quackery b/Task/Square-free-integers/Quackery/square-free-integers.quackery
new file mode 100644
index 0000000000..b083b1c081
--- /dev/null
+++ b/Task/Square-free-integers/Quackery/square-free-integers.quackery
@@ -0,0 +1,38 @@
+  [ stack ]                      is primesquares (   --> s )
+
+  []
+  1000000000145 sqrt
+  dup eratosthenes
+  times
+    [ i^ isprime if
+      [ i^ dup * join ] ]
+  primesquares put
+
+  [ true swap
+    primesquares share witheach
+      [ 2dup < iff
+          [ drop conclude ]
+          done
+        dip dup mod 0 = if
+          [ dip not conclude ] ]
+    drop ]                       is squarefree   ( n --> b )
+
+  say "square-free numbers from 1 to 145"
+  [] 145 times
+    [ i^ 1+ squarefree if
+        [ i^ 1+ number$ nested join ] ]
+  80 wrap$
+  cr cr
+  say "square-free numbers from 1000000000000 to 1000000000145"
+  [] 146 times
+  [ i^ 1000000000000 + squarefree if
+      [ i^ 1000000000000 + number$ nested join ] ]
+  80 wrap$
+  cr cr
+  ' [ 100 1000 10000 100000 1000000 ]
+  witheach
+    [  say "square-free numbers from 1 to "
+       dup echo say ": "
+      0 swap times
+        [ i^ 1+ squarefree + ]
+      echo cr ]
diff --git a/Task/Square-free-integers/S-BASIC/square-free-integers.basic b/Task/Square-free-integers/S-BASIC/square-free-integers.basic
new file mode 100644
index 0000000000..fdf66e8206
--- /dev/null
+++ b/Task/Square-free-integers/S-BASIC/square-free-integers.basic
@@ -0,0 +1,54 @@
+$lines
+
+$constant true = 0FFFFH
+$constant false = 0
+
+rem - return true if n is square-free
+function SquareFree(n = integer) = integer
+   var i, count, result = integer
+   i = 2
+   result = true
+   rem - decompose n into its prime factors
+   while (i*i) <= n and result <> false do
+      begin
+         count = 0
+         while n - (n / i) * i = 0 do
+            begin
+               count = count + 1
+               n = n / i
+            end
+         rem - not square-free if a divisor was repeated
+         if count > 1 then result = false
+         i = i + 1
+      end
+end = result
+
+rem - demonstrate the function
+
+var i, found = integer
+
+print "Showing square-free numbers between 1 and 145"
+for i = 1 to 145
+  if SquareFree(i) then print using "### ";i;
+next i
+print
+
+found = 0
+for i = 1 to 100
+  if SquareFree(i) then found = found + 1
+next i
+print "Square-free numbers between 1 and 100 ="; found
+
+found = 0
+for i = 1 to 1000
+  if SquareFree(i) then found = found + 1
+next i
+print "Square-free numbers between 1 and 1,000 ="; found
+
+found = 0
+for i = 1 to 10000
+  if SquareFree(i) then found = found + 1
+next i
+print "Square-free numbers between 1 and 10,000 ="; found
+
+end
diff --git a/Task/Square-free-integers/SETL/square-free-integers.setl b/Task/Square-free-integers/SETL/square-free-integers.setl
new file mode 100644
index 0000000000..ef1231063e
--- /dev/null
+++ b/Task/Square-free-integers/SETL/square-free-integers.setl
@@ -0,0 +1,45 @@
+program square_free_integers;
+    show_square_frees([1..145]);
+    show_square_frees([1000000000000..1000000000145]);
+    count_square_frees();
+
+    proc count_square_frees();
+        loop init
+            limit := 100;
+            count := 0;
+            n := 1;
+        while limit <= 1000000 do
+            if n = limit then
+                print(str count + " square free numbers <= " + str limit);
+                limit *:= 10;
+            end if;
+            if square_free(n) then
+                count +:= 1;
+            end if;
+            n +:= 1;
+        end loop;
+    end proc;
+
+    proc show_square_frees(nums);
+        loop for n in nums do
+            if square_free(n) then
+                nprint(lpad(str n, 15));
+                if (col +:= 1) mod 5 = 0 then
+                    print;
+                end if;
+            end if;
+        end loop;
+        print;
+    end proc;
+
+    proc square_free(n);
+        loop init r := 2;
+        while r*r <= n do
+            if n mod (r*r) = 0 then
+                return False;
+            end if;
+            r +:= 1;
+        end loop;
+        return True;
+    end proc;
+end program;
diff --git a/Task/Square-free-integers/XPL0/square-free-integers.xpl0 b/Task/Square-free-integers/XPL0/square-free-integers.xpl0
new file mode 100644
index 0000000000..9f0aee1391
--- /dev/null
+++ b/Task/Square-free-integers/XPL0/square-free-integers.xpl0
@@ -0,0 +1,47 @@
+func SqFree(N);                 \Return 'true' if N is square-free
+real N, D2;
+int  D;
+[for D:= 2 to 1000 do           \sqrt one million
+    [D2:= float(D*D);
+    if fix(Mod(N, D2)) = 0 then return false;
+    if D > 2 then D:= D+1;      \(doubles speed to 19.5 sec)
+    ];
+return true;
+];
+
+int  Num, Count, Limit;
+real T;
+[Format(3, 0);
+Count:= 0;
+for Num:= 1 to 145 do
+    [if SqFree(float(Num)) then
+        [Count:= Count+1;
+        RlOut(0, float(Num));
+        if rem(Count/20) then ChOut(0, ^ ) else CrLf(0);
+        ];
+    ];
+CrLf(0);  CrLf(0);
+
+Count:= 0;
+for Num:= 0 to 145 do
+    [T:= float(Num) + 1e12;
+    if SqFree(T) then
+        [RlOut(0, T);
+        Count:= Count+1;
+        if rem(Count/5) then ChOut(0, ^ ) else CrLf(0);
+        ];
+    ];
+CrLf(0);  CrLf(0);
+
+Limit:= 100;
+loop    [Count:= 0;
+        for Num:= 1 to Limit do
+            [T:= float(Num);
+            if SqFree(T) then Count:= Count+1;
+            ];
+        Text(0, "Square-free integers up to ");  IntOut(0, Limit);
+        Text(0, ": ");  IntOut(0, Count);  CrLf(0);
+        if Limit = 1_000_000 then quit;
+        Limit:= Limit * 10;
+        ];
+]
diff --git a/Task/Stem-and-leaf-plot/Crystal/stem-and-leaf-plot.cr b/Task/Stem-and-leaf-plot/Crystal/stem-and-leaf-plot.cr
new file mode 100644
index 0000000000..07d6e34c9e
--- /dev/null
+++ b/Task/Stem-and-leaf-plot/Crystal/stem-and-leaf-plot.cr
@@ -0,0 +1,20 @@
+data = [12, 127, 28, 42, 39, 113, 42, 18, 44, 118, 44, 37, 113, 124,
+        37, 48, 127, 36, 29, 31, 125, 139, 131, 115, 105, 132, 104,
+        123, 35, 113, 122, 42, 117, 119, 58, 109, 23, 105, 63, 27, 44,
+        105, 99, 41, 128, 121, 116, 125, 32, 61, 37, 127, 29, 113,
+        121, 58, 114, 126, 53, 114, 96, 25, 109, 7, 31, 141, 46, 13,
+        27, 43, 117, 116, 27, 7, 68, 40, 31, 115, 124, 42, 128, 52,
+        71, 118, 117, 38, 27, 106, 33, 117, 116, 111, 40, 119, 47,
+        105, 57, 122, 109, 124, 115, 43, 120, 43, 27, 27, 18, 28, 48,
+        125, 107, 114, 34, 133, 45, 120, 30, 127, 31, 116, 146]
+
+hist = Hash(Int32, Array(Int32)).new
+
+data.each do |n|
+  stem = n // 10
+  hist[stem] = (hist[stem]? || [] of Int32) << n % 10
+end
+
+Range.new(*hist.keys.minmax).each do |stem|
+  printf "%4d|%s\n", stem, (hist[stem]? || [] of Int32).sort.map(&.to_s).join
+end
diff --git a/Task/Stirling-numbers-of-the-first-kind/Forth/stirling-numbers-of-the-first-kind.fth b/Task/Stirling-numbers-of-the-first-kind/Forth/stirling-numbers-of-the-first-kind.fth
new file mode 100644
index 0000000000..59e9154b80
--- /dev/null
+++ b/Task/Stirling-numbers-of-the-first-kind/Forth/stirling-numbers-of-the-first-kind.fth
@@ -0,0 +1,25 @@
+: s1 ( n k -- u )
+  dup 0= if
+    drop 0> if 0 else 1 then exit
+  then
+  2dup < if 2drop 0 exit then
+  swap 1- swap
+  2dup 1- recurse >r
+  over swap recurse
+  * r> + ;
+
+: main ( -- )
+  ." Unsigned Stirling numbers of the first kind:" cr
+  ." n/k"
+  13 1 do
+    i 10 .r
+  loop cr
+  13 1 do
+    i 3 .r
+    i 1+ 1 do
+      j i s1 10 .r
+    loop cr
+  loop ;
+
+main
+bye
diff --git a/Task/Stirling-numbers-of-the-second-kind/Forth/stirling-numbers-of-the-second-kind.fth b/Task/Stirling-numbers-of-the-second-kind/Forth/stirling-numbers-of-the-second-kind.fth
new file mode 100644
index 0000000000..f5526fccd0
--- /dev/null
+++ b/Task/Stirling-numbers-of-the-second-kind/Forth/stirling-numbers-of-the-second-kind.fth
@@ -0,0 +1,23 @@
+: s2 ( n k -- u )
+  dup 0= if 2drop 0 exit then
+  over 0= if 2drop 0 exit then
+  2dup = if 2drop 1 exit then
+  swap 1- swap
+  2dup 1- recurse >r
+  tuck recurse * r> + ;
+
+: main ( -- )
+  ." Stirling numbers of the second kind:" cr
+  ." n/k"
+  13 1 do
+    i 8 .r
+  loop cr
+  13 1 do
+    i 3 .r
+    i 1+ 1 do
+      j i s2 8 .r
+    loop cr
+  loop ;
+
+main
+bye
diff --git a/Task/String-append/Retro/string-append.retro b/Task/String-append/Retro/string-append.retro
new file mode 100644
index 0000000000..1aadba0845
--- /dev/null
+++ b/Task/String-append/Retro/string-append.retro
@@ -0,0 +1,3 @@
+'Hello  '_World
+s:append s:put nl
+Hello World
diff --git a/Task/String-case/Zig/string-case.zig b/Task/String-case/Zig/string-case.zig
index 1110070e42..85c281716e 100644
--- a/Task/String-case/Zig/string-case.zig
+++ b/Task/String-case/Zig/string-case.zig
@@ -5,9 +5,9 @@ pub fn main() !void {
     const string = "alphaBETA";
     var lower: [string.len]u8 = undefined;
     var upper: [string.len]u8 = undefined;
-    for (string) |char, i| {
-        lower[i] = std.ascii.toLower(char);
-        upper[i] = std.ascii.toUpper(char);
+    for (string, &lower, &upper) |char, *lo, *up| {
+        lo.* = std.ascii.toLower(char);
+        up.* = std.ascii.toUpper(char);
     }
     try stdout_wr.print("lower: {s}\n", .{lower});
     try stdout_wr.print("upper: {s}\n", .{upper});
diff --git a/Task/String-interpolation-included-/S-BASIC/string-interpolation-included-.basic b/Task/String-interpolation-included-/S-BASIC/string-interpolation-included-.basic
new file mode 100644
index 0000000000..958f7e486b
--- /dev/null
+++ b/Task/String-interpolation-included-/S-BASIC/string-interpolation-included-.basic
@@ -0,0 +1,4 @@
+var template = string
+template = "Mary had a & lamb."
+print using template; "little"
+end
diff --git a/Task/Strip-block-comments/FutureBasic/strip-block-comments.basic b/Task/Strip-block-comments/FutureBasic/strip-block-comments.basic
new file mode 100644
index 0000000000..142075ef51
--- /dev/null
+++ b/Task/Strip-block-comments/FutureBasic/strip-block-comments.basic
@@ -0,0 +1,39 @@
+include "NSLog.incl"
+
+local fn StripBlockComments( string as CFStringRef, openStr as CFStringRef, closeStr as CFStringRef ) as CFStringRef
+  if ( len( openStr ) == 0 || len( closeStr ) == 0 ) then return string
+
+  CFMutableStringRef ret = fn MutableStringWithString( string )
+  CFRange range
+  while ( YES )
+    range = fn StringRangeOfString( ret, openStr )
+    if ( range.location == NSNotFound ) then exit while
+    CFRange endRange = fn StringRangeOfStringWithOptionsInRange( ret, closeStr, NULL, fn CFRangeMake( range.location + range.length, len(ret) - (range.location + range.length ) ) )
+    if ( endRange.location == NSNotFound )
+      break
+    end if
+    CFRange fullRange = fn CFRangeMake( range.location, endRange.location + endRange.length - range.location )
+    MutableStringDeleteCharacters( ret, fullRange )
+  wend
+end fn = ret
+
+CFStringRef test = @"/**\n¬
+* Some comments\n¬
+* longer comments here that we can parse.\n¬
+*\n¬
+* Rahoo \n¬
+*/\n¬
+local fn Subroutine( b as int, c as int ) as int\n¬
+  int a = /* inline comment */ b + c \n¬
+end fn = a\n¬
+/*/ <-- tricky comments */\n¬
+\n¬
+/**\n¬
+* Another comment.\n¬
+*/\n¬
+local fn DoSomething\n¬
+end fn\n¬
+  "
+NSLog( @"%@", fn StripBlockComments( test, @"/*", @"*/" ) )
+
+HandleEvents
diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/FutureBasic/strip-control-codes-and-extended-characters-from-a-string.basic b/Task/Strip-control-codes-and-extended-characters-from-a-string/FutureBasic/strip-control-codes-and-extended-characters-from-a-string.basic
new file mode 100644
index 0000000000..7d7a8e7859
--- /dev/null
+++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/FutureBasic/strip-control-codes-and-extended-characters-from-a-string.basic
@@ -0,0 +1,47 @@
+include "NSLog.incl"
+
+local fn StringStripControlCodes( string as CFStringRef ) as CFStringRef
+  CFMutableCharacterSetRef set = fn MutableCharacterSetNew
+  MutableCharacterSetAddCharactersInRange( set, fn CFRangeMake( 0, 32 ) )
+  MutableCharacterSetAddCharactersInRange( set, fn CFRangeMake( 127, 1 ) )
+end fn = fn ArrayComponentsJoinedByString( fn StringComponentsSeparatedByCharactersInSet( string, set ), @"" )
+
+local fn StringStripExtendedCharacters( string as CFStringRef ) as CFStringRef
+  CFCharacterSetRef set = fn CharacterSetWithRange( fn CFRangeMake( 128, 128 ) )
+end fn = fn ArrayComponentsJoinedByString( fn StringComponentsSeparatedByCharactersInSet( string, set ), @"" )
+
+void local fn DoIt
+  CFStringRef s1 = @"Welcome "
+  CFStringRef s2 = @"to "
+  CFStringRef s3 = @"FutureBasic"
+
+  CFMutableStringRef string = fn MutableStringWithString( s1 )
+
+  int i
+  for i = 0 to 31
+    MutableStringAppendString( string, ucs(i) )
+  next
+
+  MutableStringAppendString( string, ucs(127) )
+  MutableStringAppendString( string, s2 )
+  for i = 128 to 255
+    MutableStringAppendString( string, ucs(i) )
+  next
+  MutableStringAppendString( string, s3 )
+
+  NSLog(@"-- String --\n%@",string)
+
+  CFStringRef string1 = fn StringStripControlCodes( string )
+  NSLog(@"\n\n-- Control codes stripped --\n%@",string1)
+
+  CFStringRef string2 = fn StringStripExtendedCharacters( string )
+  NSLog(@"\n\n-- Extended characters stripped --\n%@",string2)
+
+  CFStringRef string3 = fn StringStripControlCodes( string )
+  string3 = fn StringStripExtendedCharacters( string3 )
+  NSLog(@"\n\n-- Control codes and extended characters stripped --\n%@",string3)
+end fn
+
+fn DoIt
+
+HandleEvents
diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/Langur/strip-control-codes-and-extended-characters-from-a-string.langur b/Task/Strip-control-codes-and-extended-characters-from-a-string/Langur/strip-control-codes-and-extended-characters-from-a-string.langur
index 51299ba2b1..4e27dccc91 100644
--- a/Task/Strip-control-codes-and-extended-characters-from-a-string/Langur/strip-control-codes-and-extended-characters-from-a-string.langur
+++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/Langur/strip-control-codes-and-extended-characters-from-a-string.langur
@@ -1,5 +1,5 @@
 val str = "()\x15abcd\uFFFF123\uBBBB!@#$%^&*\x01"
 
 writeln "original          : ", str
-writeln "without ctrl chars: ", replace(str, RE/\p{Cc}/, "")
-writeln "print ASCII only  : ", replace(str, re/[^ -~]/, "")
+writeln "without ctrl chars: ", replace(str, by=RE/\p{Cc}/)
+writeln "print ASCII only  : ", replace(str, by=re/[^ -~]/)
diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/Fortran/strip-whitespace-from-a-string-top-and-tail.f b/Task/Strip-whitespace-from-a-string-Top-and-tail/Fortran/strip-whitespace-from-a-string-top-and-tail.f
new file mode 100644
index 0000000000..05aa9e6a36
--- /dev/null
+++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/Fortran/strip-whitespace-from-a-string-top-and-tail.f
@@ -0,0 +1,28 @@
+! Tested with GNU Fortran (GCC) 14.2.0
+! Standard: Fortran 90+
+
+program strip_demo
+    implicit none
+    character(21) :: str = "     Jabberwocky     "
+
+    ! Show original string with delimiters
+    write(*, '(A)') "Original:      '" // str // "'"
+
+    ! Remove leading spaces (using adjustl)
+    write(*, '(A)') "Remove left:   '" // adjustl(str) // "'"
+
+    ! Remove trailing spaces (using trim)
+    write(*, '(A)') "Remove right:  '" // trim(str) // "'"
+
+    ! Remove both (using trim and adjustl)
+    write(*, '(A)') "Remove both:   '" // trim(adjustl(str)) // "'"
+end program strip_demo
+
+
+Output:
+
+Original:      '     Jabberwocky     '
+Remove left:   'Jabberwocky          '
+Remove right:  '     Jabberwocky'
+Remove both:   'Jabberwocky'
+

diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/PascalABC.NET/strip-whitespace-from-a-string-top-and-tail.pas b/Task/Strip-whitespace-from-a-string-Top-and-tail/PascalABC.NET/strip-whitespace-from-a-string-top-and-tail.pas
index 50398e4465..d41dba0f0c 100644
--- a/Task/Strip-whitespace-from-a-string-Top-and-tail/PascalABC.NET/strip-whitespace-from-a-string-top-and-tail.pas
+++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/PascalABC.NET/strip-whitespace-from-a-string-top-and-tail.pas
@@ -1,6 +1,6 @@
 begin
-  var s := #9'  abc  '#9;
-  Writeln(s.TrimStart,'|');
-  Writeln(s.TrimEnd,'|');
-  Writeln(s.Trim,'|');
+  var s := #9'  abc  '#9;         // #9 = TAB
+  Writeln('|', s.TrimStart,'|');
+  Writeln('|', s.TrimEnd,'|');
+  Writeln('|', s.Trim,'|');
 end.
diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/PureBasic/strip-whitespace-from-a-string-top-and-tail-1.basic b/Task/Strip-whitespace-from-a-string-Top-and-tail/PureBasic/strip-whitespace-from-a-string-top-and-tail-1.basic
new file mode 100644
index 0000000000..03c3cba201
--- /dev/null
+++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/PureBasic/strip-whitespace-from-a-string-top-and-tail-1.basic
@@ -0,0 +1,3 @@
+  Debug "|" + LTrim("  Top  ")  + "|"
+  Debug "|" + RTrim("  Tail  ") + "|"
+  Debug "|" + Trim("  Both  ")  + "|"
diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/PureBasic/strip-whitespace-from-a-string-top-and-tail.basic b/Task/Strip-whitespace-from-a-string-Top-and-tail/PureBasic/strip-whitespace-from-a-string-top-and-tail-2.basic
similarity index 100%
rename from Task/Strip-whitespace-from-a-string-Top-and-tail/PureBasic/strip-whitespace-from-a-string-top-and-tail.basic
rename to Task/Strip-whitespace-from-a-string-Top-and-tail/PureBasic/strip-whitespace-from-a-string-top-and-tail-2.basic
diff --git a/Task/Sudan-function/Crystal/sudan-function.cr b/Task/Sudan-function/Crystal/sudan-function.cr
new file mode 100644
index 0000000000..439aaa56e5
--- /dev/null
+++ b/Task/Sudan-function/Crystal/sudan-function.cr
@@ -0,0 +1,14 @@
+def sudan (n, x : UInt64, y : UInt64)
+  if n == 0
+    x + y
+  elsif y == 0
+    x
+  else
+    s = sudan(n, x, y-1)
+    sudan(n-1, s, s + y)
+  end
+end
+
+[{0, 0, 0}, {1, 1, 1}, {2, 1, 1}, {2, 2, 1}, {2, 2, 2}, {3, 1, 1}].each do |n, x, y|
+  puts "sudan #{n} (#{x}, #{y}) = #{sudan(n, x.to_u64, y.to_u64)}"
+end
diff --git a/Task/Sudan-function/EMal/sudan-function.emal b/Task/Sudan-function/EMal/sudan-function.emal
new file mode 100644
index 0000000000..22b7195ccd
--- /dev/null
+++ b/Task/Sudan-function/EMal/sudan-function.emal
@@ -0,0 +1,12 @@
+fun F ← int by int n, int x, int y
+  if n æ 0
+    return x + y
+  else if y æ 0
+    return x
+  end
+  return F(n - 1, F(n, x, y - 1), F(n, x, y - 1) + y)
+end
+writeLine("F(1, 3, 3) ← ", F(1, 3, 3))
+writeLine("F(2, 1, 1) ← ", F(2, 1, 1))
+writeLine("F(3, 1, 1) ← ", F(3, 1, 1))
+writeLine("F(2, 2, 1) ← ", F(2, 2, 1))
diff --git a/Task/Sudoku/Python/sudoku-2.py b/Task/Sudoku/Python/sudoku-2.py
index 6687c9d173..61d34ca0d3 100644
--- a/Task/Sudoku/Python/sudoku-2.py
+++ b/Task/Sudoku/Python/sudoku-2.py
@@ -1,56 +1,86 @@
-sudoku = [
-    # cell value                # cell number
-    0, 0, 4, 0, 5, 0, 0, 0, 0,  #  0,  1,  2,  3,  4,  5,  6,  7,  8,
-    9, 0, 0, 7, 3, 4, 6, 0, 0,  #  9, 10, 11, 12, 13, 14, 15, 16, 17,
-    0, 0, 3, 0, 2, 1, 0, 4, 9,  # 18, 19, 20, 21, 22, 23, 24, 25, 26,
-    0, 3, 5, 0, 9, 0, 4, 8, 0,  # 27, 28, 29, 30, 31, 32, 33, 34, 35,
-    0, 9, 0, 0, 0, 0, 0, 3, 0,  # 36, 37, 38, 39, 40, 41, 42, 43, 44,
-    0, 7, 6, 0, 1, 0, 9, 2, 0,  # 45, 46, 47, 48, 49, 50, 51, 52, 53,
-    3, 1, 0, 9, 7, 0, 2, 0, 0,  # 54, 55, 56, 57, 58, 59, 60, 61, 62,
-    0, 0, 9, 1, 8, 2, 0, 0, 3,  # 63, 64, 65, 66, 67, 68, 69, 70, 71,
-    0, 0, 0, 0, 6, 0, 1, 0, 0,  # 72, 73, 74, 75, 76, 77, 78, 79, 80
-    # zero = empty.
-]
+# Sudoku Solver
+# Recursive backtracking algorithm
+# Usage: python3 sudoku.py [puzzle.txt]
 
-numbers = {1,2,3,4,5,6,7,8,9}
+import sys
 
-def options(cell,sudoku):
-    """ determines the degree of freedom for a cell. """
-    column = {v for ix, v in enumerate(sudoku) if ix % 9 == cell % 9}
-    row = {v for ix, v in enumerate(sudoku) if ix // 9 == cell // 9}
-    box = {v for ix, v in enumerate(sudoku) if (ix // (9 * 3) == cell // (9 * 3)) and ((ix % 9) // 3 == (cell % 9) // 3)}
-    return numbers - (box | row | column)
+grid0 = [[0,0,8,0,0,0,0,1,6],  # Data type for sudoku puzzles:
+         [5,0,0,0,9,2,0,0,8],  # a list of 9 lists, each of 9 digits.
+         [0,0,0,1,0,0,0,0,0],
+         [9,0,0,3,0,0,8,2,0],  # grid0 is a global variable used by readFile()
+         [0,2,0,0,0,0,0,7,0],
+         [0,8,4,0,0,6,0,0,5],  # This sudoku is solved when there is no
+         [0,0,0,0,0,3,0,0,0],  # filename argument on the command line.
+         [4,0,0,9,6,0,0,0,2],
+         [1,6,0,0,0,0,7,0,0]]
 
-initial_state = sudoku[:]  # the sudoku is our initial state.
+def readFile():
+    '''Parses a textfile containing a sudoku puzzle;
+       returns this puzzle as 'grid', a list of 9 lists of 9 digits.
+       Returns grid0 if no filename is given on the command line.
+    '''
+    if len(sys.argv) == 1:  # No command line argument
+        return grid0
+    else:
+        name = sys.argv[1]  # A filename or path/filename of a sudoku textfile
+    file = open(name)
+    grid = []
+    while True:
+        txt = file.readline()
+        if txt == "": break
+        row = []
+        for ch in txt:                      # In the sudoku textfile:
+            if ch == "#":    break          #   a '#' can be used for comments,
+            if ch == ".":    row.append(0)  #   '.' or '0' stand for empty cells
+            if ch == "_":    row.append(0)  #   '_' or '-'
+            if ch == "-":    row.append(0)  #   could also be used for this.
+            if ch.isdigit(): row.append(int(ch))
+        if row != []:  # all lines without digits or empty cell characters give []
+            if len(row) != 9:
+                print("Sudoku file configuration error: not 9 columns");
+                file.close; exit()          # Halt the program
+            grid.append(row)
+    file.close()
+    if len(grid) != 9:
+        print("Sudoku file configuration error: not 9 rows"); exit()
+    else:
+        return grid
 
-job_queue = [initial_state]  # we need the jobqueue in case of ambiguity of choice.
+def printGrid (grid):
+    for i in range(0, 9):
+        if i > 0 and i % 3 == 0:
+            print("------+-------+------", end="")
+            print()
+        for j in range(0, 9):
+            if j > 0 and j % 3 == 0: print("| ", end="")
+            n = grid[i][j]
+            c = "." if n == 0 else str(n)
+            print(c, end=" ")
+        print()
 
-while job_queue:
-    state = job_queue.pop(0)
-    if not any(i==0 for i in state):  # no missing values means that the sudoku is solved.
-        break
+def valid (row, col, n):
+    res = True
+    for i in range(0, 9):
+        for j in range(0, 9):
+            if ( i == row or j == col or
+                 i // 3 == row // 3 and j // 3 == col // 3 ):  # square
+                if grid[i][j] == n: res = False
+    return res
 
-    # determine the degrees of freedom for each cell.
-    degrees_of_freedom = [0 if v!=0 else len(options(ix,state)) for ix,v in enumerate(state)]
-    # find cell with least freedom.
-    least_freedom = min(v for v in degrees_of_freedom if v > 0)
-    cell = degrees_of_freedom.index(least_freedom)
+def solve():
+    for row in range(0, 9):
+        for col in range(0, 9):
+            if grid[row][col] == 0:
+                for n in (range(1, 10)):
+                    if valid(row, col, n):
+                        grid[row][col] = n
+                        solve()             # recursive call
+                        grid[row][col] = 0  # backtracking step
+                return
+    printGrid(grid)  # The solved sudoku
+    input("\nPress enter to check for more solutions\n")
 
-    for option in options(cell, state):  # for each option we add the new state to the queue.
-        new_state = state[:]
-        new_state[cell] = option
-        job_queue.append(new_state)
-
-# finally - print out the solution
-for i in range(9):
-    print(state[i*9:i*9+9])
-
-# [2, 6, 4, 8, 5, 9, 3, 1, 7]
-# [9, 8, 1, 7, 3, 4, 6, 5, 2]
-# [7, 5, 3, 6, 2, 1, 8, 4, 9]
-# [1, 3, 5, 2, 9, 7, 4, 8, 6]
-# [8, 9, 2, 5, 4, 6, 7, 3, 1]
-# [4, 7, 6, 3, 1, 8, 9, 2, 5]
-# [3, 1, 8, 9, 7, 5, 2, 6, 4]
-# [6, 4, 9, 1, 8, 2, 5, 7, 3]
-# [5, 2, 7, 4, 6, 3, 1, 9, 8]
+grid = readFile()    # valid() and solve() use this global variable
+printGrid(grid)      # The unsolved sudoku
+print()
+solve()
diff --git a/Task/Sudoku/Python/sudoku-3.py b/Task/Sudoku/Python/sudoku-3.py
new file mode 100644
index 0000000000..6687c9d173
--- /dev/null
+++ b/Task/Sudoku/Python/sudoku-3.py
@@ -0,0 +1,56 @@
+sudoku = [
+    # cell value                # cell number
+    0, 0, 4, 0, 5, 0, 0, 0, 0,  #  0,  1,  2,  3,  4,  5,  6,  7,  8,
+    9, 0, 0, 7, 3, 4, 6, 0, 0,  #  9, 10, 11, 12, 13, 14, 15, 16, 17,
+    0, 0, 3, 0, 2, 1, 0, 4, 9,  # 18, 19, 20, 21, 22, 23, 24, 25, 26,
+    0, 3, 5, 0, 9, 0, 4, 8, 0,  # 27, 28, 29, 30, 31, 32, 33, 34, 35,
+    0, 9, 0, 0, 0, 0, 0, 3, 0,  # 36, 37, 38, 39, 40, 41, 42, 43, 44,
+    0, 7, 6, 0, 1, 0, 9, 2, 0,  # 45, 46, 47, 48, 49, 50, 51, 52, 53,
+    3, 1, 0, 9, 7, 0, 2, 0, 0,  # 54, 55, 56, 57, 58, 59, 60, 61, 62,
+    0, 0, 9, 1, 8, 2, 0, 0, 3,  # 63, 64, 65, 66, 67, 68, 69, 70, 71,
+    0, 0, 0, 0, 6, 0, 1, 0, 0,  # 72, 73, 74, 75, 76, 77, 78, 79, 80
+    # zero = empty.
+]
+
+numbers = {1,2,3,4,5,6,7,8,9}
+
+def options(cell,sudoku):
+    """ determines the degree of freedom for a cell. """
+    column = {v for ix, v in enumerate(sudoku) if ix % 9 == cell % 9}
+    row = {v for ix, v in enumerate(sudoku) if ix // 9 == cell // 9}
+    box = {v for ix, v in enumerate(sudoku) if (ix // (9 * 3) == cell // (9 * 3)) and ((ix % 9) // 3 == (cell % 9) // 3)}
+    return numbers - (box | row | column)
+
+initial_state = sudoku[:]  # the sudoku is our initial state.
+
+job_queue = [initial_state]  # we need the jobqueue in case of ambiguity of choice.
+
+while job_queue:
+    state = job_queue.pop(0)
+    if not any(i==0 for i in state):  # no missing values means that the sudoku is solved.
+        break
+
+    # determine the degrees of freedom for each cell.
+    degrees_of_freedom = [0 if v!=0 else len(options(ix,state)) for ix,v in enumerate(state)]
+    # find cell with least freedom.
+    least_freedom = min(v for v in degrees_of_freedom if v > 0)
+    cell = degrees_of_freedom.index(least_freedom)
+
+    for option in options(cell, state):  # for each option we add the new state to the queue.
+        new_state = state[:]
+        new_state[cell] = option
+        job_queue.append(new_state)
+
+# finally - print out the solution
+for i in range(9):
+    print(state[i*9:i*9+9])
+
+# [2, 6, 4, 8, 5, 9, 3, 1, 7]
+# [9, 8, 1, 7, 3, 4, 6, 5, 2]
+# [7, 5, 3, 6, 2, 1, 8, 4, 9]
+# [1, 3, 5, 2, 9, 7, 4, 8, 6]
+# [8, 9, 2, 5, 4, 6, 7, 3, 1]
+# [4, 7, 6, 3, 1, 8, 9, 2, 5]
+# [3, 1, 8, 9, 7, 5, 2, 6, 4]
+# [6, 4, 9, 1, 8, 2, 5, 7, 3]
+# [5, 2, 7, 4, 6, 3, 1, 9, 8]
diff --git a/Task/Sum-and-product-of-an-array/Langur/sum-and-product-of-an-array.langur b/Task/Sum-and-product-of-an-array/Langur/sum-and-product-of-an-array.langur
index 3d2548363d..2b938f77a6 100644
--- a/Task/Sum-and-product-of-an-array/Langur/sum-and-product-of-an-array.langur
+++ b/Task/Sum-and-product-of-an-array/Langur/sum-and-product-of-an-array.langur
@@ -1,4 +1,4 @@
 val alist = series(19)
 writeln "   list: ", alist
-writeln "    sum: ", fold(fn{+}, alist)
-writeln "product: ", fold(fn{*}, alist)
+writeln "    sum: ", fold(alist, by=fn{+})
+writeln "product: ", fold(alist, by=fn{*})
diff --git a/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5-1.jq b/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5-1.jq
deleted file mode 100644
index 4dc4101f8c..0000000000
--- a/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5-1.jq
+++ /dev/null
@@ -1,7 +0,0 @@
-def sum_multiples(d):
- ((./d) | floor) |  (d * . * (.+1))/2 ;
-
-# Sum of multiples of a or b that are less than . (the input)
-def task(a;b):
- . - 1
- | sum_multiples(a) + sum_multiples(b) - sum_multiples(a*b);
diff --git a/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5-2.jq b/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5-2.jq
deleted file mode 100644
index 6583a547b0..0000000000
--- a/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5-2.jq
+++ /dev/null
@@ -1,3 +0,0 @@
-1000 | task(3;5)  # => 233168
-
-10e20 | task(3;5) # => 2.333333333333333e+41
diff --git a/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5.jq b/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5.jq
new file mode 100644
index 0000000000..7a73096e2d
--- /dev/null
+++ b/Task/Sum-multiples-of-3-and-5/Jq/sum-multiples-of-3-and-5.jq
@@ -0,0 +1,20 @@
+def idivide($j):
+  (. % $j) as $mod
+  | (. - $mod) / $j ;
+
+def sum_multiples(d):
+ idivide(d) |  (d * . * (.+1)) | idivide(2)  ;
+
+# Sum of multiples of a or b that are less than . (the input)
+def task(a;b):
+ . - 1
+ | sum_multiples(a) + sum_multiples(b) - sum_multiples(a*b);
+
+# Examples:
+(1000 | task(3;5)),  # => 233168
+
+(10e20 | task(3;5)), # => 2.333333333333333e+41
+
+(1000000000000000000000 | task(3;5))
+# gojq => 233333333333333333333166666666666666666668
+# jq and jaq => 2.333333333333333e41
diff --git a/Task/Sum-multiples-of-3-and-5/K/sum-multiples-of-3-and-5.k b/Task/Sum-multiples-of-3-and-5/K/sum-multiples-of-3-and-5.k
new file mode 100644
index 0000000000..8b6cd3f022
--- /dev/null
+++ b/Task/Sum-multiples-of-3-and-5/K/sum-multiples-of-3-and-5.k
@@ -0,0 +1,2 @@
+limit: 1000
++/(!limit)[&{(*/{ (3!x), (5!x)}'x)=0}'!limit]
diff --git a/Task/Sum-multiples-of-3-and-5/Quackery/sum-multiples-of-3-and-5-1.quackery b/Task/Sum-multiples-of-3-and-5/Quackery/sum-multiples-of-3-and-5-1.quackery
new file mode 100644
index 0000000000..6ae00005e0
--- /dev/null
+++ b/Task/Sum-multiples-of-3-and-5/Quackery/sum-multiples-of-3-and-5-1.quackery
@@ -0,0 +1,5 @@
+  0 1000 times
+    [ i 3 mod
+      i 5 mod *
+      0 = if [ i + ] ]
+  echo
diff --git a/Task/Sum-multiples-of-3-and-5/Quackery/sum-multiples-of-3-and-5.quackery b/Task/Sum-multiples-of-3-and-5/Quackery/sum-multiples-of-3-and-5-2.quackery
similarity index 100%
rename from Task/Sum-multiples-of-3-and-5/Quackery/sum-multiples-of-3-and-5.quackery
rename to Task/Sum-multiples-of-3-and-5/Quackery/sum-multiples-of-3-and-5-2.quackery
diff --git a/Task/Sum-multiples-of-3-and-5/Retro/sum-multiples-of-3-and-5.retro b/Task/Sum-multiples-of-3-and-5/Retro/sum-multiples-of-3-and-5.retro
new file mode 100644
index 0000000000..ac4a0593a5
--- /dev/null
+++ b/Task/Sum-multiples-of-3-and-5/Retro/sum-multiples-of-3-and-5.retro
@@ -0,0 +1,17 @@
+:sum checks if number is divisible by 5 or 3
+adds then to result
+output with n:put nl;
+works only with integers, no big int support
+~~~
+'number var
+#1 !number
+
+'result var
+#0 !number
+
+:sum (n-)  #3 mod #0 eq? @number #5 mod #0 eq? or [ @result @number + !result ] if ;
+
+#1000 [ @number sum &number v:inc ] times
+@result n:put nl
+
+~~~
diff --git a/Task/Sum-of-a-series/ALGOL-60/sum-of-a-series.alg b/Task/Sum-of-a-series/ALGOL-60/sum-of-a-series.alg
new file mode 100644
index 0000000000..55260b26a2
--- /dev/null
+++ b/Task/Sum-of-a-series/ALGOL-60/sum-of-a-series.alg
@@ -0,0 +1,18 @@
+begin
+
+comment - return sum from a to b of the series 1 / k^2;
+
+real procedure suminvsq(a, b);
+  value a, b; real a, b;
+begin
+  real k, sum;
+  sum := 0;
+  for k := a step 1 until b do
+    sum := sum + 1 / (k * k);
+  suminvsq := sum;
+end;
+
+comment - show result for 1..1000
+outreal(1,suminvsq(1,1000));
+
+end
diff --git a/Task/Sum-of-a-series/Langur/sum-of-a-series-1.langur b/Task/Sum-of-a-series/Langur/sum-of-a-series-1.langur
index d8fa25f5d9..a088cbe369 100644
--- a/Task/Sum-of-a-series/Langur/sum-of-a-series-1.langur
+++ b/Task/Sum-of-a-series/Langur/sum-of-a-series-1.langur
@@ -1,4 +1,4 @@
 val pi = 3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214
 
-writeln "calc.: ", fold(fn{+}, map(fn x:1/x^2, 1..1000))
+writeln "calc.: ", fold(map(1..1000, by=fn x:1/x^2), by=fn{+})
 writeln "known: ", pi^2/6
diff --git a/Task/Sum-of-a-series/Langur/sum-of-a-series-2.langur b/Task/Sum-of-a-series/Langur/sum-of-a-series-2.langur
index 616b81088c..58018db702 100644
--- a/Task/Sum-of-a-series/Langur/sum-of-a-series-2.langur
+++ b/Task/Sum-of-a-series/Langur/sum-of-a-series-2.langur
@@ -2,5 +2,5 @@ val pi = 3.141592653589793238462643383279502884197169399375105820974944592307816
 
 mode divMaxScale = 100
 
-writeln "calc.: ", fold(fn{+}, map(fn x:1/x^2, 1..1000))
+writeln "calc.: ", fold(map(1..1000, by=fn x:1/x^2), by=fn{+})
 writeln "known: ", pi^2/6
diff --git a/Task/Summarize-primes/Lua/summarize-primes.lua b/Task/Summarize-primes/Lua/summarize-primes.lua
new file mode 100644
index 0000000000..4a5db5ee08
--- /dev/null
+++ b/Task/Summarize-primes/Lua/summarize-primes.lua
@@ -0,0 +1,28 @@
+require "math"
+
+function isprime(n)
+   for i=2, math.sqrt(n) do
+       if math.mod(n, i) == 0 then
+	       return false
+       end
+   end
+   return true
+end
+
+index = 1
+
+for i=2, 1000 do
+    sum = 0
+    if isprime(i) then
+	   for j=2,i do
+          if isprime(j) then
+             sum = sum + j
+	      end
+	   end
+
+	   if isprime(sum) then
+	       print(index, i, sum)
+	   end
+       index = index + 1
+	end
+end
diff --git a/Task/Sylvesters-sequence/Java/sylvesters-sequence.java b/Task/Sylvesters-sequence/Java/sylvesters-sequence.java
new file mode 100644
index 0000000000..416de8d0d9
--- /dev/null
+++ b/Task/Sylvesters-sequence/Java/sylvesters-sequence.java
@@ -0,0 +1,60 @@
+import java.math.BigDecimal;
+import java.math.BigInteger;
+import java.math.MathContext;
+import java.math.RoundingMode;
+
+public final class SylvestersSequence {
+
+	public static void main(String[] args) {
+		System.out.println("The first 10 terms in Sylvester's sequence are:");
+		BigInteger term = BigInteger.TWO;
+		BigRational sum = BigRational.ZERO;
+	    for ( int i = 1; i <= 10; i++ ) {
+	    	System.out.println(term);
+	        sum = sum.add( new BigRational(BigInteger.ONE, term) );
+	        term = term.multiply(term).subtract(term).add(BigInteger.ONE);
+	    }
+	    System.out.println();
+	
+	    System.out.println("The sum of their reciprocals as a rational number is:");
+	    System.out.println(sum + System.lineSeparator());	
+	
+	    System.out.println("The sum of their reciprocals as a decimal number, to 235 decimal places, is:");
+	    System.out.println(sum.toDecimal(235));
+	}
+
+}
+
+final class BigRational {
+	
+	public BigRational(BigInteger aNumerator, BigInteger aDenominator) {
+		numerator = aNumerator;
+		denominator = aDenominator;
+		
+    	BigInteger gcd = numerator.gcd(denominator);	    	
+    	numerator = numerator.divide(gcd);
+    	denominator = denominator.divide(gcd);
+    }
+	
+	public BigRational add(BigRational other) {
+		BigInteger numer = numerator.multiply(other.denominator).add(denominator.multiply(other.numerator));
+		BigInteger denom = denominator.multiply(other.denominator);		
+		return new BigRational(numer, denom);
+	}	
+	
+	public String toDecimal(int decimalPlaces) {
+		BigDecimal numer = new BigDecimal(numerator);
+		BigDecimal denom = new BigDecimal(denominator);
+		return numer.divide(denom, new MathContext(decimalPlaces + 1, RoundingMode.HALF_UP)).toString();
+	}	
+	
+	public String toString() {
+		return numerator.toString() + " / " + denominator.toString();
+	}
+
+	public static final BigRational ZERO = new BigRational(BigInteger.ZERO, BigInteger.ONE);
+	
+	private BigInteger numerator;
+	private BigInteger denominator;
+	
+}
diff --git a/Task/Symmetric-difference/Wren/symmetric-difference.wren b/Task/Symmetric-difference/Wren/symmetric-difference.wren
index 9bb7ad6ab9..30eaa25574 100644
--- a/Task/Symmetric-difference/Wren/symmetric-difference.wren
+++ b/Task/Symmetric-difference/Wren/symmetric-difference.wren
@@ -1,11 +1,9 @@
 import "./set" for Set
 
-var symmetricDifference = Fn.new { |a, b| a.except(b).union(b.except(a)) }
-
 var a = Set.new(["John", "Bob", "Mary", "Serena"])
 var b = Set.new(["Jim", "Mary", "John", "Bob"])
 System.print("A     = %(a)")
 System.print("B     = %(b)")
 System.print("A - B = %(a.except(b))")
 System.print("B - A = %(b.except(a))")
-System.print("A △ B = %(symmetricDifference.call(a, b))")
+System.print("A △ B = %(a.symDiff(b))")
diff --git a/Task/System-time/Atari-BASIC/system-time.basic b/Task/System-time/Atari-BASIC/system-time.basic
new file mode 100644
index 0000000000..21f7dbafab
--- /dev/null
+++ b/Task/System-time/Atari-BASIC/system-time.basic
@@ -0,0 +1,4 @@
+10 REM DETECT NTSC OR PAL SYSTEM
+20 FPS=60:IF PEEK(53268)=1 THEN FPS=50
+30 JIFFIES=65536*PEEK(18)+256*PEEK(19)+PEEK(20)
+40 PRINT JIFFIES/FPS;" SECONDS SINCE LAST RESET"
diff --git a/Task/System-time/Python/system-time.py b/Task/System-time/Python/system-time.py
index 513d9a94ab..38b94f8a27 100644
--- a/Task/System-time/Python/system-time.py
+++ b/Task/System-time/Python/system-time.py
@@ -1,2 +1,2 @@
 import time
-print time.ctime()
+print(time.ctime())
diff --git a/Task/System-time/Wren/system-time.wren b/Task/System-time/Wren/system-time.wren
index ba4e07fc5e..9b37978c91 100644
--- a/Task/System-time/Wren/system-time.wren
+++ b/Task/System-time/Wren/system-time.wren
@@ -1,10 +1,3 @@
-import "os" for Process
-import "./date" for Date
+import "timer" for Now
 
-var args = Process.arguments
-if (args.count != 1) Fiber.abort("Please pass the current time in hh:mm:ss format.")
-var startTime = Date.parse(args[0], Date.isoTime)
-for (i in 0..1e8) {} // do something which takes a bit of time
-var now = startTime.addMillisecs((System.clock * 1000).round)
-Date.default = Date.isoTime + "|.|ttt"
-System.print("Time now is %(now)")
+System.print(Now.time)
diff --git a/Task/Taxicab-numbers/Arturo/taxicab-numbers.arturo b/Task/Taxicab-numbers/Arturo/taxicab-numbers.arturo
new file mode 100644
index 0000000000..11422e07d2
--- /dev/null
+++ b/Task/Taxicab-numbers/Arturo/taxicab-numbers.arturo
@@ -0,0 +1,18 @@
+taxicabs: [0] ++ (@1..1200) | combine.repeated.by:2
+                            | gather 'pair -> (pair\0^3) + pair\1^3
+                            | select [k,pair] -> (size pair) > 1
+                            | arrange [k,v] -> to :integer k
+
+cubed: function [n]-> pad (to :string n)++"³" 4
+
+loop append @1..25 @2000..2007 'rank [
+    [num,p]: taxicabs\[rank]
+    print [
+        pad to :string rank 5 ":"
+        pad num 10 "="
+        cubed p\0\0 "+"
+        cubed p\0\1 "="
+        cubed p\1\0 "+"
+        cubed p\1\1
+    ]
+]
diff --git a/Task/Taxicab-numbers/M2000-Interpreter/taxicab-numbers.m2000 b/Task/Taxicab-numbers/M2000-Interpreter/taxicab-numbers.m2000
new file mode 100644
index 0000000000..b6fb31d9db
--- /dev/null
+++ b/Task/Taxicab-numbers/M2000-Interpreter/taxicab-numbers.m2000
@@ -0,0 +1,47 @@
+module TaxiCab (f as long){
+	cls,0
+	Print Part "Taxicab numbers"
+	Print Under
+	profiler
+	var Cubes=list, 	Sums=list, 	Ret=list
+	var st=0, en=1200
+	st=@Proc(0, en)
+	sort ret as number
+	Display(1, 25)
+	Display(2000, 2006)
+	Print timecount
+	print "done"
+	end
+	sub Display(from, to)
+		local k=each(ret, from,to), s=""
+		while k
+			s= format$("{0:-6} {1:-12}",K^+1, val(eval$(k!)+"&&"))+eval$(k)
+		 	Print s : if f>-1 then print #f, s
+		end while
+	end sub
+	function Proc(ia, ib)
+		local i, cube as long long, s as long long
+		for i=ia to ib
+			if i mod 10=1 then print over $("#0.00"), "Working..";(i-ia)/ib*100;"%"
+			cube=i^3
+			Append Cubes, cube
+			k=each(cubes)
+			while k
+				s=cube+eval(k)
+				if not exist(Sums, s) then
+					append Sums,s:=(i)+"^3 + "+(k^)+"^3"
+				else.if not exist(Ret, s) then
+					append Ret, s:=" = "+(i)+"^3 + "+(k^)+"^3 = "+eval$(Sums)
+				end if
+			end while
+		next
+		print over $("#0.00"), "Working..";100;"%"
+		print
+		=i
+	end function
+}
+file2export="TaxiCabNumbers.txt"
+open file2export for wide output as #f
+TaxiCab f
+close #f
+win dir$+"TaxiCabNumbers.txt"
diff --git a/Task/Temperature-conversion/ANSI-BASIC/temperature-conversion.basic b/Task/Temperature-conversion/ANSI-BASIC/temperature-conversion.basic
new file mode 100644
index 0000000000..439ee88a59
--- /dev/null
+++ b/Task/Temperature-conversion/ANSI-BASIC/temperature-conversion.basic
@@ -0,0 +1,13 @@
+100 REM Temperature conversion
+110 DO
+120    INPUT PROMPT "Kelvin degrees ":K
+130    IF K < 0 THEN EXIT DO
+140    LET C = K - 273.15
+150    LET F = K * 1.8 - 459.67
+160    LET R = K * 1.8
+170    PRINT K; "Kelvin is equivalent to"
+180    PRINT C; "degrees Celsius,"
+190    PRINT F; "degrees Fahrenheit,"
+200    PRINT R; "degrees Rankine."
+210 LOOP
+220 END
diff --git a/Task/Temperature-conversion/ASIC/temperature-conversion.asic b/Task/Temperature-conversion/ASIC/temperature-conversion.asic
new file mode 100644
index 0000000000..71ac7b6e9e
--- /dev/null
+++ b/Task/Temperature-conversion/ASIC/temperature-conversion.asic
@@ -0,0 +1,20 @@
+REM Temperature conversion
+PRINT "Kelvin degrees";
+INPUT K@
+WHILE K@ >= 0
+  C@ = K@ - 273.15
+  R@ = K@ * 1.8
+  F@ = R@ - 459.67
+  CLS
+  PRINT K@;
+  PRINT " Kelvin is equivalent to"
+  PRINT C@;
+  PRINT " degrees Celsius,"
+  PRINT F@;
+  PRINT " degrees Fahrenheit,"
+  PRINT R@;
+  PRINT " degrees Rankine."
+  PRINT "Kelvin degrees";
+  INPUT K@
+WEND
+END
diff --git a/Task/Temperature-conversion/BASIC/temperature-conversion.basic b/Task/Temperature-conversion/BASIC/temperature-conversion.basic
deleted file mode 100644
index 55a3e1aba3..0000000000
--- a/Task/Temperature-conversion/BASIC/temperature-conversion.basic
+++ /dev/null
@@ -1,11 +0,0 @@
-10 REM TRANSLATION OF AWK VERSION
-20 INPUT "KELVIN DEGREES",K
-30 IF K <= 0 THEN END: REM A VALUE OF ZERO OR LESS WILL END PROGRAM
-40 LET C = K - 273.15
-50 LET F = K * 1.8 - 459.67
-60 LET R = K * 1.8
-70 PRINT K; " KELVIN IS EQUIVALENT TO"
-80 PRINT C; " DEGREES CELSIUS"
-90 PRINT F; " DEGREES FAHRENHEIT"
-100 PRINT R; " DEGREES RANKINE"
-110 GOTO 20
diff --git a/Task/Temperature-conversion/Chipmunk-Basic/temperature-conversion.basic b/Task/Temperature-conversion/Chipmunk-Basic/temperature-conversion.basic
index f96749e0cf..508ecae8df 100644
--- a/Task/Temperature-conversion/Chipmunk-Basic/temperature-conversion.basic
+++ b/Task/Temperature-conversion/Chipmunk-Basic/temperature-conversion.basic
@@ -1,7 +1,7 @@
 10 CLS : REM  10 HOME for Applesoft BASIC : DELETE for Minimal BASIC
 20 PRINT "Kelvin Degrees ";
 30 INPUT K
-40 IF K <= 0 THEN 130
+40 IF K < 0 THEN 130
 50 LET C = K-273.15
 60 LET F = K*1.8-459.67
 70 LET R = K*1.8
diff --git a/Task/Temperature-conversion/M2000-Interpreter/temperature-conversion-1.m2000 b/Task/Temperature-conversion/M2000-Interpreter/temperature-conversion-1.m2000
new file mode 100644
index 0000000000..441b01a9c3
--- /dev/null
+++ b/Task/Temperature-conversion/M2000-Interpreter/temperature-conversion-1.m2000
@@ -0,0 +1,9 @@
+module ZX81_code {
+	10 PRINT "ENTER A TEMPERATURE IN KELVINS"
+	20 INPUT K
+	30 PRINT K;" KELVINS ="
+	40 PRINT K-273.15;" DEGREES CELSIUS"
+	50 PRINT K*1.8-459.67;" DEGREES FAHRENHEIT"
+	60 PRINT K*1.8;" DEGREES RANKINE"
+}
+ZX81_code
diff --git a/Task/Temperature-conversion/M2000-Interpreter/temperature-conversion-2.m2000 b/Task/Temperature-conversion/M2000-Interpreter/temperature-conversion-2.m2000
new file mode 100644
index 0000000000..32dfa077ad
--- /dev/null
+++ b/Task/Temperature-conversion/M2000-Interpreter/temperature-conversion-2.m2000
@@ -0,0 +1,60 @@
+Module Temprature_Conversions {
+	Module Decorated_Modules {
+		Module Cnvt2Fahrenheit (x){Push "Fahrenheit", Round(x*1.8+32, 2)}
+		Module CnvtFromFahrenheit (x) {Push "Fahrenheit", Round((x-32)/1.8, 2)}
+		Module Cnvt2Kelvin (x){Push "Kelvin", Round(x+273.15, 2)}
+		Module CnvtFromKelvin (x){Push "Kelvin", Round(x-273.15, 2)}
+		Module Cnvt2Rankine (x){Push "Rankine", Round(x*1.8+ 491.67, 2)	}
+		Module CnvtFromRankine (x){Push "Rankine", Round((x-491.67)/1.8, 2)}
+		Module Temperatures {
+			Convertion
+			data format$("From {0}° {1} convert to {2}° {3}", number, letter$, number, letter$)
+		}
+		k=253.15
+		Data "Kelvin="+k
+		Temperatures  k ; cnvtForm as CnvtFromKelvin
+		Temperatures  k ; cnvtForm as CnvtFromKelvin, convert as Cnvt2Fahrenheit
+		Temperatures  k ; cnvtForm as CnvtFromKelvin, convert as Cnvt2Rankine
+		k=-20
+		Data "Celsius="+k
+		Temperatures  k ; convert as Cnvt2Kelvin
+		Temperatures  k ; convert as Cnvt2Fahrenheit
+		Temperatures  k ; convert as Cnvt2Rankine
+		k=-4
+		Data "Fahrenheit="+k
+		Temperatures k ; cnvtForm as CnvtFromFahrenheit, convert as Cnvt2Kelvin
+		Temperatures k ;cnvtForm as CnvtFromFahrenheit
+		Temperatures k ;cnvtForm as CnvtFromFahrenheit, convert as Cnvt2Rankine
+		k=455.67
+		Data "Rankine="+k
+		Temperatures k ; cnvtForm as CnvtFromRankine, convert as Cnvt2Kelvin
+		Temperatures k ;cnvtForm as CnvtFromRankine
+		Temperatures k ;cnvtForm as CnvtFromRankine, convert as Cnvt2Fahrenheit
+	
+	}
+	Module Global Convertion {
+		over ' doublicate stack
+		Module cnvtForm  {
+			Push "Celsius" : shift 2
+		}
+		Module convert {
+			Push "Celsius" : shift 2
+		}
+		cnvtForm : convert
+		Shift 3 ' move 3rd to 1st
+		Shift 4  ' move 4th to 1st		
+	}	
+	Module TemperaturesGreek {
+		Convertion
+		data format$("Από {0}° {1} μετατροπή σε {2}° {3}", number, letter$, number, letter$)	
+	}
+	Flush
+	Data "==========English=========="
+	Decorated_Modules
+	Data "==========Ελληνικά=========="
+	Decorated_Modules ; Temperatures as TemperaturesGreek
+	Report$ = array([])#str$(chr$(13)+chr$(10))
+	ClipBoard Report$
+	Report Report$
+}
+Temprature_Conversions
diff --git a/Task/Temperature-conversion/Modula-2/temperature-conversion.mod2 b/Task/Temperature-conversion/Modula-2/temperature-conversion.mod2
new file mode 100644
index 0000000000..c8a92c3151
--- /dev/null
+++ b/Task/Temperature-conversion/Modula-2/temperature-conversion.mod2
@@ -0,0 +1,21 @@
+MODULE TempConv;
+(* Temperature conversion *)
+FROM STextIO IMPORT
+  SkipLine, WriteString, WriteLn;
+FROM SRealIO IMPORT
+  ReadReal, WriteFixed;
+
+VAR
+  K, C, F, R: REAL;
+BEGIN
+  WriteString("Temperature to convert (in Kelvin): ");
+  ReadReal(K);
+  SkipLine;
+  WriteString("K: "); WriteFixed(K, 3, 8); WriteLn;
+  C := K - 273.15;
+  WriteString("C: "); WriteFixed(C, 3, 8); WriteLn;
+  F := 1.8 * C + 32.0;
+  WriteString("F: "); WriteFixed(F, 3, 8); WriteLn;
+  R := F + 459.67;
+  WriteString("R: "); WriteFixed(R, 3, 8); WriteLn;
+END TempConv.
diff --git a/Task/Temperature-conversion/QBasic/temperature-conversion.basic b/Task/Temperature-conversion/QBasic/temperature-conversion.basic
index 1426c7f862..3c52236988 100644
--- a/Task/Temperature-conversion/QBasic/temperature-conversion.basic
+++ b/Task/Temperature-conversion/QBasic/temperature-conversion.basic
@@ -1,5 +1,6 @@
+' Temperature conversion
 DO
-	INPUT "Kelvin degrees (>=0): ", K
+  INPUT "Kelvin degrees (>=0): ", K
 LOOP UNTIL K >= 0
 
 PRINT "K = " + STR$(K)
diff --git a/Task/Temperature-conversion/Quite-BASIC/temperature-conversion.basic b/Task/Temperature-conversion/Quite-BASIC/temperature-conversion.basic
index 29be777622..b3f171c3b1 100644
--- a/Task/Temperature-conversion/Quite-BASIC/temperature-conversion.basic
+++ b/Task/Temperature-conversion/Quite-BASIC/temperature-conversion.basic
@@ -1,6 +1,6 @@
 10 PRINT "Kelvin Degrees ";
 20 INPUT ""; K
-30 IF K <= 0 THEN END
+30 IF K < 0 THEN END
 40 LET C = K-273.15
 50 LET F = K*1.8-459.67
 60 LET R = K*1.8
diff --git a/Task/Temperature-conversion/RapidQ/temperature-conversion.rapidq b/Task/Temperature-conversion/RapidQ/temperature-conversion.rapidq
new file mode 100644
index 0000000000..7bfc21528f
--- /dev/null
+++ b/Task/Temperature-conversion/RapidQ/temperature-conversion.rapidq
@@ -0,0 +1,13 @@
+'Temperature conversion
+DO
+  INPUT "Kelvin degrees "; K
+  IF K < 0 THEN EXIT DO
+  C = K - 273.15
+  F = K * 1.8 - 459.67
+  R = K * 1.8
+  PRINT K; " Kelvin is equivalent to"
+  PRINT C; " degrees Celsius,"
+  PRINT F; " degrees Fahrenheit,"
+  PRINT R; " degrees Rankine."
+LOOP
+END
diff --git a/Task/Temperature-conversion/ZX-Spectrum-Basic/temperature-conversion.basic b/Task/Temperature-conversion/ZX-Spectrum-Basic/temperature-conversion.basic
index ece2ed6d2f..054c96f4f8 100644
--- a/Task/Temperature-conversion/ZX-Spectrum-Basic/temperature-conversion.basic
+++ b/Task/Temperature-conversion/ZX-Spectrum-Basic/temperature-conversion.basic
@@ -1,6 +1,6 @@
 10 REM Translation of traditional basic version
 20 INPUT "Kelvin Degrees? ";k
-30 IF k <= 0 THEN STOP: REM A value of zero or less will end program
+30 IF k < 0 THEN STOP: REM A value less than zero will end program
 40 LET c = k - 273.15
 50 LET f = k * 1.8 - 459.67
 60 LET r = k * 1.8
diff --git a/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-1.basic b/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-1.basic
new file mode 100644
index 0000000000..6ae70540de
--- /dev/null
+++ b/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-1.basic
@@ -0,0 +1 @@
+GRAPHICS 0
diff --git a/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-2.basic b/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-2.basic
new file mode 100644
index 0000000000..8ea7b8fd47
--- /dev/null
+++ b/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-2.basic
@@ -0,0 +1 @@
+GR.0
diff --git a/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen.basic b/Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-3.basic
similarity index 100%
rename from Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen.basic
rename to Task/Terminal-control-Clear-the-screen/Atari-BASIC/terminal-control-clear-the-screen-3.basic
diff --git a/Task/Terminal-control-Clear-the-screen/M2000-Interpreter/terminal-control-clear-the-screen.m2000 b/Task/Terminal-control-Clear-the-screen/M2000-Interpreter/terminal-control-clear-the-screen.m2000
index 95de22772a..7b71240b4e 100644
--- a/Task/Terminal-control-Clear-the-screen/M2000-Interpreter/terminal-control-clear-the-screen.m2000
+++ b/Task/Terminal-control-Clear-the-screen/M2000-Interpreter/terminal-control-clear-the-screen.m2000
@@ -28,5 +28,20 @@ Module Checkit {
       Back {
             Cls 15 ' white border
       }
+	Declare form1 Form
+	With form1, "Title","My Window", "opacity", 200  ' 0 to 255 opacity for window
+	Layer form1 {
+		Window 20, 12000, 6000;
+		cls #ff0077, 0
+		pen 0
+		Cursor 0, height-1
+		Print Part $(2, width), "This is layer form1"
+	}
+	' Open form1 Modal
+	Title "", 0   ' hide console
+	Method form1, "show", 1
+	Title "done", 1 ' show console and change title on taskbar
+
+	Declare form1 Nothing
 }
 checkit
diff --git a/Task/Terminal-control-Clear-the-screen/Wren/terminal-control-clear-the-screen.wren b/Task/Terminal-control-Clear-the-screen/Wren/terminal-control-clear-the-screen.wren
index 27e558cc61..6cf0f22267 100644
--- a/Task/Terminal-control-Clear-the-screen/Wren/terminal-control-clear-the-screen.wren
+++ b/Task/Terminal-control-Clear-the-screen/Wren/terminal-control-clear-the-screen.wren
@@ -1 +1,3 @@
-System.print("\e[2J")
+import "./ansi" for Screen
+
+Screen.clear()
diff --git a/Task/Terminal-control-Coloured-text/FutureBasic/terminal-control-coloured-text.basic b/Task/Terminal-control-Coloured-text/FutureBasic/terminal-control-coloured-text.basic
new file mode 100644
index 0000000000..ff98e9547c
--- /dev/null
+++ b/Task/Terminal-control-Coloured-text/FutureBasic/terminal-control-coloured-text.basic
@@ -0,0 +1,42 @@
+// Terminal control/Coloured text
+// https://rosettacode.org/wiki/Terminal_control/Coloured_text#FreeBASIC
+
+_Window = 1
+
+window _Window,@"Flashing Colored Text",fn cgrectmake(0,0,400,400)
+windowcenter(_Window)
+WindowSetBackgroundColor(_Window,fn ColorBlack)
+
+bool FlashingColor
+
+local fn WordColors
+
+short Color
+
+IF FlashingColor = 0
+FlashingColor = 1
+ELSE
+FlashingColor = 0
+END IF
+cls
+for Color = 1 to 8
+if FlashingColor
+text @"Menlo",30,_zBlack,_zBlack
+print @(1,Color), @"Flashing Color"
+else
+if Color = 1 then text @"Menlo",30,_zYellow,_zBlue
+if Color = 2 then text @"Menlo",30,_zGreen,_zBlack
+if Color = 3 then text @"Menlo",30,_zCyan,_zYellow
+if Color = 4 then text @"Menlo",30,_zBlue,_zWhite
+if Color = 5 then text @"Menlo",30,_zMagenta,_zYellow
+if Color = 6 then text @"Menlo",30,_zRed,_zBlack
+if Color = 7 then text @"Menlo",30,_zWhite,_zBlue
+if Color = 8 then text @"Menlo",30,_zBrown,_zWhite
+print @(1,Color), @"Flashing Color"
+end if
+next Color
+end fn
+
+fn AppSetTimer( 1, @fn WordColors, _true )
+
+handleevents
diff --git a/Task/Terminal-control-Coloured-text/Wren/terminal-control-coloured-text.wren b/Task/Terminal-control-Coloured-text/Wren/terminal-control-coloured-text.wren
index 64494a8caf..f735201764 100644
--- a/Task/Terminal-control-Coloured-text/Wren/terminal-control-coloured-text.wren
+++ b/Task/Terminal-control-Coloured-text/Wren/terminal-control-coloured-text.wren
@@ -1,18 +1,19 @@
+import "./ansi" for Screen
 import "timer" for Timer
 
 var colors = ["Black", "Red", "Green", "Yellow", "Blue", "Magenta", "Cyan", "White"]
 
 // display words using 'bright' colors
-for (i in 1..7) System.print("\e[%(30+i);1m%(colors[i])") // red to white
-Timer.sleep(3000)         // wait for 3 seconds
-System.write("\e[47m")    // set background color to white
-System.write("\e[2J")     // clear screen to background color
-System.write("\e[H")      // home the cursor
+for (i in 1..7)  Screen.print(colors[i], colors[i]) // Red to White
+
+Timer.sleep(3000)            // wait for 3 seconds
+Screen.setBackColor("white") // set background color to white
+Screen.clear()               // clear screen to background color & home the cursor
 
 // display words again using 'blinking' colors
-System.write("\e[5m")     // blink on
-for (i in 0..6) System.print("\e[%(30+i);1m%(colors[i])") // black to cyan
-Timer.sleep(3000)         // wait for 3 more seconds
-System.write("\e[0m")     // reset all attributes
-System.write("\e[2J")     // clear screen to background color
-System.write("\e[H")      // home the cursor
+Screen.setStyle("blink")     // blink on
+for (i in 0..6) Screen.print(colors[i], colors[i]) // Black to Cyan
+
+Timer.sleep(3000)            // wait for 3 more seconds
+Screen.reset()               // reset all attributes
+Screen.clear()               // clear screen to background color & home the cursor
diff --git a/Task/Terminal-control-Cursor-movement/FutureBasic/terminal-control-cursor-movement.basic b/Task/Terminal-control-Cursor-movement/FutureBasic/terminal-control-cursor-movement.basic
new file mode 100644
index 0000000000..93dfedc204
--- /dev/null
+++ b/Task/Terminal-control-Cursor-movement/FutureBasic/terminal-control-cursor-movement.basic
@@ -0,0 +1,44 @@
+_window = 1
+_w = 80 : _h = 24
+window _window,@"Cursor Movement",fn cgrectmake(0,0,640,380)
+text @"Menlo", 13
+
+local fn LocateCursor(x as short,y as short,Character as CFStringRef)
+print @(x,y) Character;
+end fn
+
+// width is 80 characters
+// height is 24 rows
+
+
+short x,y
+
+// place cursor in the center to start
+x = _w/2 : y = _h/2
+print @(x,y) @" ";
+// Move cursor up one line
+y = y -1
+fn LocateCursor(x,y,@"U")
+// Move cursor left
+x = x - 1
+fn LocateCursor(x,y,@"L")
+// Move cursor down
+y = y + 1
+fn LocateCursor(x,y,@"D")
+// Move cursor right
+x = x + 1
+fn LocateCursor(x,y,@"R")
+// Move cursor to beginning of line
+x = 1
+fn LocateCursor(x,y,@"S")
+// Move cursor to end of line
+x = _w
+fn LocateCursor(x,y,@"E")
+// Move cursor to top left corner
+x = 1: y = 1
+fn LocateCursor(x,y,@"T")
+// Move cursor to bottom right corner
+x = _W: y = _h
+fn LocateCursor(x,y,@"B")
+
+handleevents
diff --git a/Task/Terminal-control-Cursor-movement/Wren/terminal-control-cursor-movement.wren b/Task/Terminal-control-Cursor-movement/Wren/terminal-control-cursor-movement.wren
index 523cc26569..e1ac92ac70 100644
--- a/Task/Terminal-control-Cursor-movement/Wren/terminal-control-cursor-movement.wren
+++ b/Task/Terminal-control-Cursor-movement/Wren/terminal-control-cursor-movement.wren
@@ -1,32 +1,23 @@
+import "./ansi" for Screen, Cursor
 import "timer" for Timer
-import "io" for Stdout
 
-System.write("\e[2J")     // clear terminal
-System.write("\e[12;40H") // move to (12, 40)
-Stdout.flush()
+Screen.clear()        // clear terminal
+Cursor.move(12, 40)   // move to (12, 40)
 Timer.sleep(2000)
-System.write("\e[D")      // move left
-Stdout.flush()
+Cursor.left           // move left
 Timer.sleep(2000)
-System.write("\e[C")      // move right
-Stdout.flush()
+Cursor.right          // move right
 Timer.sleep(2000)
-System.write("\e[A")      // move up
-Stdout.flush()
+Cursor.up             // move up
 Timer.sleep(2000)
-System.write("\e[B")      // move down
-Stdout.flush()
+Cursor.down           // move down
 Timer.sleep(2000)
-System.write("\e[G")      // move to beginning of line
-Stdout.flush()
+Cursor.column         // move to beginning of line
 Timer.sleep(2000)
-System.write("\e[79C")    // move to end of line (assuming 80 column terminal)
-Stdout.flush()
+Cursor.column(80)     // move to end of line (assuming 80 column terminal)
 Timer.sleep(2000)
-System.write("\e[1;1H")   // move to top left corner
-Stdout.flush()
+Cursor.home           // move to top left corner
 Timer.sleep(2000)
-System.write("\e[24;80H") // move to bottom right corner (assuming 80 x 24 terminal)
-Stdout.flush()
+Cursor.move(24, 80)   // move to bottom right corner (assuming 80 x 24 terminal)
 Timer.sleep(2000)
-System.write("\e[1;1H")   // home cursor again before quitting
+Cursor.home           // home cursor again before quitting
diff --git a/Task/Terminal-control-Cursor-positioning/FutureBasic/terminal-control-cursor-positioning.basic b/Task/Terminal-control-Cursor-positioning/FutureBasic/terminal-control-cursor-positioning.basic
new file mode 100644
index 0000000000..c9a87f16a9
--- /dev/null
+++ b/Task/Terminal-control-Cursor-positioning/FutureBasic/terminal-control-cursor-positioning.basic
@@ -0,0 +1,5 @@
+// Terminal control/Cursor positioning
+// https://rosettacode.org/wiki/Terminal_control/Cursor_positioning
+
+print @(3,6) @"Hello"
+handleevents
diff --git a/Task/Terminal-control-Cursor-positioning/Wren/terminal-control-cursor-positioning.wren b/Task/Terminal-control-Cursor-positioning/Wren/terminal-control-cursor-positioning.wren
index 5c80f0aa33..1f05a21453 100644
--- a/Task/Terminal-control-Cursor-positioning/Wren/terminal-control-cursor-positioning.wren
+++ b/Task/Terminal-control-Cursor-positioning/Wren/terminal-control-cursor-positioning.wren
@@ -1,2 +1,5 @@
-System.write("\e[2J")        // clear the terminal
-System.print("\e[6;3HHello") // move to (6, 3) and print 'Hello'
+import "./ansi" for Screen, Cursor
+
+Screen.clear()         // clear the terminal
+Cursor.move(6, 3)      // move to (6, 3)
+System.print("Hello")  // print 'Hello'
diff --git a/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions-1.wren b/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions-1.wren
deleted file mode 100644
index 29e4020676..0000000000
--- a/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions-1.wren
+++ /dev/null
@@ -1,12 +0,0 @@
-/* Terminal_control_Dimensions.wren */
-
-class C {
-    foreign static terminalWidth
-    foreign static terminalHeight
-}
-
-var w = C.terminalWidth
-var h = C.terminalHeight
-System.print("The dimensions of the terminal are:")
-System.print("   Width  = %(w)")
-System.print("   Height = %(h)")
diff --git a/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions-2.wren b/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions-2.wren
deleted file mode 100644
index 39adb409c6..0000000000
--- a/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions-2.wren
+++ /dev/null
@@ -1,94 +0,0 @@
-/* gcc Terminal_control_Dimensions.c -o Terminal_control_Dimensions -lwren -lm */
-
-#include 
-#include 
-#include 
-#include 
-#include 
-#include "wren.h"
-
-void C_terminalWidth(WrenVM* vm) {
-    struct winsize w;
-    ioctl(STDOUT_FILENO, TIOCGWINSZ, &w);
-    wrenSetSlotDouble(vm, 0, (double)w.ws_col);
-}
-
-void C_terminalHeight(WrenVM* vm) {
-    struct winsize w;
-    ioctl(STDOUT_FILENO, TIOCGWINSZ, &w);
-    wrenSetSlotDouble(vm, 0, (double)w.ws_row);
-}
-
-WrenForeignMethodFn bindForeignMethod(
-    WrenVM* vm,
-    const char* module,
-    const char* className,
-    bool isStatic,
-    const char* signature) {
-    if (strcmp(module, "main") == 0) {
-        if (strcmp(className, "C") == 0) {
-            if (isStatic && strcmp(signature, "terminalWidth") == 0) {
-                return C_terminalWidth;
-            } else if (isStatic && strcmp(signature, "terminalHeight") == 0) {
-                return C_terminalHeight;
-            }
-        }
-    }
-    return NULL;
-}
-
-static void writeFn(WrenVM* vm, const char* text) {
-    printf("%s", text);
-}
-
-void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) {
-    switch (errorType) {
-        case WREN_ERROR_COMPILE:
-            printf("[%s line %d] [Error] %s\n", module, line, msg);
-            break;
-        case WREN_ERROR_STACK_TRACE:
-            printf("[%s line %d] in %s\n", module, line, msg);
-            break;
-        case WREN_ERROR_RUNTIME:
-            printf("[Runtime Error] %s\n", msg);
-            break;
-    }
-}
-
-char *readFile(const char *fileName) {
-    FILE *f = fopen(fileName, "r");
-    fseek(f, 0, SEEK_END);
-    long fsize = ftell(f);
-    rewind(f);
-    char *script = malloc(fsize + 1);
-    fread(script, 1, fsize, f);
-    fclose(f);
-    script[fsize] = 0;
-    return script;
-}
-
-int main() {
-    WrenConfiguration config;
-    wrenInitConfiguration(&config);
-    config.writeFn = &writeFn;
-    config.errorFn = &errorFn;
-    config.bindForeignMethodFn = &bindForeignMethod;
-    WrenVM* vm = wrenNewVM(&config);
-    const char* module = "main";
-    const char* fileName = "Terminal_control_Dimensions.wren";
-    char *script = readFile(fileName);
-    WrenInterpretResult result = wrenInterpret(vm, module, script);
-    switch (result) {
-        case WREN_RESULT_COMPILE_ERROR:
-            printf("Compile Error!\n");
-            break;
-        case WREN_RESULT_RUNTIME_ERROR:
-            printf("Runtime Error!\n");
-            break;
-        case WREN_RESULT_SUCCESS:
-            break;
-    }
-    wrenFreeVM(vm);
-    free(script);
-    return 0;
-}
diff --git a/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions.wren b/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions.wren
new file mode 100644
index 0000000000..4b778214dd
--- /dev/null
+++ b/Task/Terminal-control-Dimensions/Wren/terminal-control-dimensions.wren
@@ -0,0 +1,6 @@
+import "os" for Terminal
+
+var size = Terminal.size
+System.print("The dimensions of the terminal are:")
+System.print("   Width  = %(size[1])")
+System.print("   Height = %(size[0])")
diff --git a/Task/Terminal-control-Display-an-extended-character/Aquarius-BASIC/terminal-control-display-an-extended-character.basic b/Task/Terminal-control-Display-an-extended-character/Aquarius-BASIC/terminal-control-display-an-extended-character.basic
new file mode 100644
index 0000000000..19850cc6f9
--- /dev/null
+++ b/Task/Terminal-control-Display-an-extended-character/Aquarius-BASIC/terminal-control-display-an-extended-character.basic
@@ -0,0 +1 @@
+PRINT CHR$(0)
diff --git a/Task/Terminal-control-Hiding-the-cursor/Atari-BASIC/terminal-control-hiding-the-cursor.basic b/Task/Terminal-control-Hiding-the-cursor/Atari-BASIC/terminal-control-hiding-the-cursor.basic
new file mode 100644
index 0000000000..f514d1ef6c
--- /dev/null
+++ b/Task/Terminal-control-Hiding-the-cursor/Atari-BASIC/terminal-control-hiding-the-cursor.basic
@@ -0,0 +1,9 @@
+5 GRAPHICS 0
+10 POKE 752,1:PRINT "hidden"
+20 GOSUB 100
+30 POKE 752,0:PRINT "visible"
+40 GOSUB 100
+50 END
+100 FOR I=1 TO 1500
+110 NEXT I
+120 RETURN
diff --git a/Task/Terminal-control-Hiding-the-cursor/FutureBasic/terminal-control-hiding-the-cursor.basic b/Task/Terminal-control-Hiding-the-cursor/FutureBasic/terminal-control-hiding-the-cursor.basic
new file mode 100644
index 0000000000..7f7402c267
--- /dev/null
+++ b/Task/Terminal-control-Hiding-the-cursor/FutureBasic/terminal-control-hiding-the-cursor.basic
@@ -0,0 +1,35 @@
+// Terminal control/Hiding the cursor
+// https://rosettacode.org/wiki/Terminal_control/Hiding_the_cursor#
+
+
+_window = 1
+begin enum 1
+  _scrollView
+  _textView
+end enum
+
+void local fn BuildWindow
+  CGRect r = fn NSMakeRect(0,0,550,400)
+  window _window, @"Hide Cursor", r
+  scrollview _scrollView, r
+  ViewSetAutoresizingMask( _scrollView, NSViewWidthSizable + NSViewHeightSizable )
+  textview _textView,, _scrollView
+  TextSetString( _textView, @"Cursor hides every two seconds. " )
+  WindowMakeFirstResponder( _window, _textView )
+end fn
+
+editmenu 1
+
+fn BuildWindow
+
+local fn HiddenCursorToggle
+  if fn TextViewIsEditable(_textView)
+    TextViewSetEditable(_textView,_false)
+  else
+    TextViewSetEditable(_textView,_true)
+  end if
+end fn
+
+fn AppSetTimer( 2, @Fn HiddenCursorToggle, _true )  // hide cursor every two seconds
+
+HandleEvents
diff --git a/Task/Terminal-control-Hiding-the-cursor/M2000-Interpreter/terminal-control-hiding-the-cursor.m2000 b/Task/Terminal-control-Hiding-the-cursor/M2000-Interpreter/terminal-control-hiding-the-cursor.m2000
new file mode 100644
index 0000000000..09bbe73e8e
--- /dev/null
+++ b/Task/Terminal-control-Hiding-the-cursor/M2000-Interpreter/terminal-control-hiding-the-cursor.m2000
@@ -0,0 +1,11 @@
+' Find and replace time for caret time out
+declare CR WINDOWS.REGISTRY
+const HKEY_CURRENT_USER = 0x80000001&
+const REG_DWORD = 4&					'32-bit number
+with CR, "ClassKey",  HKEY_CURRENT_USER
+with CR, "SectionKey", "Control Panel\Desktop\"
+with CR, "ValueType", REG_DWORD , "ValueKey", "CaretTimeout"
+with CR, "KeyExists" as CaretTimeout.Exist, "Value" as CaretTimeout.value
+If CaretTimeout.Exist then Print  "Old Value: 0x"+Hex$(uint(CaretTimeout.value),4)+"&", CaretTimeout.value
+CaretTimeout.value=0xFFFFFFFF&
+If CaretTimeout.Exist then Print  "New Value: 0x"+ Hex$(uint(CaretTimeout.value),4)+"&", CaretTimeout.value
diff --git a/Task/Terminal-control-Hiding-the-cursor/Wren/terminal-control-hiding-the-cursor.wren b/Task/Terminal-control-Hiding-the-cursor/Wren/terminal-control-hiding-the-cursor.wren
index cde8953be6..c8d35edc95 100644
--- a/Task/Terminal-control-Hiding-the-cursor/Wren/terminal-control-hiding-the-cursor.wren
+++ b/Task/Terminal-control-Hiding-the-cursor/Wren/terminal-control-hiding-the-cursor.wren
@@ -1,6 +1,7 @@
+import "./ansi" for Cursor
 import "timer" for Timer
 
-System.print("\e[?25l")
+Cursor.hide()
 Timer.sleep(3000)
-System.print("\e[?25h")
+Cursor.show()
 Timer.sleep(3000)
diff --git a/Task/Terminal-control-Inverse-video/Atari-BASIC/terminal-control-inverse-video.basic b/Task/Terminal-control-Inverse-video/Atari-BASIC/terminal-control-inverse-video.basic
new file mode 100644
index 0000000000..2b1e8d2894
--- /dev/null
+++ b/Task/Terminal-control-Inverse-video/Atari-BASIC/terminal-control-inverse-video.basic
@@ -0,0 +1,9 @@
+10 DIM S$(12),INV$(12)
+20 S$="Rosetta Code"
+30 FOR I=1 TO 12
+40 INV$(I)=CHR$(ASC(S$(I))+128)
+50 NEXT I
+60 GRAPHICS 0
+70 FOR I=1 TO 10
+80 PRINT S$,INV$
+90 NEXT I
diff --git a/Task/Terminal-control-Inverse-video/Wren/terminal-control-inverse-video.wren b/Task/Terminal-control-Inverse-video/Wren/terminal-control-inverse-video.wren
index 7510ce49de..dc43d69898 100644
--- a/Task/Terminal-control-Inverse-video/Wren/terminal-control-inverse-video.wren
+++ b/Task/Terminal-control-Inverse-video/Wren/terminal-control-inverse-video.wren
@@ -1,2 +1,4 @@
-System.print("\e[7mInverse")
-System.print("\e[0mNormal")
+import "./ansi" for Style
+
+System.print(Style.inverse("Inverse"))
+System.print("Normal")
diff --git a/Task/Terminal-control-Positional-read/Atari-BASIC/terminal-control-positional-read.basic b/Task/Terminal-control-Positional-read/Atari-BASIC/terminal-control-positional-read.basic
new file mode 100644
index 0000000000..1db55cf02b
--- /dev/null
+++ b/Task/Terminal-control-Positional-read/Atari-BASIC/terminal-control-positional-read.basic
@@ -0,0 +1,2 @@
+LOCATE 3,6,Q
+C$=CHR$(Q)
diff --git a/Task/Terminal-control-Preserve-screen/Wren/terminal-control-preserve-screen.wren b/Task/Terminal-control-Preserve-screen/Wren/terminal-control-preserve-screen.wren
index 2ce53fb648..9d4037f5e3 100644
--- a/Task/Terminal-control-Preserve-screen/Wren/terminal-control-preserve-screen.wren
+++ b/Task/Terminal-control-Preserve-screen/Wren/terminal-control-preserve-screen.wren
@@ -1,12 +1,11 @@
-import "io" for Stdout
+import "./ansi" for Screen
 import "timer" for Timer
 
-System.write("\e[?1049h\e[H")
+Screen.enableAltBuffer()
 System.print("Alternate screen buffer")
 for (i in 5..1) {
     var s = (i != 1) ? "s" : ""
-    System.write("\rGoing back in %(i) second%(s)...")
-    Stdout.flush()
+    Screen.fwrite("\rGoing back in %(i) second%(s)...")
     Timer.sleep(1000)
 }
-System.write("\e[?1049l")
+Screen.disableAltBuffer()
diff --git a/Task/Terminal-control-Ringing-the-terminal-bell/Atari-BASIC/terminal-control-ringing-the-terminal-bell.basic b/Task/Terminal-control-Ringing-the-terminal-bell/Atari-BASIC/terminal-control-ringing-the-terminal-bell.basic
new file mode 100644
index 0000000000..add5fbc2fb
--- /dev/null
+++ b/Task/Terminal-control-Ringing-the-terminal-bell/Atari-BASIC/terminal-control-ringing-the-terminal-bell.basic
@@ -0,0 +1 @@
+PRINT CHR$(253)
diff --git a/Task/Terminal-control-Ringing-the-terminal-bell/FutureBasic/terminal-control-ringing-the-terminal-bell.basic b/Task/Terminal-control-Ringing-the-terminal-bell/FutureBasic/terminal-control-ringing-the-terminal-bell.basic
new file mode 100644
index 0000000000..15e4e1bfb9
--- /dev/null
+++ b/Task/Terminal-control-Ringing-the-terminal-bell/FutureBasic/terminal-control-ringing-the-terminal-bell.basic
@@ -0,0 +1,2 @@
+beep
+handleevents
diff --git a/Task/Terminal-control-Unicode-output/FutureBasic/terminal-control-unicode-output.basic b/Task/Terminal-control-Unicode-output/FutureBasic/terminal-control-unicode-output.basic
new file mode 100644
index 0000000000..962dcdcbe7
--- /dev/null
+++ b/Task/Terminal-control-Unicode-output/FutureBasic/terminal-control-unicode-output.basic
@@ -0,0 +1,20 @@
+// Terminal control/Unicode output
+// https://rosettacode.org/wiki/Terminal_control/Unicode_output
+
+text @"Menlo" , 18
+
+print @"\U000025b3"
+
+if error
+  print "Unicode is not supported"
+else
+  cls
+  print
+  CFStringRef OutputString
+  OutputString = @"Unicode is supported and U+25B3 is "
+  OutputString = fn StringbyAppendingString(OutputString,@"\U000025b3")
+  print OutputString
+
+end if
+
+handleevents
diff --git a/Task/Terminal-control-Unicode-output/Go/terminal-control-unicode-output.go b/Task/Terminal-control-Unicode-output/Go/terminal-control-unicode-output.go
deleted file mode 100644
index 352b07df61..0000000000
--- a/Task/Terminal-control-Unicode-output/Go/terminal-control-unicode-output.go
+++ /dev/null
@@ -1,16 +0,0 @@
-package main
-
-import (
-    "fmt"
-    "os"
-    "strings"
-)
-
-func main() {
-    lang := strings.ToUpper(os.Getenv("LANG"))
-    if strings.Contains(lang, "UTF") {
-        fmt.Printf("This terminal supports unicode and U+25b3 is : %c\n", '\u25b3')
-    } else {
-        fmt.Println("This terminal does not support unicode")
-    }
-}
diff --git a/Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output-2.wren b/Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output-2.wren
deleted file mode 100644
index 6f00e2acd0..0000000000
--- a/Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output-2.wren
+++ /dev/null
@@ -1,92 +0,0 @@
-/* gcc Terminal_control_Unicode_output.c -o Terminal_control_Unicode_output -lwren -lm */
-
-#include 
-#include 
-#include 
-#include "wren.h"
-
-void C_isUnicodeSupported(WrenVM* vm) {
-    char *str = getenv("LANG");
-    bool us = false;
-    int i;
-    for (i = 0; str[i + 2] != 0; i++) {
-        if ((str[i] == 'u' && str[i + 1] == 't' && str[i + 2] == 'f') ||
-            (str[i] == 'U' && str[i + 1] == 'T' && str[i + 2] == 'F')) {
-            us = true;
-            break;
-        }
-    }
-    wrenSetSlotBool(vm, 0, us);
-}
-
-WrenForeignMethodFn bindForeignMethod(
-    WrenVM* vm,
-    const char* module,
-    const char* className,
-    bool isStatic,
-    const char* signature) {
-    if (strcmp(module, "main") == 0) {
-        if (strcmp(className, "C") == 0) {
-            if (isStatic && strcmp(signature, "isUnicodeSupported") == 0) {
-                return C_isUnicodeSupported;
-            }
-        }
-    }
-    return NULL;
-}
-
-static void writeFn(WrenVM* vm, const char* text) {
-    printf("%s", text);
-}
-
-void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) {
-    switch (errorType) {
-        case WREN_ERROR_COMPILE:
-            printf("[%s line %d] [Error] %s\n", module, line, msg);
-            break;
-        case WREN_ERROR_STACK_TRACE:
-            printf("[%s line %d] in %s\n", module, line, msg);
-            break;
-        case WREN_ERROR_RUNTIME:
-            printf("[Runtime Error] %s\n", msg);
-            break;
-    }
-}
-
-char *readFile(const char *fileName) {
-    FILE *f = fopen(fileName, "r");
-    fseek(f, 0, SEEK_END);
-    long fsize = ftell(f);
-    rewind(f);
-    char *script = malloc(fsize + 1);
-    fread(script, 1, fsize, f);
-    fclose(f);
-    script[fsize] = 0;
-    return script;
-}
-
-int main() {
-    WrenConfiguration config;
-    wrenInitConfiguration(&config);
-    config.writeFn = &writeFn;
-    config.errorFn = &errorFn;
-    config.bindForeignMethodFn = &bindForeignMethod;
-    WrenVM* vm = wrenNewVM(&config);
-    const char* module = "main";
-    const char* fileName = "Terminal_control_Unicode_output.wren";
-    char *script = readFile(fileName);
-    WrenInterpretResult result = wrenInterpret(vm, module, script);
-    switch (result) {
-        case WREN_RESULT_COMPILE_ERROR:
-            printf("Compile Error!\n");
-            break;
-        case WREN_RESULT_RUNTIME_ERROR:
-            printf("Runtime Error!\n");
-            break;
-        case WREN_RESULT_SUCCESS:
-            break;
-    }
-    wrenFreeVM(vm);
-    free(script);
-    return 0;
-}
diff --git a/Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output-1.wren b/Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output.wren
similarity index 56%
rename from Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output-1.wren
rename to Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output.wren
index 7c4cd972c3..8e96849d5e 100644
--- a/Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output-1.wren
+++ b/Task/Terminal-control-Unicode-output/Wren/terminal-control-unicode-output.wren
@@ -1,10 +1,6 @@
-/* Terminal_control_Unicode_output.wren */
+import "os" for Terminal
 
-class C {
-    foreign static isUnicodeSupported
-}
-
-if (C.isUnicodeSupported) {
+if (Terminal.supportsUnicode) {
     System.print("Unicode is supported on this terminal and U+25B3 is : \u25b3")
 } else {
     System.print("Unicode is not supported on this terminal.")
diff --git a/Task/Ternary-logic/EMal/ternary-logic.emal b/Task/Ternary-logic/EMal/ternary-logic.emal
new file mode 100644
index 0000000000..b3736975c3
--- /dev/null
+++ b/Task/Ternary-logic/EMal/ternary-logic.emal
@@ -0,0 +1,34 @@
+type Trit
+enum
+  int FALSE, MAYBE, TRUE
+  fun tNot ← <|Trit.byValue(Trit.TRUE.value - me.value)
+  fun tAnd ←  you.value, me, you)
+  fun tImp ←  1 }
+
+nwords = mapping.values.map(&.size).sum
+
+puts "There are #{nwords} words in #{filename} which can be represented by the digit key mapping."
+puts "They require #{mapping.size} digit combinations to represent them."
+puts "#{textonyms.size} digit combinations represent Textonyms."
+
+# let's find something original
+
+repeated = mapping.keys.select(/^(.)\1\1+$/).sort_by(&.size).reverse
+puts
+puts "Least-effort words"
+repeated.each do |w|
+  puts "  #{w}\t #{mapping[w].join(", ")}"
+end
diff --git a/Task/Thue-Morse/M2000-Interpreter/thue-morse-1.m2000 b/Task/Thue-Morse/M2000-Interpreter/thue-morse-1.m2000
deleted file mode 100644
index 21311dccfc..0000000000
--- a/Task/Thue-Morse/M2000-Interpreter/thue-morse-1.m2000
+++ /dev/null
@@ -1,42 +0,0 @@
-thuemorse$=lambda$ (n as integer)->{
-		def sb0$="0", sb1$="1"
-		n=max.data(0, n)
-		=lambda$
-			sb0$, sb1$,
-			n, park$
-			(many)->{
-			if n<0 and park$="" then exit
-			while n>0
-				tmp$=sb0$
-				sb0$=sb1$
-				sb1$=tmp$
-				n--
-			end while
-			if n>=0 then n-- :park$+=sb0$
-
-			if many"" then
-			log$=resp$+"...transmitted"+{
-			}
-		else
-			exit
-		end if
-	always
-next i
-Clipboard log$
-Report log$
diff --git a/Task/Thue-Morse/M2000-Interpreter/thue-morse-2.m2000 b/Task/Thue-Morse/M2000-Interpreter/thue-morse-2.m2000
deleted file mode 100644
index be88213690..0000000000
--- a/Task/Thue-Morse/M2000-Interpreter/thue-morse-2.m2000
+++ /dev/null
@@ -1,23 +0,0 @@
-// copy thuemorse lambda here//
-dim t$(0 to 6)
-document log$
-jobs=stack
-For i=6 to 0
-	t$(i)=thuemorse$(i)
-	stack jobs {push i}
-next i
-stack jobs {
-	while not empty
-		read i
-		resp$=t$(i)(16)
-		if resp$<>"" then
-			log$="Message :"+str$(i,0)+{
-			}		
-			log$=resp$+"...transmitted"+{
-			}
-			data i
-		end if
-	end while
-}
-Clipboard log$
-Report log$
diff --git a/Task/Thue-Morse/M2000-Interpreter/thue-morse.m2000 b/Task/Thue-Morse/M2000-Interpreter/thue-morse.m2000
new file mode 100644
index 0000000000..906fa64f00
--- /dev/null
+++ b/Task/Thue-Morse/M2000-Interpreter/thue-morse.m2000
@@ -0,0 +1,67 @@
+thuemorse$=lambda$ (n as integer)->{
+		def sb0$="0", sb1$="1"
+		n=max.data(0, n)
+		=lambda$
+			sb0$, sb1$,
+			n, park$
+			(many)->{
+			if n<0 and park$="" then exit
+			while n>0
+				tmp$=sb0$
+				sb0$+=sb1$
+				sb1$+=tmp$
+				n--
+			end while
+			if n>=0 then n-- :park$+=sb0$
+			if many"" then
+			Print batch$;   ' here we can do anything for each batch$
+		else
+			Print
+			exit
+		end if
+	always
+next i
+
+MODULE FromZX81_BASIC {
+// T$(J) -> mid$(T$, J, 1)
+// THEN GOTO 90  (is ok but here we use THEN 90)
+	 10 LET T$="0"
+	 20 PRINT "T0=";T$
+	 30 FOR I=1 TO 7
+	 40 PRINT "T";I;"=";
+	 50 FOR J=1 TO LEN(T$)
+	 60 IF MID$(T$,J, 1)="0" THEN 90
+	 70 LET T$=T$+"0"
+	 80 GOTO 100
+	 90 LET T$=T$+"1"
+	100 NEXT J
+	110 PRINT T$
+	120 NEXT I
+}
+FromZX81_BASIC
+Module Modern {
+	NextMorse=lambda t="0", s="", i=1 -> {
+			t+=replace$("b", "1", replace$("1", "0", replace$("0", "b", s)))
+			="T"+i+"="+t
+			i++ : s=t
+	}
+	for i=1 to 8
+		? NextMorse()
+	next
+}
+modern
diff --git a/Task/Tic-tac-toe/FutureBasic/tic-tac-toe.basic b/Task/Tic-tac-toe/FutureBasic/tic-tac-toe.basic
new file mode 100644
index 0000000000..766431995d
--- /dev/null
+++ b/Task/Tic-tac-toe/FutureBasic/tic-tac-toe.basic
@@ -0,0 +1,303 @@
+output file "Tic-Tac-Toe"
+
+_computer = 0
+_human    = 1
+
+_window = 1
+begin enum output 1
+  _one
+  _two
+  _three
+  _four
+  _five
+  _six
+  _seven
+  _eight
+  _nine
+
+  _infoField
+  _resetBtn
+end enum
+
+
+void local fn BuildWindow
+  int i
+
+  CGRect r = fn CGRectMake( 0, 0, 278, 348 )
+  window _window, @"Tic-Tac-Toe", r, NSWindowStyleMaskTitled + NSWindowStyleMaskClosable
+
+  r = fn CGRectMake( 20, 217, 80, 82 )
+  for i = _one to _three
+    button i,,,@"", r, NSButtonTypeMomentaryLight, NSBezelStyleTexturedSquare, _window
+    r = fn CGRectOffset( r, 79, 0 )
+  next
+  r = fn CGRectMake( 20, 139, 80, 82 )
+  for i = _four to _six
+    button i,,,@"", r, NSButtonTypeMomentaryLight, NSBezelStyleTexturedSquare, _window
+    r = fn CGRectOffset( r, 79, 0 )
+  next
+  r = fn CGRectMake( 20, 60, 80, 82 )
+  for i = _seven to _nine
+    button i,,,@"", r, NSButtonTypeMomentaryLight, NSBezelStyleTexturedSquare, _window
+    r = fn CGRectOffset( r, 79, 0 )
+  next
+
+  for i = _one to _nine
+    ControlSetFontWithName( i, @"Menlo", 60.0 )
+    ButtonSetTitle( i, @"" )
+    ViewSetClickGestureRecognizer( i )
+  next
+
+  r = fn CGRectMake( 20, 306, 240, 24 )
+  textfield _infoField,,,r, _window
+  TextFieldSetEditable(        _infoField, NO )
+  TextFieldSetSelectable(      _infoField, NO )
+  ControlSetAlignment(         _infoField, NSTextAlignmentCenter )
+  TextFieldSetDrawsBackground( _infoField, NO )
+  TextFieldSetBordered(        _infoField, NO )
+  TextFieldSetTextColor(       _infoField, fn ColorRed )
+  ControlSetFontWithName(      _infoField, @"Arial Bold", 18.0 )
+
+  r = fn CGRectMake( 155, 13, 109, 24 )
+  button _resetBtn,,,@"New Game", r, NSButtonTypeMomentaryLight, NSBezelStyleRounded, _window
+end fn
+
+
+void local fn LockBoard
+  for int i = _one to _nine
+    ButtonSetState( i, NSControlStateValueOn )
+  next
+end fn
+
+
+void local fn SetBtnTitleColor( tag1 as NSinteger, tag2 as NSinteger, tag3 as NSinteger, color as ColorRef )
+  ButtonSetTitleColor( tag1, color ) : ButtonSetTitleColor( tag2, color ) : ButtonSetTitleColor( tag3, color )
+end fn
+
+
+void local fn SetColorOfWinningCells( cellsToColor as NSUInteger )
+  select cellsToColor
+    // Rows 1-3
+    case 1 : fn SetBtnTitleColor( _one,   _two,   _three, fn ColorRed )
+    case 2 : fn SetBtnTitleColor( _four,  _five,  _six,   fn ColorRed )
+    case 3 : fn SetBtnTitleColor( _seven, _eight, _nine,  fn ColorRed )
+      // Columns 1-3
+    case 4 : fn SetBtnTitleColor( _one,   _four, _seven, fn ColorRed )
+    case 5 : fn SetBtnTitleColor( _two,   _five, _eight, fn ColorRed )
+    case 6 : fn SetBtnTitleColor( _three, _six,  _nine,  fn ColorRed )
+      // Diagonal _one to _nine and _three to _seven
+    case 7 : fn SetBtnTitleColor( _one,   _five, _nine,  fn ColorRed )
+    case 8 : fn SetBtnTitleColor( _three, _five, _seven, fn ColorRed )
+  end select
+end fn
+
+
+void local fn DeclareWinner( whoseTurn as NSInteger, cellsToColor as NSUinteger )
+  fn SetColorOfWinningCells( cellsToColor )
+  if ( whoseTurn == _computer )
+    fn LockBoard
+    ControlSetStringValue( _infoField, @"Macintosh won!" )
+  else
+    fn LockBoard
+    ControlSetStringValue( _infoField, @"You won!" )
+  end if
+end fn
+
+
+void local fn NewGame
+  ControlSetStringValue( _infoField, @"" )
+  for int i = _one to _nine
+    ButtonSetState( i, NSControlStateValueOff )
+    ButtonSetTitle( i, @"" )
+    ButtonSetTitleColor( i, fn ColorText )
+  next
+end fn
+
+
+BOOL local fn CheckCells( tag1 as NSInteger, mark1 as CFStringRef, tag2 as NSInteger,  mark2 as CFStringRef, tag3 as NSInteger, mark3 as CFStringRef )
+  BOOL result = NO
+  if fn StringIsEqual( fn ButtonTitle( tag1 ), mark1 ) && fn StringIsEqual( fn ButtonTitle( tag2 ), mark2 ) && fn StringIsEqual( fn ButtonTitle( tag3 ), mark3 ) then result = YES
+end fn = result
+
+
+BOOL local fn CheckForWinner( player as long ) as BOOL
+  CFStringRef  mark
+  BOOL         result = NO
+
+  if player == _human then mark = @"X" else mark = @"O"
+
+  // Check rows
+  if fn CheckCells( _one,   mark, _two,   mark, _three, mark ) then result = YES : fn DeclareWinner( player, 1 ) : exit fn
+  if fn CheckCells( _four,  mark, _five,  mark, _six,   mark ) then result = YES : fn DeclareWinner( player, 2 ) : exit fn
+  if fn CheckCells( _seven, mark, _eight, mark, _nine,  mark ) then result = YES : fn DeclareWinner( player, 3 ) : exit fn
+
+  // Check colums
+  if fn CheckCells( _one,   mark, _four,  mark, _seven, mark ) then result = YES : fn DeclareWinner( player, 4 ) : exit fn
+  if fn CheckCells( _two,   mark, _five,  mark, _eight, mark ) then result = YES : fn DeclareWinner( player, 5 ) : exit fn
+  if fn CheckCells( _three, mark, _six ,  mark, _nine,  mark ) then result = YES : fn DeclareWinner( player, 6 ) : exit fn
+
+  // Check _one, _five, _nine diagonal
+  if fn CheckCells( _one,  mark, _five,   mark, _nine,  mark ) then result = YES : fn DeclareWinner( player, 7 ) : exit fn
+
+  // Check _three, _five, _seven diagonal
+  if fn CheckCells( _three, mark, _five,  mark, _seven, mark ) then result = YES : fn DeclareWinner( player, 8 ) : exit fn
+end fn = result
+
+
+void local fn SetControls( tag as NSInteger )
+  ButtonSetTitle( tag, @"O" ) :  ButtonSetState( tag, NSControlStateValueOn )
+end fn
+
+
+void local fn ComputerMove
+  NSUInteger i
+  BOOL       loop = YES
+
+  /*
+  1 2 3
+  4 5 6
+  7 8 9
+  */
+
+  // Check row 1 for winning moves
+  if fn CheckCells( _one, @"",  _two, @"O" , _three, @"O" ) then  fn SetControls( _one   ) : exit fn
+  if fn CheckCells( _one, @"O", _two, @""  , _three, @"O" ) then  fn SetControls( _two   ) : exit fn
+  if fn CheckCells( _one, @"O", _two, @"O" , _three, @""  ) then  fn SetControls( _three ) : exit fn
+
+  // Check row 2 for winning moves
+  if fn CheckCells( _four, @"",  _five, @"O" , _six, @"O" ) then  fn SetControls( _four ) : exit fn
+  if fn CheckCells( _four, @"O", _five, @""  , _six, @"O" ) then  fn SetControls( _five ) : exit fn
+  if fn CheckCells( _four, @"O", _five, @"O" , _six, @""  ) then  fn SetControls( _six  ) : exit fn
+
+  // Check row 3 for winning moves
+  if fn CheckCells( _seven, @"",  _eight, @"O" , _nine, @"O" ) then  fn SetControls( _seven ) : exit fn
+  if fn CheckCells( _seven, @"O", _eight, @""  , _nine, @"O" ) then  fn SetControls( _eight ) : exit fn
+  if fn CheckCells( _seven, @"O", _eight, @"O" , _nine, @""  ) then  fn SetControls( _nine  ) : exit fn
+
+  // Check colmun 1 for winning moves
+  if fn CheckCells( _one, @"",  _four, @"O", _seven, @"O" ) then fn SetControls( _one   ) : exit fn
+  if fn CheckCells( _one, @"O", _four, @"",  _seven, @"O" ) then fn SetControls( _four  ) : exit fn
+  if fn CheckCells( _one, @"O", _four, @"O", _seven, @""  ) then fn SetControls( _seven ) : exit fn
+
+  // Check colmun 2 for winning moves
+  if fn CheckCells( _two, @"",  _five, @"O", _eight, @"O" ) then fn SetControls( _two   ) : exit fn
+  if fn CheckCells( _two, @"O", _five, @"",  _eight, @"O" ) then fn SetControls( _five  ) : exit fn
+  if fn CheckCells( _two, @"O", _five, @"O", _eight, @""  ) then fn SetControls( _eight ) : exit fn
+
+  // Check colmun 3 for winning moves
+  if fn CheckCells( _three, @"",  _six, @"O", _nine, @"O" ) then fn SetControls( _three ) : exit fn
+  if fn CheckCells( _three, @"O", _six, @"",  _nine, @"O" ) then fn SetControls( _six   ) : exit fn
+  if fn CheckCells( _three, @"O", _six, @"O", _nine, @""  ) then fn SetControls( _nine  ) : exit fn
+
+  // Check _one to _nine diagonal for winning moves
+  if fn CheckCells( _one, @"",  _five, @"O", _nine, @"O" ) then fn SetControls( _one  ) : exit fn
+  if fn CheckCells( _one, @"O", _five, @"",  _nine, @"O" ) then fn SetControls( _five ) : exit fn
+  if fn CheckCells( _one, @"O", _five, @"O", _nine, @""  ) then fn SetControls( _nine ) : exit fn
+
+  // Check _three to _nine diagonal for winning moves
+  if fn CheckCells( _three, @"",  _five, @"O", _seven, @"O" ) then fn SetControls( _three ) : exit fn
+  if fn CheckCells( _three, @"O", _five, @"",  _seven, @"O" ) then fn SetControls( _five  ) : exit fn
+  if fn CheckCells( _three, @"O", _five, @"O", _seven, @""  ) then fn SetControls( _seven ) : exit fn
+
+  // Check row 1 for blocking moves
+  if fn CheckCells( _one, @"",   _two, @"X", _three, @"X" ) then fn SetControls( _one   ) : exit fn
+  if fn CheckCells( _one, @"X",  _two, @"",  _three, @"X" ) then fn SetControls( _two   ) : exit fn
+  if fn CheckCells( _one, @"X",  _two, @"X", _three, @""  ) then fn SetControls( _three ) : exit fn
+
+  // Check row 2 for blocking moves
+  if fn CheckCells( _four, @"",   _five, @"X", _six, @"X" ) then fn SetControls( _four ) : exit fn
+  if fn CheckCells( _four, @"X",  _five, @"",  _six, @"X" ) then fn SetControls( _five ) : exit fn
+  if fn CheckCells( _four, @"X",  _five, @"X", _six, @""  ) then fn SetControls( _six  ) : exit fn
+
+  // Check row 3 for blocking moves
+  if fn CheckCells( _seven, @"",  _eight, @"X", _nine, @"X" ) then fn SetControls( _seven ) : exit fn
+  if fn CheckCells( _seven, @"X" ,_eight, @"",  _nine, @"X" ) then fn SetControls( _eight ) : exit fn
+  if fn CheckCells( _seven, @"X", _eight, @"X", _nine, @""  ) then fn SetControls( _nine  ) : exit fn
+
+  // Check colmun 1 for blocking moves
+  if fn CheckCells(  _one, @"",  _four, @"X", _seven, @"X" ) then fn SetControls( _one   ) : exit fn
+  if fn CheckCells(  _one, @"X", _four, @"",  _seven, @"X" ) then fn SetControls( _four  ) : exit fn
+  if fn CheckCells(  _one, @"X", _four, @"X", _seven, @""  ) then fn SetControls( _seven ) : exit fn
+
+  // Check colmun 2 for blocking moves
+  if fn CheckCells( _two, @"",  _five, @"X", _eight, @"X" ) then fn SetControls( _two   ) : exit fn
+  if fn CheckCells( _two, @"X", _five, @"",  _eight, @"X" ) then fn SetControls( _five  ) : exit fn
+  if fn CheckCells( _two, @"X", _five, @"X", _eight, @""  ) then fn SetControls( _eight ) : exit fn
+
+  // Check colmun 3 for blocking moves
+  if fn CheckCells( _three, @"",  _six, @"X", _nine, @"X" ) then fn SetControls( _three ) : exit fn
+  if fn CheckCells( _three, @"X", _six, @"",  _nine, @"X" ) then fn SetControls( _six   ) : exit fn
+  if fn CheckCells( _three, @"X", _six, @"X", _nine, @""  ) then fn SetControls( _nine  ) : exit fn
+
+  // Check _one, _five, _nine diagonal for blocking moves
+  if fn CheckCells( _one, @"",  _five, @"X", _nine, @"X" ) then fn SetControls( _one  ) : exit fn
+  if fn CheckCells( _one, @"X", _five, @"",  _nine, @"X" ) then fn SetControls( _five ) : exit fn
+  if fn CheckCells( _one, @"X", _five, @"X", _nine, @""  ) then fn SetControls( _nine ) : exit fn
+
+  // Check _three, _five, _nine diagonal for blocking moves
+  if fn CheckCells( _three, @"",   _five, @"X", _seven, @"X" ) then fn SetControls( _three ) : exit fn
+  if fn CheckCells( _three, @"X",  _five, @"",  _seven, @"X" ) then fn SetControls( _five  ) : exit fn
+  if fn CheckCells( _three, @"X" , _five, @"X", _seven, @""  ) then fn SetControls( _seven ) : exit fn
+
+  // If no winning or blocking moves found, select random empty button for computer move
+  for i = _one to _nine
+    if ( fn StringIsEqual( fn ButtonTitle(i), @"" ) )
+      while ( loop = YES )
+        i = rnd(9)
+        if ( fn StringIsEqual( fn ButtonTitle(i), @"" ) )
+          ButtonSetTitle( i, @"O" ) : ButtonSetState( i, NSControlStateValueOn )
+          loop = NO
+        end if
+      wend
+    end if
+  next
+end fn
+
+
+BOOL local fn CheckForTie
+  BOOL result = YES
+
+  for int i = _one to _nine
+    if ( fn StringIsEqual( fn ButtonTitle(i), @"" ) )
+      result = NO : exit fn
+    end if
+  next
+end fn = result
+
+
+void local fn Play( tag as long )
+  ButtonPerformClick( tag )
+  ButtonSetTitle( tag, @"X" ) : ButtonSetState( tag, NSControlStateValueOn )
+  if fn CheckForTie then fn LockBoard : ControlSetStringValue( _infoField, @"Tie Game!" )
+  if ( fn CheckForWinner( _human ) ==  NO ) then fn ComputerMove
+  if ( fn CheckForWinner( _computer ) == NO )
+    if fn CheckForTie then fn LockBoard : ControlSetStringValue( _infoField, @"Tie Game!" )
+  else
+    exit fn
+  end if
+end fn
+
+
+void local fn DoAppEvent( ev as long )
+  select (ev)
+    case _appWillFinishLaunching : fn BuildWindow
+  end select
+end fn
+
+
+void local fn DoDialog( ev as long, tag as long, wnd as long )
+  select (ev)
+    case _btnClick
+      select ( tag )
+        case _resetBtn : fn NewGame
+      end select
+    case _gestureRecognizerClick
+      if ( fn ButtonState( tag ) == NSControlStateValueOff ) then fn Play( tag )
+    case _windowWillClose : end
+  end select
+end fn
+
+on appevent fn DoAppEvent
+on dialog fn DoDialog
+
+HandleEvents
diff --git a/Task/Tic-tac-toe/J/tic-tac-toe-1.j b/Task/Tic-tac-toe/J/tic-tac-toe-1.j
index 69a658b77c..ef06e6f43c 100644
--- a/Task/Tic-tac-toe/J/tic-tac-toe-1.j
+++ b/Task/Tic-tac-toe/J/tic-tac-toe-1.j
@@ -5,4 +5,4 @@ move=. pos ($:@][echo@'no')`(-@turn@], turn@]`[`(board@])})@.open ]
 outcome=. 'tie'"_`(' wins',~ {&'.XO'@-@turn)@.won
 show=. [ ''echo@, '',~ (,' '&,)/"1@({&'.XO')@(3 3$board)
 won=. [: +./ 3 = [: | +/"1@(],|:,(<@0 1|:]),:<@0 1|:|.)@(3 3$board)
-ttt=: [: outcome [: [F.(show@move[_2:Z:won+.full) 10&{.@_1
+ttt=: [: outcome [: show@move^:(won-.@+.full)^:_. (10&{.@_1)
diff --git a/Task/Tic-tac-toe/J/tic-tac-toe-2.j b/Task/Tic-tac-toe/J/tic-tac-toe-2.j
index 325f65948e..10d907e113 100644
--- a/Task/Tic-tac-toe/J/tic-tac-toe-2.j
+++ b/Task/Tic-tac-toe/J/tic-tac-toe-2.j
@@ -1 +1 @@
-Until=. {{[F.(u[_2:Z:v)}}  NB. apply u until condition v is true
+Until=. {{u^:(-.@v)^:_.}}  NB. apply u until condition v is true
diff --git a/Task/Tic-tac-toe/J/tic-tac-toe-4.j b/Task/Tic-tac-toe/J/tic-tac-toe-4.j
deleted file mode 100644
index dc3238ad10..0000000000
--- a/Task/Tic-tac-toe/J/tic-tac-toe-4.j
+++ /dev/null
@@ -1 +0,0 @@
-{{u^:(-.@:v)^:_}}
diff --git a/Task/Tic-tac-toe/Modula-2/tic-tac-toe.mod2 b/Task/Tic-tac-toe/Modula-2/tic-tac-toe.mod2
new file mode 100644
index 0000000000..1e25cc5bfd
--- /dev/null
+++ b/Task/Tic-tac-toe/Modula-2/tic-tac-toe.mod2
@@ -0,0 +1,268 @@
+MODULE TicTacToe;
+
+FROM STextIO IMPORT
+  WriteLn, WriteString, ReadString, SkipLine;
+FROM SWholeIO IMPORT
+  WriteInt, ReadCard;
+FROM RandomNumbers IMPORT
+  Rnd;
+
+TYPE
+  TWinPos = ARRAY [0 .. 7], [0 .. 2] OF INTEGER; (* Winning positions *)
+  TMover = (Human, Computer, Nobody);
+
+CONST
+  WinPos = TWinPos{{0, 1, 2}, {3, 4, 5},
+                   {6, 7, 8}, {0, 3, 6},
+                   {1, 4, 7}, {2, 5, 8},
+                   {0, 4, 8}, {2, 4, 6}};
+
+VAR
+  Board    : ARRAY [0 .. 8] OF CHAR;
+  BestMove,
+  T        : INTEGER;
+  MyPiece,
+  HisPiece : CHAR;
+  CompFirst: BOOLEAN;
+  Mover    : TMover;
+  Answ     : ARRAY [0 .. 1] OF CHAR;
+  MyWinsCnt,
+  HisWinsCnt,
+  DrawsCnt,
+  MovesCnt,
+  I        : CARDINAL;
+
+PROCEDURE WriteStringLn(S: ARRAY OF CHAR);
+BEGIN
+  WriteString(S);
+  WriteLn
+END WriteStringLn;
+
+PROCEDURE SpacesFilled(): BOOLEAN;
+VAR
+  I: CARDINAL;
+BEGIN
+  FOR I := 0 TO 8 DO
+    IF Board[I] = " " THEN
+      RETURN FALSE;
+    END
+  END;
+  RETURN TRUE
+END SpacesFilled;
+
+PROCEDURE DisplayNumberedBoard;
+VAR
+  I  : CARDINAL;
+  Row: ARRAY [0 .. 10] OF CHAR;
+BEGIN
+  Row := " * | * | * ";
+  FOR I := 0 TO 8 BY 3 DO
+    Row[1] := CHR(I + 1 + ORD("0"));
+    Row[5] := CHR(I + 2 + ORD("0"));
+    Row[9] := CHR(I + 3 + ORD("0"));
+    WriteStringLn(Row);
+    IF I <> 6 THEN
+      WriteStringLn("---+---+---");
+    END;
+  END
+END DisplayNumberedBoard;
+
+PROCEDURE DisplayPiecedBoard;
+VAR
+  I  : CARDINAL;
+  Row: ARRAY [0 .. 10] OF CHAR;
+BEGIN
+  Row := " * | * | * ";
+  FOR I := 0 TO 8 BY 3 DO
+    Row[1] := Board[I];
+    Row[5] := Board[I + 1];
+    Row[9] := Board[I + 2];
+    WriteStringLn(Row);
+    IF I <> 6 THEN
+      WriteStringLn("---+---+---");
+    END;
+  END;
+END DisplayPiecedBoard;
+
+PROCEDURE Evaluate(Me: CHAR; Him: CHAR): INTEGER;
+  (* Recursive algorithm *)
+VAR
+  I       : CARDINAL;
+  SafeMove,
+  V,
+  LoseFlag: INTEGER;
+BEGIN
+  IF Win(Me) THEN
+    RETURN 1
+  END;
+  IF Win(Him) THEN
+    RETURN -1
+  END;
+  IF SpacesFilled() THEN
+    RETURN 0
+  END;
+  LoseFlag := 1;
+  I := 0;
+  WHILE I <= 8 DO
+    IF Board[I] = " " THEN
+      Board[I] := Me; (* Try the move. *)
+      V := Evaluate(Him, Me);
+      Board[I] := " "; (* Restore the empty space. *)
+      IF V = -1 THEN
+        BestMove := I;
+        RETURN 1
+      END;
+      IF V = 0 THEN
+        LoseFlag := 0;
+        SafeMove := I
+      END;
+    END;
+    I := I + 1;
+  END;
+  BestMove := SafeMove;
+  RETURN -LoseFlag
+END Evaluate;
+
+PROCEDURE Win(Piece: CHAR): BOOLEAN;
+VAR
+  I: CARDINAL;
+BEGIN
+  FOR I := 0 TO 7 DO
+    IF (Board[WinPos[I, 0]] = Piece) AND
+       (Board[WinPos[I, 1]] = Piece) AND
+       (Board[WinPos[I, 2]] = Piece) THEN
+      RETURN TRUE
+    END;
+  END;
+  RETURN FALSE
+END Win;
+
+PROCEDURE ClearBoard;
+VAR
+  I: CARDINAL;
+BEGIN
+  FOR I := 0 TO 8 DO
+    Board[I] := " "
+  END;
+END ClearBoard;
+
+PROCEDURE WriteSummary(What: ARRAY OF CHAR; Cnt: CARDINAL);
+BEGIN
+  WriteString(What);
+  WriteInt(Cnt, 1);
+  WriteString(" game");
+  IF Cnt <> 1 THEN
+    WriteStringLn("s.");
+  ELSE
+    WriteStringLn(".");
+  END;
+END WriteSummary;
+
+BEGIN
+  MyWinsCnt := 0;
+  HisWinsCnt := 0;
+  DrawsCnt := 0;
+  CompFirst := TRUE; (* It be reversed, so in fact human goes first *)
+  WriteLn;
+  WriteStringLn("            TIC-TAC-TOE");
+  WriteLn;
+  WriteStringLn("In this version, X always goes first.");
+  WriteStringLn("The board is numbered:");
+  REPEAT
+    CompFirst := NOT CompFirst; (* reverse who goes first *)
+    MovesCnt := 0;
+    WriteLn;
+    DisplayNumberedBoard;
+    WriteLn;
+    IF CompFirst THEN
+      WriteStringLn("I go first.");
+    ELSE
+      WriteString("You go first.");
+    END;
+    WriteLn;
+    ClearBoard;
+    IF CompFirst THEN
+      MyPiece := "X";
+      HisPiece := "O"
+    ELSE
+      MyPiece := "O";
+      HisPiece := "X"
+    END;
+    IF CompFirst THEN
+      Mover := Computer
+    ELSE
+      Mover := Human
+    END;
+    WHILE Mover <> Nobody DO
+      CASE Mover OF
+      | Computer:
+          IF MovesCnt = 0 THEN
+            BestMove := Rnd(9)
+          ELSIF MovesCnt = 1 THEN
+            IF Board[4] <> " " THEN
+              BestMove := Rnd(2) * 6 + Rnd(2) * 2 (* 0, 2, 6, or 8 *)
+            ELSE
+              BestMove := 4
+            END
+          ELSE
+            T := Evaluate(MyPiece, HisPiece)
+          END;
+          Board[BestMove] := MyPiece;
+          MovesCnt := MovesCnt + 1;
+          WriteLn;
+          DisplayPiecedBoard;
+          WriteLn;
+          IF Win(MyPiece) THEN
+            MyWinsCnt := MyWinsCnt + 1;
+            WriteStringLn("I win!");
+            Mover := Nobody
+          ELSIF SpacesFilled() THEN
+            DrawsCnt := DrawsCnt + 1;
+            WriteStringLn("It's a draw. Thank you.");
+            Mover := Nobody
+          ELSE
+            Mover := Human
+          END
+      | Human:
+          LOOP
+            WriteString("Where do you move? ");
+            ReadCard(I);
+            SkipLine;
+            IF (I < 1) OR (I > 9) THEN
+              WriteString("Illegal! ");
+            ELSIF Board[I - 1] <> " " THEN
+              WriteString("Place already occupied. ");
+            ELSE
+              EXIT
+            END
+          END;
+          Board[I - 1] := HisPiece;
+          MovesCnt := MovesCnt + 1;
+          WriteLn;
+          DisplayPiecedBoard;
+          WriteLn;
+          IF Win(HisPiece) THEN
+            HisWinsCnt := HisWinsCnt + 1;
+            WriteStringLn("You beat me! Good game.");
+            Mover := Nobody
+          ELSIF SpacesFilled() THEN
+            DrawsCnt := DrawsCnt + 1;
+            WriteStringLn("It's a draw. Thank you.");
+            Mover := Nobody
+          ELSE
+            Mover := Computer
+          END;
+      END (* CASE *)
+    END; (* WHILE *)
+    WriteLn;
+    WriteString("Another game (y/n)? ");
+    ReadString(Answ);
+    SkipLine
+  UNTIL CAP(Answ[0]) <> "Y";
+  WriteLn;
+  WriteStringLn("Final score:");
+  WriteSummary("You won ", MyWinsCnt);
+  WriteSummary("I won ", MyWinsCnt);
+  WriteSummary("We tied ", DrawsCnt);
+  WriteStringLn("See you later!");
+END TicTacToe.
diff --git a/Task/Tokenize-a-string/Draco/tokenize-a-string.draco b/Task/Tokenize-a-string/Draco/tokenize-a-string.draco
new file mode 100644
index 0000000000..3e3570310a
--- /dev/null
+++ b/Task/Tokenize-a-string/Draco/tokenize-a-string.draco
@@ -0,0 +1,24 @@
+proc tokenize(char sep; *char str; [*]*char parts) word:
+    word n;
+    n := 0;
+    while
+        parts[n] := str;
+        while str* /= sep and str* /= '\e' do str := str + 1 od;
+        n := n+1;
+        str* /= '\e'
+    do
+        str* := '\e';
+        str := str + 1
+    od;
+    n
+corp
+
+proc main() void:
+    word i, count;
+    [10]*char parts;
+    count := tokenize(',', "Hello,How,Are,You,Today", parts);
+    for i from 0 upto count-1 do
+        write(parts[i], ". ")
+    od;
+    writeln()
+corp
diff --git a/Task/Topological-sort/FreeBASIC/topological-sort-1.basic b/Task/Topological-sort/FreeBASIC/topological-sort-1.basic
new file mode 100644
index 0000000000..ab9fb12fd5
--- /dev/null
+++ b/Task/Topological-sort/FreeBASIC/topological-sort-1.basic
@@ -0,0 +1,150 @@
+Type Pair
+    primero As Integer
+    segundo As Integer
+End Type
+
+Type Graph
+    vertices(14) As String
+    numVertices As Integer
+    proximos(14, 14) As Boolean
+
+    Declare Constructor(s As String, edges() As Pair)
+    Declare Function hasDependency(r As Integer, todo() As Integer, todoCount As Integer) As Boolean
+    Declare Function topoSort() As String
+End Type
+
+Function splitString(text As String, delimiter As String, Byref count As Integer) As String Ptr
+    Dim As Integer numTokens = 0
+    Dim As String tmp = text
+    Dim As Long posic
+
+    ' Count delimiters
+    Do
+        posic = Instr(tmp, delimiter)
+        If posic = 0 Then Exit Do
+        numTokens += 1
+        tmp = Mid(tmp, posic + Len(delimiter))
+    Loop
+    numTokens += 1
+
+    ' Allocate array
+    count = numTokens
+    Dim As String Ptr result = Callocate((numTokens) * Sizeof(String))
+
+    ' Split string
+    tmp = text
+    numTokens = 0
+    Do
+        posic = Instr(tmp, delimiter)
+        If posic = 0 Then
+            result[numTokens] = tmp
+            Exit Do
+        End If
+        result[numTokens] = Left(tmp, posic - 1)
+        tmp = Mid(tmp, posic + Len(delimiter))
+        numTokens += 1
+    Loop
+
+    Return result
+End Function
+
+Constructor Graph(s As String, edges() As Pair)
+    Dim As Integer i, tokenCount
+    Dim As String Ptr tokens = splitString(s, ", ", tokenCount)
+    numVertices = tokenCount
+    For i = 0 To numVertices - 1
+        vertices(i) = tokens[i]
+    Next
+    Deallocate(tokens)
+
+    ' Initialize proximos matrix
+    For i = 0 To Ubound(edges)
+        proximos(edges(i).primero, edges(i).segundo) = True
+    Next
+End Constructor
+
+Function Graph.hasDependency(r As Integer, todo() As Integer, todoCount As Integer) As Boolean
+    For i As Integer = 0 To todoCount - 1
+        If proximos(r, todo(i)) Then Return True
+    Next
+    Return False
+End Function
+
+Function Graph.topoSort() As String
+    Dim As String result = ""
+    Dim As Integer todoCount, i, j
+    Dim As Integer todo(numVertices)
+
+    todoCount = numVertices
+    ' Initialize todo list
+    For i = 0 To numVertices - 1
+        todo(i) = i
+    Next
+
+    While todoCount > 0
+        i = 0
+        Dim As Boolean found = False
+
+        While i < todoCount
+            If Not hasDependency(todo(i), todo(), todoCount) Then
+                ' Add to result
+                If Len(result) > 0 Then result &= ", "
+                result &= vertices(todo(i))
+
+                ' Remove from todo
+                For j = i To todoCount - 2
+                    todo(j) = todo(j + 1)
+                Next
+                todoCount -= 1
+                found = True
+                Exit While
+            End If
+            i += 1
+        Wend
+
+        If Not found Then Return "Graph has cycles"
+    Wend
+
+    Return "[" & result & "]"
+End Function
+
+' Main program
+Dim As String s = "std, ieee, des_system_lib, dw01, dw02, dw03, dw04, dw05, " & _
+"dw06, dw07, dware, gtech, ramlib, std_cell_lib, synopsys"
+
+Dim As Pair deps(33)
+' Initialize deps array
+deps(0) = Type(2, 0)  : deps(1) = Type(2, 14)
+deps(2) = Type(2, 13) : deps(3) = Type(2, 4)
+deps(4) = Type(2, 3)  : deps(5) = Type(2, 12)
+deps(6) = Type(2, 1)  : deps(7) = Type(3, 1)
+deps(8) = Type(3, 10) : deps(9) = Type(3, 11)
+deps(10) = Type(4, 1)  : deps(11) = Type(4, 10)
+deps(12) = Type(5, 0)  : deps(13) = Type(5, 14)
+deps(14) = Type(5, 10) : deps(15) = Type(5, 4)
+deps(16) = Type(5, 3)  : deps(17) = Type(5, 1)
+deps(18) = Type(5, 11) : deps(19) = Type(6, 1)
+deps(20) = Type(6, 3)  : deps(21) = Type(6, 10)
+deps(22) = Type(6, 11) : deps(23) = Type(7, 1)
+deps(24) = Type(7, 10) : deps(25) = Type(8, 1)
+deps(26) = Type(8, 10) : deps(27) = Type(9, 1)
+deps(28) = Type(9, 10) : deps(29) = Type(10, 1)
+deps(30) = Type(11, 1) : deps(31) = Type(12, 0)
+deps(32) = Type(12, 1) : deps(33) = Type(13, 1)
+
+Dim As Graph g = Graph(s, deps())
+Print "Topologically sorted order:"
+Print g.topoSort()
+Print
+
+' Add new dependency
+For i As Integer = 33 To 11 Step -1
+    deps(i) = deps(i-1)
+Next
+deps(10) = Type(3, 6)
+
+Dim As Graph g2 = Graph(s, deps())
+Print "Following the addition of dw04 to the dependencies of dw01:"
+Print g2.topoSort()
+
+Sleep
diff --git a/Task/Topological-sort/FreeBASIC/topological-sort-2.basic b/Task/Topological-sort/FreeBASIC/topological-sort-2.basic
new file mode 100644
index 0000000000..3a7c952646
--- /dev/null
+++ b/Task/Topological-sort/FreeBASIC/topological-sort-2.basic
@@ -0,0 +1,168 @@
+Const NULL As Any Ptr = 0
+
+Type item_t
+    As String nombre
+    As Integer Ptr deps
+    As Integer n_deps
+    As Integer  idx
+    As Integer depth
+End Type
+
+Dim Shared As String entrada
+entrada = "des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee" & Chr(10) & _
+"dw01             ieee dw01 dware gtech" & Chr(10) & _
+"dw02             ieee dw02 dware" & Chr(10) & _
+"dw03             std synopsys dware dw03 dw02 dw01 ieee gtech" & Chr(10) & _
+"dw04             dw04 ieee dw01 dware gtech" & Chr(10) & _
+"dw05             dw05 ieee dware" & Chr(10) & _
+"dw06             dw06 ieee dware" & Chr(10) & _
+"dw07             ieee dware" & Chr(10) & _
+"dware            ieee dware" & Chr(10) & _
+"gtech            ieee gtech" & Chr(10) & _
+"ramlib           std ieee" & Chr(10) & _
+"std_cell_lib     ieee std_cell_lib" & Chr(10) & _
+"synopsys" & Chr(10) & _
+"cycle_11         cycle_12" & Chr(10) & _
+"cycle_12         cycle_11" & Chr(10) & _
+"cycle_21         dw01 cycle_22 dw02 dw03" & Chr(10) & _
+"cycle_22         cycle_21 dw01 dw04" & Chr(10)
+
+Function get_item(list() As item_t, Byref longi As Integer, nombre As String) As Integer
+    Dim As Integer i
+    For i = 0 To longi - 1
+        If list(i).nombre = nombre Then Return i
+    Next
+
+    longi += 1
+    Redim Preserve list(longi - 1)
+    i = longi - 1
+    list(i).idx = i
+    list(i).nombre = nombre
+    list(i).n_deps = 0
+    list(i).deps = NULL
+    list(i).depth = 0
+    Return i
+End Function
+
+Sub add_dep(Byref it As item_t, i As Integer)
+    If it.idx = i Then Return
+    it.deps = Reallocate(it.deps, (it.n_deps + 1) * Sizeof(Integer))
+    it.deps[it.n_deps] = i
+    it.n_deps += 1
+End Sub
+
+Function parse_input(ret() As item_t) As Integer
+    Dim As Integer i, parent, idx, n_items, posic, nextpos
+    Dim As item_t list()
+    Dim As String s, linea, word
+
+    n_items = 0
+    s = entrada
+
+    Do While Len(s) > 0
+        posic = Instr(s, Chr(10))
+        If posic = 0 Then
+            linea = s
+            s = ""
+        Else
+            linea = Left(s, posic - 1)
+            s = Mid(s, posic + 1)
+        End If
+
+        i = 0
+        While Len(linea) > 0
+            linea = Trim(linea)
+            If Len(linea) = 0 Then Exit While
+
+            posic = Instr(linea, " ")
+            If posic = 0 Then
+                word = linea
+                linea = ""
+            Else
+                word = Left(linea, posic - 1)
+                linea = Mid(linea, posic + 1)
+            End If
+
+            If Len(word) > 0 Then
+                idx = get_item(list(), n_items, word)
+
+                If i = 0 Then
+                    parent = idx
+                Else
+                    add_dep(list(parent), idx)
+                End If
+                i += 1
+            End If
+        Wend
+    Loop
+
+    Redim ret(n_items - 1)
+    For i = 0 To n_items - 1
+        ret(i) = list(i)
+    Next
+
+    Return n_items
+End Function
+
+Function get_depth(base_() As item_t, idx As Integer, bad As Integer) As Integer
+    Dim As Integer max = 1, i, t
+
+    If base_(idx).n_deps = 0 Then
+        base_(idx).depth = 1
+        Return 1
+    End If
+
+    If base_(idx).depth < 0 Then Return base_(idx).depth
+    If base_(idx).depth > 0 Then Return base_(idx).depth
+
+    base_(idx).depth = bad
+    For i = 0 To base_(idx).n_deps - 1
+        t = get_depth(base_(), base_(idx).deps[i], bad)
+        If t < 0 Then
+            max = t
+            Exit For
+        End If
+        If max < t + 1 Then max = t + 1
+    Next
+
+    base_(idx).depth = max
+    Return max
+End Function
+
+' Main program
+Dim As Integer i, j, n, bad = -1, max = -1000000, min = 1000000
+Dim As item_t items()
+
+n = parse_input(items())
+
+For i = 0 To n - 1
+    If items(i).depth = 0 And get_depth(items(), i, bad) < 0 Then bad -= 1
+Next
+
+For i = 0 To n - 1
+    If items(i).depth > max Then max = items(i).depth
+    If items(i).depth < min Then min = items(i).depth
+Next
+
+Print "Compile order:"
+For i = min To max
+    If i = 0 Then Continue For
+
+    If i < 0 Then
+        Print "   [unorderable]";
+    Else
+        Print i; ":";
+    End If
+
+    For j = 0 To n - 1
+        If items(j).depth = i Then Print " "; items(j).nombre;
+    Next
+    Print
+Next
+
+' Clean up memory
+For i = 0 To n - 1
+    If items(i).deps <> NULL Then Deallocate(items(i).deps)
+Next
+
+Sleep
diff --git a/Task/Totient-function/C/totient-function.c b/Task/Totient-function/C/totient-function.c
index 30c486665e..cb00793627 100644
--- a/Task/Totient-function/C/totient-function.c
+++ b/Task/Totient-function/C/totient-function.c
@@ -1,51 +1,52 @@
-/*Abhishek Ghosh, 7th December 2018*/
+#include 
 
-#include
-
-int totient(int n){
-	int tot = n,i;
+int
+totient(int n)
+{
+	int result = n;
 	
-	for(i=2;i*i<=n;i+=2){
-		if(n%i==0){
-			while(n%i==0)
-				n/=i;
-			tot-=tot/i;
+	for (int i=2; i*i <= n; i+=2) {
+		if (n % i == 0) {
+			while (n % i == 0)
+				n /= i;
+			result -= result / i;
 		}
 		
-		if(i==2)
-			i=1;
+		if (i == 2)
+			i = 1;
 	}
 	
-	if(n>1)
-		tot-=tot/n;
-	
-	return tot;
+	if (n > 1)
+		result -= result / n;
+	return result;
 }
 
-int main()
+int
+main(void)
 {
-	int count = 0,n,tot;
+	int count, n, tot;
 	
-	printf(" n    %c   prime",237);
-        printf("\n---------------\n");
-	
-	for(n=1;n<=25;n++){
+	printf(" n  phi  prime\n");
+    printf("--------------\n");
+
+	count = 0;
+	for (n = 1; n <= 25; n++) {
 		tot = totient(n);
 		
-		if(n-1 == tot)
+		if (tot == n - 1)
 			count++;
 		
-		printf("%2d   %2d   %s\n", n, tot, n-1 == tot?"True":"False");
+		printf("%2d   %2d   %s\n", n, tot, tot == (n-1) ? "true" : "false");
 	}
-	
-	printf("\nNumber of primes up to %6d =%4d\n", 25,count);
-	
-	for(n = 26; n <= 100000; n++){
+
+	printf("\n");
+
+	for (n = 26; n <= 100000; n++) {
         tot = totient(n);
-        if(tot == n-1)
+        if (tot == n-1)
 			count++;
 
-        if(n == 100 || n == 1000 || n%10000 == 0){
+        if (n == 100 || n == 1000 || n == 10000) {
             printf("\nNumber of primes up to %6d = %4d\n", n, count);
         }
     }
diff --git a/Task/Totient-function/EasyLang/totient-function.easy b/Task/Totient-function/EasyLang/totient-function.easy
index 89d13455e1..56f5cd9c90 100644
--- a/Task/Totient-function/EasyLang/totient-function.easy
+++ b/Task/Totient-function/EasyLang/totient-function.easy
@@ -1,21 +1,15 @@
-func totient n .
+fastfunc totient n .
    tot = n
    i = 2
    while i <= sqrt n
       if n mod i = 0
-         while n mod i = 0
-            n = n div i
-         .
+         while n mod i = 0 : n = n div i
          tot -= tot div i
       .
-      if i = 2
-         i = 1
-      .
+      if i = 2 : i = 1
       i += 2
    .
-   if n > 1
-      tot -= tot div n
-   .
+   if n > 1 : tot -= tot div n
    return tot
 .
 numfmt 0 3
@@ -23,17 +17,13 @@ print "  N Prim Phi"
 for n = 1 to 25
    tot = totient n
    x$ = "    "
-   if n - 1 = tot
-      x$ = " x  "
-   .
+   if n - 1 = tot : x$ = " x  "
    print n & x$ & tot
 .
 print ""
 for n = 1 to 100000
    tot = totient n
-   if n - 1 = tot
-      cnt += 1
-   .
+   if n - 1 = tot : cnt += 1
    if n = 100 or n = 1000 or n = 10000 or n = 100000
       print n & " - " & cnt & " primes"
    .
diff --git a/Task/Totient-function/PascalABC.NET/totient-function.pas b/Task/Totient-function/PascalABC.NET/totient-function.pas
new file mode 100644
index 0000000000..ceb9bc55f1
--- /dev/null
+++ b/Task/Totient-function/PascalABC.NET/totient-function.pas
@@ -0,0 +1,17 @@
+uses school;
+
+function totient(n: int64) := (1..n).Select(k -> (if gcd(n, k) = 1 then 1 else 0)).Sum;
+
+function is_prime(n: int64) := totient(n) = n - 1;
+
+begin
+  foreach var n in 1..25 do
+    writeln('φ(', n, ') = ', totient(n), if is_prime(n) then ', is prime' else '');
+  var count := 0;
+  foreach var n in 1..100_000 do
+  begin
+    count += if is_prime(n) then 1 else 0;
+    if n in |100, 1000, 10_000, 100_000| then
+      writeln('Primes up to ', n, ': ', count);
+  end;
+end.
diff --git a/Task/Towers-of-Hanoi/Fortran/towers-of-hanoi-2.f b/Task/Towers-of-Hanoi/Fortran/towers-of-hanoi-2.f
index 59f3275359..c586e17ac8 100644
--- a/Task/Towers-of-Hanoi/Fortran/towers-of-hanoi-2.f
+++ b/Task/Towers-of-Hanoi/Fortran/towers-of-hanoi-2.f
@@ -1,19 +1,140 @@
-PROGRAM TOWER2
+!	This is a nice alternative to the usual recursive Hanoi solutions. It runs about 10x
+!       faster than a well crafted recursive solution for 30 disks.
+      SUBROUTINE olives(Numdisk)
+!>  This is an implementation of "Olive's Algorithm"
+!!  The “simpler” algorithm where the smallest disk moves circularly every second
+!!  move is attributed to Raoul Olive, the nephew of Edouard Lucas, the inventor of the
+!!  Towers of Hanoi puzzle. We alternately move disk one in it's established direction
+!!  Then we move the one of the 'non-one' disks, depending on the legality of the move.
+!!  In this implementation, I use a small array of the stack entities. This allows us
+!!  to easily find the stack where the disk to be moved resides.
+      USE data_defs
+      IMPLICIT NONE
+!
+! PARAMETER definitions
+!
+      INTEGER(int32) , PARAMETER  ::  bigm = maxpos*3
+!
+! Dummy arguments
+!
+      INTEGER(int32)  ::  Numdisk
+      INTENT (IN) Numdisk
+!
+! Local variables
+!
+      TYPE(stack) , POINTER  ::  a , b , c , on_now   !< on_now is where disk 1 is
+      TYPE(stack) , TARGET , DIMENSION(3) ::  abc !< The three stack are put in an array for identification i.e. abc(1)%stack_id = 1
+      INTEGER  ::  direction !< Direction of disk1, negative is counter clockwise, positive = clockwise
+      INTEGER(int32)  ::  i , j
 
-  CALL Move(4, 1, 2, 3)
+      DATA(abc(i)%height , i = 1 , 3)/3*0/
+      DATA(abc(i)%stack_id , i = 1 , 3)/1 , 2 , 3/
+      DATA((abc(i)%disks(j),i = 1,3) , j = 1 , maxpos)/bigm*0/
+! Code starts here
+!
+! Move numdisks from A to C using B as intermediate
+!
+      a => abc(1)
+      b => abc(2)
+      c => abc(3)
+      on_now => a   !< Point to the starting pole
+      a%height = Numdisk    !< A = the starting pole
+!
+      last_move = -1
+!
+      a%disks = [(Numdisk + 1 - j, j = 1, Numdisk)]
 
-CONTAINS
+      IF( btest(Numdisk,0) )THEN        !< First move rule always involves disk 1, test odd/even for first move
+         CALL move(a , c)
+         direction = -1         ! Counter clockwise
+         on_now => c
+      ELSE
+         CALL move(a , b)
+         direction = 1          ! Clockwise
+         on_now => b
+      END IF
+!
+      DO WHILE ( c%height/=Numdisk )
+!
+         SELECT CASE(on_now%stack_id)   !< Depending where disk one is, make a legal move
+         CASE(1)    !< One is on stack 1 i.e. a so we can only make a legal move in between b and c
+            IF( legal(b,c) )THEN
+               CALL move(b , c)
+            ELSE
+               CALL move(c , b)
+            END IF
+         CASE(2)                        ! Disk one on stack 2 i.e. "b"
+            IF( legal(a,c) )THEN
+               CALL move(a , c)
+            ELSE
+               CALL move(c , a)
+            END IF
+         CASE(3)                        ! Disk one on stack 3 i.e. "c"
+            IF( legal(a,b) )THEN
+               CALL move(a , b)
+            ELSE
+               CALL move(b , a)
+            END IF
+         END SELECT
 
-  RECURSIVE SUBROUTINE Move(ndisks, from, via, to)
-    INTEGER, INTENT (IN) :: ndisks, from, via, to
+!< Now move disk 1 in the direction it was heading
+         i = on_now%stack_id + direction       !< Increment the stack a->b->c->a or vice versa Decrement the stack c->b->a->c
+!< Note that here we use the stack_id to figure out which disk destination to use. As we increment or decrement the stack counter
+!! we reset it to the correct disk when it is outside the 1..3 range. It is set so as to maintain the correct disk direction.
+         SELECT CASE(i)
+         CASE(0)
+            i = 3
+         CASE(1:3)
+         CASE(4)
+            i = 1
+         END SELECT
 
-    IF (ndisks > 1) THEN
-       CALL Move(ndisks-1, from, to, via)
-       WRITE(*, "(A,I1,A,I1,A,I1)") "Move disk ", ndisks, "  from pole ", from, " to pole ", to
-       Call Move(ndisks-1,via,from,to)
-    ELSE
-       WRITE(*, "(A,I1,A,I1,A,I1)") "Move disk ", ndisks, "  from pole ", from, " to pole ", to
-    END IF
-  END SUBROUTINE Move
+         CALL move(on_now , abc(i))
+         on_now => abc(i)
+      END DO
+      PRINT '(*(i0,2x))' , (c%disks(i) , i = 1 , Numdisk) ! Print final disk configuration
+      on_now => null()
+!
+      RETURN
+      END SUBROUTINE olives
+      SUBROUTINE Move(Donor , Receiver)
+      USE Data_defs
+      IMPLICIT NONE
 
-END PROGRAM TOWER2
+! Dummy arguments
+!
+      TYPE(stack)  ::  Donor , Receiver
+      INTENT (INOUT) Donor , Receiver
+! Code starts here
+!$GCC$ attributes INLINE :: MOVE
+!
+! Code starts here
+      last_move = Receiver%Stack_id
+      Receiver%Height = Receiver%Height + 1           ! make slot in receiver
+      Receiver%Disks(Receiver%Height) = Donor%Disks(Donor%Height)     !Move the disk
+      Donor%Disks(Donor%Height) = 0                   ! Black it out
+      Donor%Height = Donor%Height - 1                 ! Decrement the donor height
+      RETURN
+      END SUBROUTINE Move
+    Module data_defs
+      IMPLICIT NONE
+!
+! PARAMETER definitions
+!
+      INTEGER , PARAMETER  ::  int32 = selected_int_kind(8) , &
+                             & int64 = selected_int_kind(16)
+
+      INTEGER(int32) , PARAMETER  ::  maxpos = 40        ! Maximum possible disks without a huge blowout
+!
+! Derived Type definitions
+!
+      TYPE :: stack
+         INTEGER(int32)  ::  stack_id
+         INTEGER(int32)  ::  height
+         INTEGER(int32) , DIMENSION(maxpos)  ::  disks
+      END TYPE stack
+!
+! Local variables
+!
+      INTEGER  ::  last_move              ! Holds the destination of the last move
+      end module data_defs
diff --git a/Task/Trabb-Pardo-Knuth-algorithm/C/trabb-pardo-knuth-algorithm.c b/Task/Trabb-Pardo-Knuth-algorithm/C/trabb-pardo-knuth-algorithm.c
index 0d6b84598b..6db5923277 100644
--- a/Task/Trabb-Pardo-Knuth-algorithm/C/trabb-pardo-knuth-algorithm.c
+++ b/Task/Trabb-Pardo-Knuth-algorithm/C/trabb-pardo-knuth-algorithm.c
@@ -1,37 +1,34 @@
-#include
-#include
+#include 
+#include 
 
-int
-main ()
+double f(double x)
+{
+  return sqrt(fabs(x)) + 5 * pow(x, 3);
+}
+
+int main()
 {
   double inputs[11], check = 400, result;
   int i;
 
-  printf ("\nPlease enter 11 numbers :");
-
+  printf ("\nPlease enter 11 numbers: ");
   for (i = 0; i < 11; i++)
-    {
-      scanf ("%lf", &inputs[i]);
-    }
-
-  printf ("\n\n\nEvaluating f(x) = |x|^0.5 + 5x^3 for the given inputs :");
-
+  {
+    scanf ("%lf", &inputs[i]);
+  }
+  printf ("\n\n\nEvaluating f(x) = |x|^0.5 + 5x^3 for the given inputs:");
   for (i = 10; i >= 0; i--)
+  {
+    result = f(inputs[i]);
+    printf ("\nf(%lf) = ", inputs[i]);
+    if (result > check)
     {
-      result = sqrt (fabs (inputs[i])) + 5 * pow (inputs[i], 3);
-
-      printf ("\nf(%lf) = ");
-
-      if (result > check)
-        {
-          printf ("Overflow!");
-        }
-
-      else
-        {
-          printf ("%lf", result);
-        }
+      printf ("Overflow!");
     }
-
+    else
+    {
+      printf ("%lf", result);
+    }
+  }
   return 0;
 }
diff --git a/Task/Tree-datastructures/M2000-Interpreter/tree-datastructures.m2000 b/Task/Tree-datastructures/M2000-Interpreter/tree-datastructures.m2000
new file mode 100644
index 0000000000..f2716ec3bf
--- /dev/null
+++ b/Task/Tree-datastructures/M2000-Interpreter/tree-datastructures.m2000
@@ -0,0 +1,88 @@
+module Tree_datastructures (a$){
+	terminal=(,)
+	document b$, all$=a$
+	report a$
+	nl$={
+		}
+	tree=@MakeTree(a$)
+	traverseTree(tree)
+	report b$
+	all$=b$
+	clear b$
+	TraverseTreeIndent(tree)
+	report b$
+	all$=b$
+	print b$=a$
+	all$=(b$=a$)+nl$
+	clipboard all$
+	end
+	sub TraverseTree(t as array, Level=1)
+		b$=Level+" "+t#val$(0)+nl$
+		local i
+		for i=1 to len(t)-1
+			if t#val(i) is terminal else TraverseTree(t#val(i), Level+1)
+		next
+	end sub
+	sub TraverseTreeIndent(t as array, Level=0)
+		b$=string$("....", Level) +t#val$(0)+nl$
+		local i
+		for i=1 to len(t)-1
+			if t#val(i) is terminal else TraverseTreeIndent(t#val(i), Level+1)
+		next
+	end sub
+	function MakeTree(a$)
+		local a$(), c$
+		a$()=piece$(a$, nl$)
+		local child=terminal, tree=(a$(0),terminal)
+		local Level=2, i, j
+		flush
+		for i=1 to len(a$())-1
+			if len(a$(i))=0 then continue
+			for j=1 to len(a$(i)) div 2
+				if left$(a$(i), j*4)<>string$(".", j*4) then
+					c$=mid$(a$(i), (j-1)*4+1)
+					exit for
+				end if
+			next j
+			while j50  Degrees to Radians
+* 23.12.2024 WP made Methods public
 **********************************************************************/
-.local~my.rxm=.rxm~new(16,"D")
+.local~my.rxm=.rxm~new(50,"R")
 
 ::Class rxm Public
 
-::Method init
+::Method init Public
   Expose precision type
   Use Arg  precision=(digits()),type='D'
 
@@ -40,13 +42,14 @@
 
 ::attribute type get
 
-::Method arccos
+::Method arccos Public
 /***********************************************************************
 * Return arccos(x,precision,type) -- with specified precision
 * arccos(x) = pi/2 - arcsin(x)
 ***********************************************************************/
   Expose precision type
   Use Strict Arg x,xprec=(precision),xtype=(type)
+  xtype=translate(xtype)
   iprec=xprec+10
   Numeric Digits iprec
   If x=1 Then
@@ -68,13 +71,14 @@
   Numeric Digits xprec
   Return (r+0)
 
-::Method arcsin
+::Method arcsin Public
 /***********************************************************************
 * Return arcsin(x,precision,type) -- with specified precision
 * arcsin(x) = x+(x**3)*1/2*3+(x**5)*1*3/2*4*5+(x**7)*1*3*5/2*4*6*7+...
 ***********************************************************************/
   Expose precision type
   Use Strict Arg x,xprec=(precision),xtype=(type)
+  xtype=translate(xtype)
   iprec=xprec+10
   Numeric Digits iprec
   sign=sign(x)
@@ -131,7 +135,7 @@
   Numeric Digits xprec
   Return sign*(r+0)
 
-::Method arctan
+::Method arctan Public
 /***********************************************************************
 * Return arctan(x,precision,type) -- with specified precision
 * x=0 -> arctan(x) = 0
@@ -144,6 +148,7 @@
 ***********************************************************************/
   Expose precision type
   Use Strict Arg x,xprec=(precision),xtype=(type)
+  xtype=translate(xtype)
   iprec=xprec+10
   Numeric Digits iprec
   Select
@@ -171,7 +176,7 @@
   Numeric Digits xprec
   Return (r+0)
 
-::Method arsinh
+::Method arsinh Public
 /***********************************************************************
 * Return arsinh(x,precision,type) -- with specified precision
 * arsinh(x) = ln(x+sqrt(x**2+1))
@@ -185,13 +190,14 @@
   Numeric Digits xprec
   Return (r+0)
 
-::Method cos
+::Method cos Public
 /* REXX *************************************************************
 * Return cos(x,precision,type) -- with the specified precision
 * cos(x)=sin(x+pi/2)
 ********************************************************************/
   Expose precision type
   Use Strict Arg x,xprec=(precision),xtype=(type)
+  xtype=translate(xtype)
   iprec=xprec+10
   Numeric Digits iprec
   Select
@@ -203,7 +209,7 @@
   Numeric Digits xprec
   Return (r+0)
 
-::Method cosh
+::Method cosh Public
 /* REXX ****************************************************************
 * Return cosh(x,precision,type) -- with specified precision
 * cosh(x) = 1+(x**2/2!)+(x**4/4!)+(x**6/6!)+-...
@@ -224,13 +230,14 @@
   Numeric Digits xprec
   Return (r+0)
 
-::Method cotan
+::Method cotan Public
 /* REXX *************************************************************
 * Return cotan(x,precision,type) -- with the specified precision
 * cot(x)=cos(x)/sin(x)
 ********************************************************************/
   Expose precision type
   Use Strict Arg x,xprec=(precision),xtype=(type)
+  xtype=translate(xtype)
   iprec=xprec+10
   Numeric Digits iprec
   s=self~sin(x,iprec,xtype)
@@ -241,7 +248,7 @@
   Numeric Digits xprec
   Return (r+0)
 
-::Method exp
+::Method exp Public
 /***********************************************************************
 * exp(x,precision) returns e**x -- with specified precision
 * exp(x,precision,base) returns base**x -- with specified precision
@@ -288,7 +295,7 @@
   Numeric Digits xprec
   Return (r+0)
 
-::Method log
+::Method log Public
 /***********************************************************************
 * log(x,precision) -- returns ln(x) with specified precision
 * log(x,precision,base) -- returns blog(x) with specified precision
@@ -328,7 +335,7 @@
     End
   Return r
 
-::Method ln2p
+::Method ln2p Public
   Parse Arg p
   Numeric Digits p+10
   If p<=1000 Then
@@ -344,8 +351,13 @@
     ln=newln
     End
 
-::Method LN2
-
+::Method LN2 Public
+    V = ''
+    V = V || 0.69314718055994530941723212145817656807
+    V = V || 5500134360255254120680009493393621969694
+    V = V || 7156058633269964186875420014810205706857
+    V = V || 3368552023575813055703267075163507596193
+    V = V || 0727570828371435190307038623891673471123350
 v=''
 v=v||0.69314718055994530941723212145817656807
 v=v||5500134360255254120680009493393621969694
@@ -375,7 +387,7 @@ v=v||231467232172053401649256872747782344535348
 
     return V
 
-::Method log10
+::Method log10 Public
 /***********************************************************************
 * Return log10(x,prec)  specified precision
 ***********************************************************************/
@@ -386,7 +398,7 @@ v=v||231467232172053401649256872747782344535348
   Numeric Digits xprec
   Return (r+0)
 
-::Method pi
+::Method pi Public
 /* REXX *************************************************************
 * Return pi with the specified precision
 ********************************************************************/
@@ -432,7 +444,7 @@ v=v||231467232172053401649256872747782344535348
   Numeric Digits xprec
   Return (p+0)
 
-::Method power
+::Method power Public
 /***********************************************************************
 * power(base,exponent,precision) returns base**exponent
 *                                            -- with specified precision
@@ -449,7 +461,7 @@ v=v||231467232172053401649256872747782344535348
       End
     Else Do                            /* Exponent is not an integer */
 --    Say 'for a negative base ('||b')',
---                           'exponent ('c') must be an integer'
+                           'exponent ('c') must be an integer'
       Return 'nan'                     /* Return not a number        */
       End
     End
@@ -463,7 +475,7 @@ v=v||231467232172053401649256872747782344535348
     Return r
   Return rsign*r
 
-::Method sqrt
+::Method sqrt Public
 /* REXX *************************************************************
 * Return sqrt(x,precision) -- with the specified precision
 ********************************************************************/
@@ -483,7 +495,7 @@ v=v||231467232172053401649256872747782344535348
   Numeric Digits xprec
   Return (r+0)
 
-::Method sin
+::Method sin Public
 /* REXX *************************************************************
 * Return sin(x,precision,type) -- with the specified precision
 * xtype = 'R' (radians, default) 'D' (degrees) 'G' (grades)
@@ -491,7 +503,8 @@ v=v||231467232172053401649256872747782344535348
 ********************************************************************/
   Expose precision type
   Use Strict Arg x,xprec=(precision),xtype=(type)
-  iprec=xprec+10                       /* internal precision         */
+  xtype=translate(xtype)
+  iprec=xprec+20                       /* internal precision         */
   Numeric Digits iprec
   /* first use pi constant or compute it if necessary                */
   pi=self~pi(iprec)
@@ -539,7 +552,7 @@ v=v||231467232172053401649256872747782344535348
   Numeric Digits xprec
   Return sign*(r+0)
 
-::Method sinh
+::Method sinh Public
 /* REXX ****************************************************************
 * Return sinh(x,precision) -- with specified precision
 * sinh(x) = x+(x**3/3!)+(x**5/5!)+(x**7/7!)+-...
@@ -561,13 +574,14 @@ v=v||231467232172053401649256872747782344535348
   Numeric Digits xprec
   Return (r+0)
 
-::Method tan
+::Method tan Public
 /* REXX *************************************************************
 * Return tan(x,precision,type) -- with the specified precision
 * tan(x)=sin(x)/cos(x)
 ********************************************************************/
   Expose precision type
   Use Strict Arg x,xprec=(precision),xtype=(type)
+  xtype=translate(xtype)
   iprec=xprec+10
   Numeric Digits iprec
   s=self~sin(x,iprec,xtype)
@@ -578,7 +592,7 @@ v=v||231467232172053401649256872747782344535348
   Numeric Digits xprec
   Return (t+0)
 
-::Method tanh
+::Method tanh Public
 /***********************************************************************
 * Return tanh(x,precision) -- with specified precision
 * tanh(x) = sinh(x)/cosh(x)
@@ -593,6 +607,7 @@ v=v||231467232172053401649256872747782344535348
 
 ::routine rxmarccos public
   Use Strict Arg x,xprec=(.my.rxm~precision),xtype=(.my.rxm~type)
+  xtype=translate(xtype)
 
   If datatype(x,'NUM')=0 Then Do
 --  Say 'Argument 1 must be a number'
@@ -616,6 +631,7 @@ v=v||231467232172053401649256872747782344535348
 
 ::routine rxmarcsin public
   Use Strict Arg x,xprec=(.my.rxm~precision),xtype=(.my.rxm~type)
+  xtype=translate(xtype)
 
   If datatype(x,'NUM')=0 Then Do
 --  Say 'Argument 1 must be a number'
@@ -709,7 +725,6 @@ v=v||231467232172053401649256872747782344535348
 --  Say 'Argument 3 must be R, D, or G'
     Raise Syntax 88.907 array(3,'R, D, or G',xtype)
     End
-
   return .my.rxm~cos(x,xprec,xtype)
 
 ::routine rxmcosh public
diff --git a/Task/Trigonometric-functions/REXX/trigonometric-functions.rexx b/Task/Trigonometric-functions/REXX/trigonometric-functions-1.rexx
similarity index 100%
rename from Task/Trigonometric-functions/REXX/trigonometric-functions.rexx
rename to Task/Trigonometric-functions/REXX/trigonometric-functions-1.rexx
diff --git a/Task/Trigonometric-functions/REXX/trigonometric-functions-2.rexx b/Task/Trigonometric-functions/REXX/trigonometric-functions-2.rexx
new file mode 100644
index 0000000000..98903eb4fc
--- /dev/null
+++ b/Task/Trigonometric-functions/REXX/trigonometric-functions-2.rexx
@@ -0,0 +1,42 @@
+include Settings
+
+say version; say 'Trigonometric functions'; say
+s = Copies('-',77); w = 18
+call Trigo
+call Arcus1
+call Arcus2
+exit
+
+Trigo:
+say s
+say 'Deg' Left('Rad',w) Left('Sin(Rad)',w) Left('Cos(Rad)',w) Left('Tan(Rad)',w)
+say s
+do a = 0 by 5 to 90
+   b = Rad(a)
+   say Left(a,3) Left(b/1,w) Left(Sin(b)/1,w) Left(Cos(b)/1,w) Left(Tan(b)/1,w)
+end
+say s
+return
+
+Arcus1:
+say Left('Arg',4) Left('Arcsin(Arg)',w) Left('Arccos(Arg)',w) Left('Arctan(Arg)',w)
+say s
+do b = -1 by 0.1 to 1
+   say Left(b,4) Left(Arcsin(b)/1,w) Left(Arccos(b)/1,w) Left(Arctan(b)/1,w)
+end
+say s
+return
+
+Arcus2:
+say 'Deg' Left('Rad',w) Left('Arcsin(Sin(Rad))',w) Left('Arccos(Cos(Rad))',w) Left('Arctan(Tan(Rad))',w)
+say s
+do a = 0 by 5 to 90
+   b = Rad(a)
+   say Left(a,3) Left(b/1,w) Left(Arcsin(Sin(b))/1,w) Left(Arccos(Cos(b))/1,w) Left(Arctan(Tan(b))/1,w)
+end
+say s
+return
+
+include Functions
+include Constants
+include Abend
diff --git a/Task/Trigonometric-functions/Uiua/trigonometric-functions.uiua b/Task/Trigonometric-functions/Uiua/trigonometric-functions.uiua
new file mode 100644
index 0000000000..5dd41768b4
--- /dev/null
+++ b/Task/Trigonometric-functions/Uiua/trigonometric-functions.uiua
@@ -0,0 +1,20 @@
+a       ← ÷4π
+b       ← ÷π ×180 a
+Cos     ← ∿+η
+Tangent ← ÷∩∿+η.
+Arcsin  ← °∿
+Arccos  ← -:η°∿
+"Radians:"
+∿ a # sine
+Cos a
+Tangent a
+Arcsin ∿ a
+Arccos Cos a
+∠ Tangent a 1
+"Degrees:"
+∿ ×π ÷180 b
+Cos ×π ÷180 b
+Tangent ×π ÷180 b
+Arcsin∿ ×π ÷180 b
+Arccos Cos ×π ÷180 b
+∠ Tangent ×π ÷180 b 1
diff --git a/Task/Truncatable-primes/Raku/truncatable-primes.raku b/Task/Truncatable-primes/Raku/truncatable-primes.raku
index 888a7cd3bf..2b7c62ed02 100644
--- a/Task/Truncatable-primes/Raku/truncatable-primes.raku
+++ b/Task/Truncatable-primes/Raku/truncatable-primes.raku
@@ -1,10 +1,14 @@
-constant ltp = $[2, 3, 5, 7], -> @ltp {
-    $[ grep { .&is-prime }, ((1..9) X~ @ltp) ]
+constant ltp = [2, 3, 5, 7], {
+    last if .not;
+    [ ((1..9) X~ @$_).grep: &is-prime ]
 } ... *;
 
-constant rtp = $[2, 3, 5, 7], -> @rtp {
-    $[ grep { .&is-prime }, (@rtp X~ (1..9)) ]
+constant rtp = [2, 3, 5, 7], {
+    last if .not;
+    [ (@$_ X~ (1,3,7,9)).grep: &is-prime ]
 } ... *;
 
-say "Highest ltp = ", ltp[5][*-1];
-say "Highest rtp = ", rtp[5][*-1];
+say "Largest ltp < 1e6 = ", ltp[5][*-1];
+say "Largest rtp < 1e6 = ", rtp[5][*-1];
+say "Largest possible ltp = ", ltp.eager.flat.tail;
+say "Largest possible rtp = ", rtp.eager.flat.tail;
diff --git a/Task/Truth-table/FreeBASIC/truth-table.basic b/Task/Truth-table/FreeBASIC/truth-table.basic
new file mode 100644
index 0000000000..884134aa3e
--- /dev/null
+++ b/Task/Truth-table/FreeBASIC/truth-table.basic
@@ -0,0 +1,219 @@
+Dim Shared As Integer Variables(26)
+Dim Shared As Integer ExprStack(255)
+Dim Shared As Integer OpStack(255)
+Dim Shared As Integer OpPrecedence(6)
+Dim Shared As String Operators(6)
+Dim Shared As String VarList
+Dim Shared As Integer exprPos, stackPos, idx, combos
+
+' Initialize operator data with aliases
+Operators(1) = "!"   : OpPrecedence(1) = 4 ' NOT (both ~ and !)
+Operators(2) = "&"   : OpPrecedence(2) = 3 ' AND
+Operators(3) = "|"   : OpPrecedence(3) = 2 ' OR
+Operators(4) = "^"   : OpPrecedence(4) = 2 ' XOR
+Operators(5) = "=>"  : OpPrecedence(5) = 1 ' IMPLIES
+Operators(6) = "<="  : OpPrecedence(6) = 1 ' CONVERSE
+
+Sub EvaluateExpression()
+    Dim As Integer typeFlag, value
+    stackPos = 0
+
+    For idx = 0 To exprPos-1
+        typeFlag = ExprStack(idx) And 224
+        value = ExprStack(idx) And 31
+
+        Select Case typeFlag
+        Case 0  ' Operator
+            Select Case value
+            Case 1  ' NOT
+                If stackPos < 1 Then Print "Missing operand": Exit Sub
+                OpStack(stackPos-1) = 1 - OpStack(stackPos-1)
+            Case 2  ' AND
+                If stackPos < 2 Then Print "Missing operand": Exit Sub
+                stackPos -= 1
+                OpStack(stackPos-1) = OpStack(stackPos-1) And OpStack(stackPos)
+            Case 3  ' OR
+                If stackPos < 2 Then Print "Missing operand": Exit Sub
+                stackPos -= 1
+                OpStack(stackPos-1) = OpStack(stackPos-1) Or OpStack(stackPos)
+            Case 4  ' XOR
+                If stackPos < 2 Then Print "Missing operand": Exit Sub
+                stackPos -= 1
+                OpStack(stackPos-1) = OpStack(stackPos-1) Xor OpStack(stackPos)
+            Case 5  ' IMPLIES
+                If stackPos < 2 Then Print "Missing operand": Exit Sub
+                stackPos -= 1
+                OpStack(stackPos-1) = Iif(OpStack(stackPos-1), OpStack(stackPos), -1)
+            Case 6  ' CONVERSE
+                If stackPos < 2 Then Print "Missing operand": Exit Sub
+                stackPos -= 1
+                OpStack(stackPos-1) = Iif(OpStack(stackPos), OpStack(stackPos-1), -1)
+            End Select
+        Case 32  ' Constant
+            OpStack(stackPos) = -value
+            stackPos += 1
+        Case 64  ' Variable
+            OpStack(stackPos) = Variables(Instr(VarList, Chr(value + 65)))
+            stackPos += 1
+        End Select
+    Next
+
+    If stackPos <> 1 Then Print "Missing operator": Exit Sub
+End Sub
+
+Sub ProcessRemainingOperators()
+    While stackPos > 0
+        stackPos -= 1
+        Select Case OpStack(stackPos)
+        Case 97
+            Print "Error: missing )!": Exit Sub
+        Case Else
+            ExprStack(exprPos) = OpStack(stackPos)
+            exprPos += 1
+        End Select
+    Wend
+End Sub
+
+Sub BuildVariableList()
+    VarList = ""
+    For idx = 0 To exprPos-1
+        If (ExprStack(idx) And 224) = 64 Then
+            Dim As String tmpChar = Chr(ExprStack(idx) + 1)
+            If Instr(VarList, tmpChar) = 0 Then VarList &= tmpChar
+        End If
+    Next
+End Sub
+
+Sub PrintRow()
+    For idx = 1 To Len(VarList)
+        Print Iif(Variables(idx), "T ", "F ");
+    Next
+    Print "| ";
+
+    EvaluateExpression()
+    Print Iif(OpStack(0), "T", "F")
+End Sub
+
+Sub GenerateNextCombination()
+    idx = 1
+    While idx <= Len(VarList)
+        Select Case Variables(idx)
+        Case 1
+            Variables(idx) = 0
+            idx += 1
+        Case 0
+            Variables(idx) = 1
+            Exit While
+        End Select
+    Wend
+End Sub
+
+Sub PrintTruthTable(originalExpr As String)
+    For idx = 1 To Len(VarList)
+        Print Mid(VarList, idx, 1); " ";
+    Next
+    Print "| "; originalExpr
+    Print String(2 + 2*Len(VarList) + Len(originalExpr), "-")
+
+    For combos = 1 To 2^Len(VarList)
+        PrintRow()
+        GenerateNextCombination()
+    Next
+End Sub
+
+
+'Main program
+Print "Boolean expression evaluator"
+Print String(28, "-")
+Print "Accepts single-character variables (a-z, A-Z), postfix or infix."
+Print "Operators: ! (not), & (and), | (or), ^ (xor), => (implies), <= (converse)"
+Print "Optionally seperated by whitespace. Just enter nothing to quit."
+
+Dim As String inputExpr, cleanExpr, originalExpr, remainExpr, currentChar
+Dim As Integer asciiVal
+Dim As Boolean operatorFound
+
+Do
+    For idx = 1 To 26: Variables(idx) = 0: Next
+
+    Print : Input "Boolean expression: ", inputExpr
+    If inputExpr = "" Then Exit Do
+
+    cleanExpr = ""
+    exprPos = 0
+    stackPos = 0
+
+    ' Remove spaces
+    For idx = 1 To Len(inputExpr)
+        currentChar = Mid(inputExpr, idx, 1)
+        If currentChar <> " " Then cleanExpr &= currentChar
+    Next
+
+    originalExpr = cleanExpr
+
+    While cleanExpr <> ""
+        currentChar = Left(cleanExpr, 1)
+        asciiVal = Asc(currentChar) Or 32
+        remainExpr = Right(cleanExpr, Len(cleanExpr) - 1)
+
+        Select Case True
+        Case asciiVal >= 97 Andalso asciiVal <= 122
+            ExprStack(exprPos) = asciiVal - 33
+            exprPos += 1
+
+        Case currentChar = "0" Orelse currentChar = "1"
+            ExprStack(exprPos) = Val(currentChar) + 32
+            exprPos += 1
+
+        Case (currentChar = "(")
+            OpStack(stackPos) = 97
+            stackPos += 1
+
+        Case (currentChar = ")")
+            While stackPos > 0 And OpStack(stackPos-1) <> 97
+                ExprStack(exprPos) = OpStack(stackPos-1)
+                exprPos += 1
+                stackPos -= 1
+            Wend
+            If stackPos > 0 Then stackPos -= 1
+
+        Case Else
+            operatorFound = False
+            For idx = 1 To 6 '7
+                If Left(cleanExpr, Len(Operators(idx))) = Operators(idx) Orelse _
+                    (Operators(idx) = "~" Andalso Left(cleanExpr, 1) = "!") Then
+
+                    operatorFound = True
+                    cleanExpr = Right(cleanExpr, Len(cleanExpr) - Len(Operators(idx)))
+
+                    While stackPos > 0 Andalso OpStack(stackPos-1) <> 97 Andalso _
+                        OpPrecedence(OpStack(stackPos-1) And 31) >= OpPrecedence(idx)
+                        ExprStack(exprPos) = OpStack(stackPos-1)
+                        exprPos += 1
+                        stackPos -= 1
+                    Wend
+
+                    OpStack(stackPos) = idx
+                    stackPos += 1
+                    Exit For
+                End If
+            Next
+
+            If Not operatorFound Then
+                Print "Parse error at: "; cleanExpr
+                Print
+                Exit Do
+            End If
+            Continue While
+        End Select
+
+        cleanExpr = remainExpr
+    Wend
+
+    ' Process remaining operators and build variable list
+    ProcessRemainingOperators()
+    BuildVariableList()
+    PrintTruthTable(originalExpr)
+Loop
+
+Sleep
diff --git a/Task/Truth-table/M2000-Interpreter/truth-table.m2000 b/Task/Truth-table/M2000-Interpreter/truth-table.m2000
new file mode 100644
index 0000000000..5dd4df7240
--- /dev/null
+++ b/Task/Truth-table/M2000-Interpreter/truth-table.m2000
@@ -0,0 +1,77 @@
+module TrueTable {
+	Input "How many parameters:";N
+	if N<1 then exit
+	if N>26 then Restart
+	print "Use of variables:", @(19),
+	for i=1 to N
+		print " "+chr$(i+64);
+	next
+	print
+	print "Identifiers:", @(20), "NOT AND OR XOR TRUE FALSE"
+	print "Symbols:", @(20), "( )"
+	dim a(0 to N) as boolean
+	a(N)=true
+	input "boolean expression: ";E$
+	E$=ucase$(E$)
+	P$=E$
+	E$=replace$("TRUE", "___", E$)
+	E$=replace$("FALSE", "^^^", E$)	
+	E$=replace$("AND", "%%%", E$)
+	E$=replace$("XOR", "???", E$)
+	E$=replace$("OR", "!!!", E$)
+	E$=replace$("NOT", "^^^", E$)
+	Z$=filter$(E$, "%?!^()_^")
+	try ok {
+		for i=0 to N-1
+			Z$=filter$(Z$, chr$(i+65))
+			if instr(E$,chr$(i+65))=0 then Error "Missing "+chr$(i+65)
+			E$=replace$(chr$(i+65), "[]("+i+")", E$)
+		next
+	}
+	if error or not ok then print "Error"+Error$ : restart
+	if trim$(Z$)<>"" then print "FOUND:";Z$;"ILLEGAL CHARACTERS": restart
+	E$=replace$("%%%","AND", E$)
+	E$=replace$("???", "XOR", E$)
+	E$=replace$( "!!!", "OR", E$)
+	E$=replace$("^^^", "NOT", E$)
+	E$=replace$("[]", "a", E$)
+	E$=replace$("___", "TRUE",  E$)
+	E$=replace$("^^^", "FALSE", E$)		
+	S$=""
+	H$=""
+	B$=""
+	for i=1 to N
+		H$+="   "+chr$(i+64)+"   |"
+		B$+="-------+"
+	next
+	B$+=string$("-",len(P$))
+	H$+=P$
+	print H$
+	S$=H$+{
+	}
+	try ok {
+		do	L$=""
+			for i=0 to N-1
+				L$+=format$(" {0:5} |", a(i))
+			next
+			L$+=" "+Str$(Eval(E$))
+			print B$
+			print L$
+			S$+=B$+{
+			}+L$+{
+			} 			
+		when @PlayNext()
+		clipboard S$
+	}
+	if error or not ok then print "Error"+Error$ : restart
+	End
+	function PlayNext()
+		local i
+		for i=0 to N
+			a(i)=not a(i)
+			if a(i) then exit for
+		next
+		=N>=i
+	end function
+}
+TrueTable
diff --git a/Task/Twin-primes/Forth/twin-primes.fth b/Task/Twin-primes/Forth/twin-primes.fth
new file mode 100644
index 0000000000..b6c50ca367
--- /dev/null
+++ b/Task/Twin-primes/Forth/twin-primes.fth
@@ -0,0 +1,47 @@
+variable sieve-addr
+
+: sieve-free ( -- )
+  sieve-addr @ free abort" free failed"
+  0 sieve-addr ! ;
+
+: sieve-allocate ( n -- )
+  sieve-free
+  dup allocate abort" out of memory"
+  tuck sieve-addr ! erase ;
+
+: odd-prime? ( n -- ? ) 2/ sieve-addr @ + c@ 0= ;
+: notprime! ( n -- ) 2/ sieve-addr @ + 1 swap c! ;
+
+\ odds-only prime sieve
+: sieve { n -- }
+  n 2/ sieve-allocate
+  1 notprime! 3
+  begin
+    dup dup * n <
+  while
+    dup odd-prime? if
+      n over dup * do
+        i notprime!
+      dup 2* +loop
+    then
+    2 +
+  repeat
+  drop ;
+
+: twin-prime-count ( n -- n )
+  dup sieve 5 0 >r
+  begin
+    2dup >
+  while
+    dup odd-prime? if
+      dup 2 - odd-prime? if
+        r> 1+ >r
+      then
+    then
+    2 +
+  repeat
+  sieve-free 2drop r> ;
+
+10000000 dup twin-prime-count swap
+." Number of twin prime pairs less than " . ." is " . cr
+bye
diff --git a/Task/Twos-complement/Racket/twos-complement.rkt b/Task/Twos-complement/Racket/twos-complement.rkt
new file mode 100644
index 0000000000..848166adc9
--- /dev/null
+++ b/Task/Twos-complement/Racket/twos-complement.rkt
@@ -0,0 +1,9 @@
+#lang racket/base
+
+(define (main)
+  (let ([n 42])
+    (printf "n = ~a, -n = ~a, two's complement = ~a\n"
+            n (- n) (add1 (bitwise-not n)))))
+
+(module+ main
+  (main))
diff --git a/Task/Twos-complement/X86-64-Assembly/twos-complement.x86-64 b/Task/Twos-complement/X86-64-Assembly/twos-complement.x86-64
new file mode 100644
index 0000000000..c3c8f680a8
--- /dev/null
+++ b/Task/Twos-complement/X86-64-Assembly/twos-complement.x86-64
@@ -0,0 +1,5 @@
+    mov rax, 1968  ;  1968 in rax
+    neg rax        ; -1968 should be in rax
+;------------------
+    not rax
+    inc rax        ;  1968 should be in rax again.
diff --git a/Task/UPC/EasyLang/upc.easy b/Task/UPC/EasyLang/upc.easy
index 416884c2e8..4d770fcc72 100644
--- a/Task/UPC/EasyLang/upc.easy
+++ b/Task/UPC/EasyLang/upc.easy
@@ -1,12 +1,8 @@
 proc trim . s$ .
    a = 1
-   while substr s$ a 1 = " "
-      a += 1
-   .
+   while substr s$ a 1 = " " : a += 1
    b = len s$
-   while substr s$ b 1 = " "
-      b -= 1
-   .
+   while substr s$ b 1 = " " : b -= 1
    s$ = substr s$ a (b - a + 1)
 .
 func$ rev s$ .
@@ -14,7 +10,7 @@ func$ rev s$ .
    for i to len a$[] div 2
       swap a$[i] a$[len a$[] - i + 1]
    .
-   return strjoin a$[]
+   return strjoin a$[] ""
 .
 func$ invert s$ .
    for c$ in strchars s$
@@ -33,16 +29,10 @@ func[] decode_upc upc$ .
          h$ = substr upc$ pos 7
          for dig to 10
             d$ = digs$[dig]
-            if isright = 1
-               d$ = invert d$
-            .
-            if h$ = d$
-               break 1
-            .
-         .
-         if dig = 11
-            return [ ]
+            if isright = 1 : d$ = invert d$
+            if h$ = d$ : break 1
          .
+         if dig = 11 : return [ ]
          dig -= 1
          digs[] &= dig
          sum += dig * sumf
@@ -50,27 +40,17 @@ func[] decode_upc upc$ .
          pos = pos + 7
       .
    .
-   if len upc$ <> 95
-      return [ ]
-   .
-   if substr upc$ 1 3 <> "# #"
-      return [ ]
-   .
+   if len upc$ <> 95 : return [ ]
+   if substr upc$ 1 3 <> "# #" : return [ ]
    pos = 4
    sumf = 3
    getdigs
-   if substr upc$ pos 5 <> " # # "
-      return [ ]
-   .
+   if substr upc$ pos 5 <> " # # " : return [ ]
    pos += 5
    isright = 1
    getdigs
-   if substr upc$ 1 3 <> "# #"
-      return [ ]
-   .
-   if sum mod 10 <> 0
-      return [ ]
-   .
+   if substr upc$ 1 3 <> "# #" : return [ ]
+   if sum mod 10 <> 0 : return [ ]
    return digs[]
 .
 barcodes$[] = [ "         # #   # ##  #  ## #   ## ### ## ### ## #### # # # ## ##  #   #  ##  ## ###  # ##  ## ### #  # #       " "        # # #   ##   ## # #### #   # ## #   ## #   ## # # # ###  # ###  ##  ## ###  # #  ### ###  # # #         " "         # #    # # #  ###  #   #    # #  #   #    # # # # ## #   ## #   ## #   ##   # # #### ### ## # #         " "       # # ##  ## ##  ##   #  #   #  # ###  # ##  ## # # #   ## ##  #  ### ## ## #   # #### ## #   # #        " "         # # ### ## #   ## ## ###  ##  # ##   #   # ## # # ### #  ## ##  #    # ### #  ## ##  #      # #          " "          # #  #   # ##  ##  #   #   #  # ##  ##  #   # # # # #### #  ##  # #### #### # #  ##  # #### # #         " "         # #  #  ##  ##  # #   ## ##   # ### ## ##   # # # #  #   #   #  #  ### # #    ###  # #  #   # #        " "        # # #    # ##  ##   #  # ##  ##  ### #   #  # # # ### ## ## ### ## ### ### ## #  ##  ### ## # #         " "         # # ### ##   ## # # #### #   ## # #### # #### # # #   #  # ###  #    # ###  # #    # ###  # # #       " "        # # # #### ##   # #### # #   ## ## ### #### # # # #  ### # ###  ###  # # ###  #    # #  ### # #         " ]
diff --git a/Task/URL-decoding/Langur/url-decoding.langur b/Task/URL-decoding/Langur/url-decoding.langur
index bcba2950c4..73a27c6509 100644
--- a/Task/URL-decoding/Langur/url-decoding.langur
+++ b/Task/URL-decoding/Langur/url-decoding.langur
@@ -1,5 +1,12 @@
-val finish = fn s:b2s(map(fn x:number(x, 16), rest(split("%", s))))
-val decode = fn s:replace(s, re/(%[0-9A-Fa-f]{2})+/, finish)
+val finish = fn s:b2s(map(
+    less(split(s, by="%"), of=1),
+    by=fn x:number(x, fmt=16),
+    ))
+val decode = fn s:replace(
+    s,
+    by=re/(%[0-9A-Fa-f]{2})+/,
+    with=finish,
+    )
 
-writeln decode("http%3A%2F%2Ffoo%20bar%2F")
-writeln decode("google.com/search?q=%60Abdu%27l-Bah%C3%A1")
+writeln decode("https%3A%2F%2Fno%20more%20foo%20bars%20please%2F")
+writeln decode("google.com/search?q=%22unbroken%20string%22")
diff --git a/Task/URL-encoding/EasyLang/url-encoding.easy b/Task/URL-encoding/EasyLang/url-encoding.easy
new file mode 100644
index 0000000000..f460d12259
--- /dev/null
+++ b/Task/URL-encoding/EasyLang/url-encoding.easy
@@ -0,0 +1,21 @@
+func$ tohex h .
+   for c in [ h div 16 h mod 16 ]
+      c += 48
+      if c >= 58 : c += 7
+      r$ &= strchar c
+   .
+   return r$
+.
+func$ urlenc s$ .
+   for c$ in strchars s$
+      c = strcode c$
+      if c >= 48 and c <= 57 or c >= 65 and c <= 90 or c >= 97 and c <= 122
+         #
+      else
+         c$ = "%" & tohex c
+      .
+      r$ &= c$
+   .
+   return r$
+.
+print urlenc "http://foo bar/"
diff --git a/Task/URL-encoding/Langur/url-encoding.langur b/Task/URL-encoding/Langur/url-encoding.langur
index 53580f1b28..26ef6f0d35 100644
--- a/Task/URL-encoding/Langur/url-encoding.langur
+++ b/Task/URL-encoding/Langur/url-encoding.langur
@@ -1,7 +1,8 @@
 val urlEncode = fn(s) {
 	replace(
-	    s, re/[^A-Za-z0-9]/,
-	    fn s:join("", map(fn b:"%{{b:X02}}", s2b(s))),
+	    s,
+        by=re/[^A-Za-z0-9]/,
+	    with=fn r:join(map(s2b(r), by=fn b:"%{{b:X02}}")),
 	)
 }
 
diff --git a/Task/URL-encoding/Standard-ML/url-encoding.ml b/Task/URL-encoding/Standard-ML/url-encoding.ml
new file mode 100644
index 0000000000..3d2b5b1a49
--- /dev/null
+++ b/Task/URL-encoding/Standard-ML/url-encoding.ml
@@ -0,0 +1,7 @@
+fun urlEncode str =
+  let
+    fun charToHex c = "%" ^ (Int.fmt StringCvt.HEX (ord c))
+    fun escapeChar c = if Char.isAlphaNum c then Char.toString c else charToHex c
+  in
+    String.concat (map escapeChar (explode str))
+  end
diff --git a/Task/UTF-8-encode-and-decode/Langur/utf-8-encode-and-decode.langur b/Task/UTF-8-encode-and-decode/Langur/utf-8-encode-and-decode.langur
index 0c0986069b..4efa9e9924 100644
--- a/Task/UTF-8-encode-and-decode/Langur/utf-8-encode-and-decode.langur
+++ b/Task/UTF-8-encode-and-decode/Langur/utf-8-encode-and-decode.langur
@@ -3,6 +3,6 @@ writeln "character   Unicode    UTF-8 encoding (hex)"
 for cp in "AöЖ€𝄞" {
     val utf8 =  cp -> cp2s -> s2b
     val cpstr = utf8 -> b2s
-    val utf8rep = join(" ", map(fn b:"{{b:X02}}", utf8))
+    val utf8rep = join(map(utf8, by=fn b:"{{b:X02}}"), by=" ")
     writeln "{{cpstr:-11}} U+{{cp:X04:-8}} {{utf8rep}}"
 }
diff --git a/Task/Ukkonen-s-suffix-tree-construction/C++/ukkonen-s-suffix-tree-construction.cpp b/Task/Ukkonen-s-suffix-tree-construction/C++/ukkonen-s-suffix-tree-construction.cpp
index 6781444d65..f7edd92c13 100644
--- a/Task/Ukkonen-s-suffix-tree-construction/C++/ukkonen-s-suffix-tree-construction.cpp
+++ b/Task/Ukkonen-s-suffix-tree-construction/C++/ukkonen-s-suffix-tree-construction.cpp
@@ -27,7 +27,7 @@ public:
 		text = word + '\u0004'; // Terminal character
 
 		nodes.reserve(2 * text.length());
-		root = newNode(UNDEFINED, UNDEFINED);
+		root = new_node(UNDEFINED, UNDEFINED);
 		active_node = root;
 
 		for ( const char& character : text ) {
@@ -36,8 +36,8 @@ public:
 	}
 
 	std::map> get_longest_repeated_substrings() {
-		std::vector indexes = doTraversal();
-		std::string word = text.substr(0, text.length() - 1);
+		const std::vector indexes = do_traversal();
+		const std::string word = text.substr(0, text.length() - 1);
 		std::map> result{ };
 
 		if ( indexes.front() > 0 ) {
@@ -61,7 +61,7 @@ private:
 			}
 
 			if ( ! nodes[active_node].children.contains(text[active_edge]) ) {
-				const int32_t leaf = newNode(text_index, LEAF_NODE);
+				const int32_t leaf = new_node(text_index, LEAF_NODE);
 				nodes[active_node].children[text[active_edge]] = leaf;
 				add_suffix_link(active_node);
 			} else {
@@ -76,9 +76,9 @@ private:
 					break;
 				}
 
-				const uint32_t split = newNode(nodes[next].start, nodes[next].start + active_length);
+				const uint32_t split = new_node(nodes[next].start, nodes[next].start + active_length);
 				nodes[active_node].children[text[active_edge]] = split;
-				const int32_t leaf = newNode(text_index, LEAF_NODE);
+				const int32_t leaf = new_node(text_index, LEAF_NODE);
 				nodes[split].children[character] = leaf;
 				nodes[next].start += active_length;
 				nodes[split].children[text[nodes[next].start]] = next;
@@ -118,7 +118,7 @@ private:
 		need_parent_link = node;
 	}
 
-	uint32_t newNode(const int32_t& start, const int32_t& end) {
+	uint32_t new_node(const int32_t& start, const int32_t& end) {
 		Node node(start, end);
 		node.leaf_index = ( end == LEAF_NODE ) ? leaf_index_generator++ : UNDEFINED;
 		nodes[current_node] = node;
@@ -126,7 +126,7 @@ private:
 		return current_node++;
 	}
 
-	std::vector doTraversal() {
+	std::vector do_traversal() {
 		std::vector indexes{ };
 		indexes.emplace_back(UNDEFINED);
 
@@ -152,8 +152,7 @@ private:
 
 	std::vector nodes;
 	std::string text;
-
-    int32_t root;
+	int32_t root;
 	int32_t active_node, active_length = 0, active_edge = 0;
 	int32_t text_index = 0, current_node = 0, need_parent_link = 0, remainder = 0, leaf_index_generator = 0;
 
@@ -162,32 +161,32 @@ private:
 };
 
 int main() {
-	std::vector limits = { 1'000, 10'000, 100'000 };
+	const std::vector limits = { 1'000, 10'000, 100'000 };
+
+	std::ifstream stream("../piDigits.txt");
+	const std::string contents( ( std::istreambuf_iterator(stream) ),
+						        ( std::istreambuf_iterator() ) );
 
 	for ( const int32_t& limit : limits ) {
-		std::ifstream stream("../piDigits.txt");
-		std::string contents( ( std::istreambuf_iterator(stream) ),
-                              ( std::istreambuf_iterator() ) );
-		std::string pi_digits = contents.substr(0, limit);
+		const std::string pi_digits = contents.substr(0, limit);
 
-		auto begin = std::chrono::high_resolution_clock::now();
+		const auto begin = std::chrono::high_resolution_clock::now();
 		SuffixTree tree(pi_digits);
 		std::map> substrings = tree.get_longest_repeated_substrings();
-		auto end = std::chrono::high_resolution_clock::now();
-		auto elapsed = std::chrono::duration_cast( end - begin );
+		const auto end = std::chrono::high_resolution_clock::now();
+		const auto elapsed = std::chrono::duration_cast( end - begin );
 
 		std::cout << "First " << limit << " digits of pi has longest repeated characters:" << std::endl;
 		for ( std::pair> entry : substrings ) {
 			std::cout << "    '" << entry.first << "' starting at index ";
-			for ( int32_t index : entry.second ) {
+			for ( const int32_t& index : entry.second ) {
 				std::cout << index << " ";
 			}
 			std::cout << std::endl;
 		}
 
-		std::cout << "Time taken: " << elapsed << " milliseconds." << std::endl << std::endl;
+		std::cout << "Time taken: " << elapsed << std::endl << std::endl;
 	}
 
-	std::cout << "The timings show that the implementation has approximately linear performance."
-              << std::endl;
+	std::cout << "The timings show that the implementation has approximately linear performance." << std::endl;
 }
diff --git a/Task/Ultra-useful-primes/M2000-Interpreter/ultra-useful-primes.m2000 b/Task/Ultra-useful-primes/M2000-Interpreter/ultra-useful-primes.m2000
new file mode 100644
index 0000000000..30279235de
--- /dev/null
+++ b/Task/Ultra-useful-primes/M2000-Interpreter/ultra-useful-primes.m2000
@@ -0,0 +1,27 @@
+module Ultra_Useful {
+	minusOne=biginteger("-1")	
+	one=biginteger("1")
+	two=biginteger("2")
+	num=biginteger("0")
+	k=num
+	with num,"tostring" as numS
+	with k,"tostring" as kS
+	for n= 1 to 10
+		k=minusOne
+		kk=-1
+		n1=biginteger(str$(n,""))
+		method two,"intpower", n1 as n1
+		do
+			method k,"add", two as k
+			kk+=2
+			method two, "intpower", n1 as num
+			method num, "subtract", k as num
+			method num,"isProbablyPrime", 10 as ret
+			if ret then
+				Print n, kk : Refresh
+				exit
+			end if
+		always
+	next
+}
+Ultra_Useful
diff --git a/Task/Ultra-useful-primes/Quackery/ultra-useful-primes.quackery b/Task/Ultra-useful-primes/Quackery/ultra-useful-primes.quackery
new file mode 100644
index 0000000000..5ec2e65548
--- /dev/null
+++ b/Task/Ultra-useful-primes/Quackery/ultra-useful-primes.quackery
@@ -0,0 +1,7 @@
+  12 times
+    [ i^ 1+ bit bit
+      1
+      [ 2dup -
+        prime not while
+        2 + again ]
+      echo sp drop ]
diff --git a/Task/Unicode-variable-names/Joy/unicode-variable-names.joy b/Task/Unicode-variable-names/Joy/unicode-variable-names.joy
new file mode 100644
index 0000000000..98d857bbdc
--- /dev/null
+++ b/Task/Unicode-variable-names/Joy/unicode-variable-names.joy
@@ -0,0 +1,8 @@
+DEFINE Δ == 1.
+DEFINE Δ1 == Δ 1 +.
+Δ. Δ1.
+1
+2
+DEFINE 💩 == 2.
+💩.
+2
diff --git a/Task/Universal-Turing-machine/EasyLang/universal-turing-machine.easy b/Task/Universal-Turing-machine/EasyLang/universal-turing-machine.easy
new file mode 100644
index 0000000000..5d124545bd
--- /dev/null
+++ b/Task/Universal-Turing-machine/EasyLang/universal-turing-machine.easy
@@ -0,0 +1,138 @@
+global right$[] left$[] pos blank$ .
+proc show stat$ . .
+   write stat$
+   for i to 5 - len stat$
+      write " "
+   .
+   write "| "
+   h = -len left$[] + 1
+   for i = h to len right$[]
+      if i <= 0
+         c$ = left$[-i + 1]
+      else
+         c$ = right$[i]
+      .
+      if i = pos
+         write "*"
+      else
+         write " "
+      .
+      write c$ & " "
+   .
+   print ""
+.
+func$ get .
+   if pos <= 0
+      return left$[-pos + 1]
+   .
+   return right$[pos]
+.
+proc put s$ . .
+   if pos <= 0
+      left$[-pos + 1] = s$
+   else
+      right$[pos] = s$
+   .
+.
+proc mleft . .
+   pos -= 1
+   if pos <= 0 and len left$[] < (-pos + 1)
+      left$[] &= blank$
+   .
+.
+proc mright . .
+   pos += 1
+   if pos > 0 and len right$[] < pos
+      right$[] &= blank$
+   .
+.
+proc utm stat$ endstat$ bl$ init$ rules$[] trace . .
+   blank$ = bl$
+   pos = 1
+   right$[] = strsplit init$ " "
+   left$[] = [ ]
+   for r$ in rules$[]
+      r$[][] &= strsplit r$ " "
+   .
+   repeat
+      if trace = 1
+         show stat$
+      else
+         if steps mod 1000000 = 0
+            write "."
+         .
+      .
+      for i to len r$[][]
+         if r$[i][1] = stat$ and r$[i][2] = get
+            put r$[i][3]
+            if r$[i][4] = "left"
+               mleft
+            elif r$[i][4] = "right"
+               mright
+            .
+            stat$ = r$[i][5]
+            break 1
+         .
+      .
+      steps += 1
+      until stat$ = endstat$
+   .
+   if trace = 1
+      show stat$
+   else
+      print ""
+      print "Steps: " & steps
+   .
+.
+#
+repeat
+   s$ = input
+   until s$ = ""
+   trace = 1
+   if substr s$ 1 7 = "5-state"
+      trace = 0
+   .
+   print "--- " & s$ & "---"
+   s$ = input
+   in1$[] = strsplit s$ " "
+   in2$ = input
+   r$[] = [ ]
+   repeat
+      s$ = input
+      until s$ = ""
+      r$[] &= s$
+   .
+   utm in1$[1] in1$[2] in1$[3] in2$ r$[] trace
+   print ""
+.
+#
+input_data
+Simple incrementer
+q0 qf B
+1 1 1
+q0 1 1 right q0
+q0 B 1 stay qf
+
+Three-state busy beaver
+a halt 0
+0
+a 0 1 right b
+a 1 1 left c
+b 0 1 left a
+b 1 1 right b
+c 0 1 left b
+c 1 1 stay halt
+
+5-state, 2-symbol probable Busy Beaver
+A H 0
+0
+A 0 1 right B
+A 1 1 left C
+B 0 1 right C
+B 1 1 right B
+C 0 1 right D
+C 1 0 left E
+D 0 1 left A
+D 1 1 left D
+E 0 1 stay H
+E 1 0 left A
diff --git a/Task/Universal-Turing-machine/Quackery/universal-turing-machine.quackery b/Task/Universal-Turing-machine/Quackery/universal-turing-machine.quackery
new file mode 100644
index 0000000000..f4472c563a
--- /dev/null
+++ b/Task/Universal-Turing-machine/Quackery/universal-turing-machine.quackery
@@ -0,0 +1,51 @@
+  [ this ]                    is halt     ( --> halt )
+  [ stack ]                   is state    ( --> s )
+  [ stack ]                   is machine  ( --> s )
+
+  [ state share echo say ": "
+    split
+    swap witheach [ echo sp ]
+    behead nested echo sp
+    witheach [ echo sp ] cr ] is echotape ( tape head --> )
+
+  [ over dip [ unrot poke ] ] is write    ( tape head value --> tape head )
+
+  [ write
+    dup 0 = iff
+      [ dip [ 0 swap join ] ]
+    else [ 1 - ] ]            is left     ( tape head value --> tape head )
+
+  [ write
+    1+
+    over size over = if
+      [ dip [ 0 join ] ] ]    is right    ( tape head value --> tape head )
+
+  [ write ]                   is stay     ( tape head value --> tape head )
+
+  [ 0 state put
+    rot machine put
+    [ 2dup echotape
+      2dup peek
+      machine share
+      state share peek
+      swap peek do
+      state replace
+      state share
+      halt = until ]
+    echotape
+    state release
+    machine release ]         is turing   ( machine tape head --> )
+
+  say "Simple Incrementer"
+  cr cr
+  ' [ [ [ 1 stay halt ] [ 1 right 0 ] ] ]
+  ' [ 1 1 1 ] 0
+  turing
+  cr cr
+  say "Three-state Busy Beaver"
+  cr cr
+  ' [ [ [ 1 right 1 ] [ 1 left  2    ] ]
+      [ [ 1 left  0 ] [ 1 right 1    ] ]
+      [ [ 1 left  1 ] [ 1 stay  halt ] ] ]
+  ' [ 0 ] 0
+  turing
diff --git a/Task/Untouchable-numbers/Python/untouchable-numbers.py b/Task/Untouchable-numbers/Python/untouchable-numbers.py
new file mode 100644
index 0000000000..504d73487a
--- /dev/null
+++ b/Task/Untouchable-numbers/Python/untouchable-numbers.py
@@ -0,0 +1,93 @@
+def prime_sieve(limit: int):
+    p = 3
+
+    limit += 1
+
+    c = [False] * limit
+
+    c[0] = True
+    c[1] = True
+
+    for i in range(4, limit, 2):
+        c[i] = True
+
+    while True:
+        p2 = p * p
+
+        if p2 >= limit:
+            break
+
+        for i in range(p2, limit, 2 * p):
+            c[i] = True
+
+        while True:
+            p += 2
+
+            if not c[p]:
+                break
+
+    return c
+
+def main():
+    limit = 1000000
+
+    uc = 2
+    p = 10
+    m = 63
+    ul = 151000
+
+    c = prime_sieve(limit)
+    n = m * limit + 1
+
+    sum_divs = [0] * n
+
+    for i in range(1, n):
+        for j in range(i, n, i):
+            sum_divs[j] += i
+
+    s = [False] * n
+
+    for i in range(1, n):
+        sumation = sum_divs[i] - i
+        if sumation <= n:
+            s[sumation] = True
+
+    untouchable = [0] * ul
+
+    untouchable[0] = 2
+    untouchable[1] = 5
+
+    for n in range(6, limit+1, 2):
+        if not s[n] and c[n - 1] and c[n-3]:
+            untouchable[uc] = n
+            uc += 1
+
+    print("List of untouchable numbers <= 2,000:")
+
+    for i in range(uc):
+        j = untouchable[i]
+
+        if j > 2000:
+            break
+
+        print("%3d " % j, end=' ')
+
+        if not ((i+1) % 10):
+            print()
+
+    print("\n\n%d untouchable numbers were found  <=     2,000\n" % i)
+
+    for i in range(uc):
+        j = untouchable[i]
+
+        if j > p:
+            print("%d untouchable numbers were found  <= %d\n" % (i, p))
+            p *= 10
+
+            if p == limit:
+                break
+
+    print("%d untouchable numbers were found  <= %d" % (uc, limit))
+
+if __name__ == '__main__':
+    main()
diff --git a/Task/Use-another-language-to-call-a-function/FutureBasic/use-another-language-to-call-a-function.basic b/Task/Use-another-language-to-call-a-function/FutureBasic/use-another-language-to-call-a-function.basic
new file mode 100644
index 0000000000..c11f2aa16a
--- /dev/null
+++ b/Task/Use-another-language-to-call-a-function/FutureBasic/use-another-language-to-call-a-function.basic
@@ -0,0 +1,23 @@
+include "NSLog.incl"
+
+// FutureBasic function
+local fn Query( buffer as ptr, size as ^unsigned long ) as long
+  CFStringRef string = @"Here am I"
+  ptr p = fn StringCStringUsingEncoding( string, NSASCIIStringEncoding )
+  *size = len(string)
+  BlockMoveData( p, buffer, *size )
+end fn = 1
+
+
+// C code
+BeginCCode
+  char buffer[1024];
+  size_t Size = sizeof(buffer);
+  if ( Query( buffer, &Size ) == 0 ) { // call FutureBasic function
+     NSLog(@"failed to call Query\n");
+  } else {
+     NSLog(@"%s",buffer);
+  }
+EndC
+
+HandleEvents
diff --git a/Task/Use-another-language-to-call-a-function/Zig/use-another-language-to-call-a-function.zig b/Task/Use-another-language-to-call-a-function/Zig/use-another-language-to-call-a-function.zig
index 80d594b2b4..6f0f612d01 100644
--- a/Task/Use-another-language-to-call-a-function/Zig/use-another-language-to-call-a-function.zig
+++ b/Task/Use-another-language-to-call-a-function/Zig/use-another-language-to-call-a-function.zig
@@ -1,11 +1,9 @@
-const std = @import("std");
-
-export fn Query(Data: [*c]u8, Length: *usize) callconv(.C) c_int {
+export fn Query(data: [*c]u8, length: *usize) callconv(.C) c_int {
     const value = "Here I am";
 
-    if (Length.* >= value.len) {
-        @memcpy(@ptrCast([*]u8, Data), value, value.len);
-        Length.* = value.len;
+    if (length.* >= value.len) {
+        @memcpy(data[0..value.len], value);
+        length.* = value.len;
         return 1;
     }
 
diff --git a/Task/User-input-Graphical/Nim/user-input-graphical.nim b/Task/User-input-Graphical/Nim/user-input-graphical.nim
index 535e880cf7..8573991395 100644
--- a/Task/User-input-Graphical/Nim/user-input-graphical.nim
+++ b/Task/User-input-Graphical/Nim/user-input-graphical.nim
@@ -1,82 +1,97 @@
-import strutils
-import gintro/[glib, gobject, gtk, gio]
+import std/strformat
+import gtk2, glib2
 
-type MainWindow = ref object of ApplicationWindow
-  strEntry: Entry
-  intEntry: SpinButton
+###############################################################################
+# Missing declaration.
 
-#---------------------------------------------------------------------------------------------------
+when defined(win32):
+  const lib = "libgtk-win32-2.0-0.dll"
+elif defined(macosx):
+  const lib = "(libgtk-quartz-2.0.0.dylib|libgtk-x11-2.0.dylib)"
+else:
+  const lib = "libgtk-x11-2.0.so(|.0)"
 
-proc displayValues(strval: string; intval: int) =
+proc getContentArea(dialog: PDialog): PVBox {.cdecl,
+    importc: "gtk_dialog_get_content_area", dynlib: lib.}
+
+
+###############################################################################
+
+type App = object
+  window: PWindow
+  strEntry: PEntry
+  intEntry: PSpinButton
+
+
+proc displayValues(app: App; strval: cstring; intval: int) =
   ## Display a dialog window with the values entered by the user.
 
-  let dialog = newDialog()
-  dialog.setModal(true)
-  let label1 = newLabel(" String value is “$1”.".format(strval))
-  label1.setHalign(Align.start)
-  dialog.contentArea.packStart(label1, true, true, 5)
-  let msg = " Integer value is $1 which is ".format(intval) &
-            (if intval == 75000: "right. " else: "wrong (expected 75000). ")
-  let label2 = newLabel(msg)
-  dialog.contentArea.packStart(label2, true, true, 5)
-  discard dialog.addButton("OK", ord(ResponseType.ok))
+  let dialog = dialogNewWithButtons("user_input_graphical", app.window,
+                                    DIALOG_MODAL or DIALOG_DESTROY_WITH_PARENT, "OK")
+  let label1 = labelNew(cstring(&" String value is “{strval}”."))
+  let contentArea = dialog.getContentArea()
+  contentArea.packStart(label1, true, true, 5)
+  let text = if intval == 75000: "right. " else: "wrong (expected 75000). "
+  let msg = &" Integer value is {intval} which is {text}"
+  let label2 = labelNew(msg.cstring)
+  contentArea.packStart(label2, true, true, 5)
   dialog.showAll()
   discard dialog.run()
   dialog.destroy()
 
-#---------------------------------------------------------------------------------------------------
 
-proc onOk(button: Button; window: MainWindow) =
+proc onOk(button: PButton; app: var App) =
   ## Callback executed when the OK button has been clicked.
-  let strval = window.strEntry.text()
-  let intval = window.intEntry.value().toInt
-  displayValues(strval, intval)
+  let strval = app.strEntry.getText()
+  let intval = app.intEntry.getValue().toInt
+  app.displayValues(strval, intval)
   if intval == 75_000:
-    window.destroy()
+    app.window.destroy()
 
-#---------------------------------------------------------------------------------------------------
 
-proc activate(app: Application) =
-  ## Activate the application.
+proc onDestroyEvent(widget: PWidget; data: pointer): gboolean {.cdecl.} =
+  ## Quit the application.
+  mainQuit()
 
-  let window = newApplicationWindow(MainWindow, app)
-  window.setTitle("User input")
 
-  let content = newBox(Orientation.vertical, 10)
-  content.setHomogeneous(true)
-  let grid = newGrid()
-  grid.setColumnSpacing(30)
-  let bbox = newButtonBox(Orientation.horizontal)
-  bbox.setLayout(ButtonBoxStyle.spread)
+var app: App
 
-  let strLabel = newLabel("Enter some text")
-  strLabel.setHalign(Align.start)
-  window.strEntry = newEntry()
-  grid.attach(strLabel, 0, 0, 1, 1)
-  grid.attach(window.strEntry, 1, 0, 1, 1)
+nimInit()
 
-  let intLabel = newLabel("Enter 75000")
-  intLabel.setHalign(Align.start)
-  window.intEntry = newSpinButtonWithRange(0, 80_000, 1)
-  grid.attach(intLabel, 0, 1, 1, 1)
-  grid.attach(window.intEntry, 1, 1, 1, 1)
+app.window = windowNew(WINDOW_TOPLEVEL)
+app.window.setTitle("User input")
+discard app.window.signalConnect("destroy", SIGNAL_FUNC(onDestroyEvent), nil)
 
-  let btnOk = newButton("OK")
+let content = vboxNew(false, 10)
+content.setHomogeneous(true)
+let grid = tableNew(2, 2, false)
+grid.setColSpacings(30)
 
-  bbox.add(btnOk)
+let hbox1 = hboxNew(false, 0)
+let strLabel = labelNew("Enter some text")
+app.strEntry = entryNew()
+hbox1.packStart(strLabel, false, false, 0)
+grid.attach(hbox1, 0, 1, 0, 1, constFILL, 0, 0, 0)
+grid.attach(app.strEntry, 1, 2, 0, 1, constFILL, 0, 0, 0)
 
-  content.packStart(grid, true, true, 0)
-  content.packEnd(bbox, true, true, 0)
+let hbox2 = hboxNew(false, 0)
+let intLabel = labelNew("Enter 75000")
+app.intEntry = spinButtonNew(0, 80_000, 1)
+hbox2.packStart(intLabel, false, false, 0)
+grid.attach(hbox2, 0, 1, 1, 2, constFILL, 0, 0, 0)
+grid.attach(app.intEntry, 1, 2, 1, 2, constFILL, 0, 0, 0)
 
-  window.setBorderWidth(5)
-  window.add(content)
+let btnOk = buttonNew("OK")
+btnOk.setSizeRequest(100, 40)
+let hbox3 = hboxNew(false, 20)
+hbox3.packEnd(btnOk, false, true, 10)
+content.packStart(grid, true, true, 0)
+content.packEnd(hbox3, false, false, 0)
 
-  discard btnOk.connect("clicked", onOk, window)
+app.window.setBorderWidth(5)
+app.window.add content
 
-  window.showAll()
+discard btnOk.signalConnect("clicked", SIGNAL_FUNC(onOk), app.addr)
 
-#———————————————————————————————————————————————————————————————————————————————————————————————————
-
-let app = newApplication(Application, "Rosetta.UserInput")
-discard app.connect("activate", activate)
-discard app.run()
+app.window.showAll()
+main()
diff --git a/Task/User-input-Graphical/V-(Vlang)/user-input-graphical.v b/Task/User-input-Graphical/V-(Vlang)/user-input-graphical.v
index bc88d58635..2faa4a0cb4 100644
--- a/Task/User-input-Graphical/V-(Vlang)/user-input-graphical.v
+++ b/Task/User-input-Graphical/V-(Vlang)/user-input-graphical.v
@@ -4,11 +4,6 @@ import ui
 struct App {
 	mut:
 	win &ui.Window = unsafe {nil}
-	txt_1 &ui.TextBox = unsafe {nil}
-	txt_2 &ui.TextBox = unsafe {nil}
-	lbl_1 &ui.Label = unsafe {nil}
-	lbl_2 &ui.Label = unsafe {nil}
-	btn_1 &ui.Button = unsafe {nil}
 	instr string = "Enter some text, the number 75000, and press 'Validate'"
 	txt string
 	num string
@@ -16,44 +11,37 @@ struct App {
 
 fn main() {
 	mut app := &App{}
-//	widgets defined and placed here for clarity
-	app.lbl_1 = ui.label(text: &app.instr, id: "lbl_1", justify: [0.5, 0.0]) // [x, y] for text placement
-	app.lbl_2 = ui.label(text: "", id: "lbl_2", text_align: .center, justify: [0.5, 0.0])
-	app.txt_1 = ui.textbox(placeholder: "String", text: &app.txt, id: "txt_1")
-	app.txt_2 = ui.textbox(placeholder: "Number", text: &app.num, id: "txt_2")
-	app.btn_1 = ui.button(width: 5, text: "Validate", on_click: app.btn_click)
-
-	app.win = ui.window(
-		height: 150
-		width: 450
-		title: "Input Info"
-		mode: .resizable
+//	widgets defined and placed first for clarity
+	lbl_1 := ui.label(text: &app.instr, id: "lbl_1", justify: [0.5, 0.0]) // [x, y] for text placement
+	lbl_2 := ui.label(text: "", id: "lbl_2", text_align: .center, justify: [0.5, 0.0])
+	txt_1 := ui.textbox(placeholder: "String", text: &app.txt, id: "txt_1")
+	txt_2 := ui.textbox(placeholder: "Number", text: &app.num, id: "txt_2")
+	btn_1 := ui.button(width: 5, text: "Validate", on_click: app.btn_click)
+//	column can be spread vertically and for visualization
+	col := ui.column(
+		alignment: .center // button's center, relative to UI
+		spacing: 5 // button's distance from other widgets
+		widths: [ui.stretch, 150] // button's width relative to UI				
+		margin: ui.Margin{0, 5, 0, 5} // widgets relative to UI's edges, {y, right, x, left}
 		children: [
 			ui.column(
-				alignment: .center // button's center, relative to UI
-				spacing: 5 // button's distance from other widgets
-				widths: [ui.stretch, 150] // button's width relative to UI				
-				margin: ui.Margin{0, 5, 0, 5} // widgets relative to UI's edges, {y, right, x, left}
-				children: [
-			        ui.column(
-						alignment: .center
-                        spacing: 5 // distance between widgets in same column
-                        children: [
-					        app.lbl_1
-							app.lbl_2
-					        app.txt_1
-					        app.txt_2
-                        ]
-                    ),
-					// button in and controlled from separate column
-					app.btn_1	
-				]
-			),
+				alignment: .center
+                spacing: 5 // distance between widgets in same column
+                children: [
+			        lbl_1
+					lbl_2
+			        txt_1
+			        txt_2
+                ]
+            ),
+			btn_1 // button in and controlled from separate column
 		]
 	)
+	app.win = ui.window(height: 150, width: 450, title: "Input Info", mode: .resizable, children: [col])
 	ui.run(app.win)
 }
 
 fn (mut app App) btn_click(btn &ui.Button) {
-	app.lbl_2.set_text("${app.txt} ${app.num}")
+	mut lbl_2 := app.win.get_or_panic[ui.Label]("lbl_2") // id: "lbl_2" (used above)
+	lbl_2.set_text("${app.txt} ${app.num}")
 }
diff --git a/Task/User-input-Graphical/XPL0/user-input-graphical.xpl0 b/Task/User-input-Graphical/XPL0/user-input-graphical.xpl0
index c11754e5d3..1e840ef851 100644
--- a/Task/User-input-Graphical/XPL0/user-input-graphical.xpl0
+++ b/Task/User-input-Graphical/XPL0/user-input-graphical.xpl0
@@ -1,95 +1,91 @@
-\12345678901234567890123456789012345
-\User input/Graphical..........  X .
-\ Please enter a string and 75000: .
-\ String: Hello, World!___         .
-\ Number: 75000___________         .
+\012345678901234567890123456789012345
+\ User input/Graphical..........  X .
+\  Please enter a string and 75000: .
+\  String: Hello, World!___.        .
+\  Number: 75000___________.        .
 
-def  X0=20, Y0=10;              \upper-left corner of window's position (chars)
+def  X0=20, Y0=10;              \position of upper-left corner of window (chars)
+int  Mouse, Button, X, Y, Ch, I, SN; \SN = string number = 0 or 1
 def  StrMax = 16;               \maximum number of characters in strings
-char String(2, StrMax);         \string arrays (includes Number string)
+char String(2, StrMax);         \2 string arrays (including Number string)
 int  StrInx(2);                 \index to character to be added to String
-int  Mouse, Button, C, I, SN;
 
 func GetButton;                 \Return soft button number at mouse pointer
-int  X, Y;
 [Mouse:= GetMouse;
-X:= Mouse(0)/8 - X0;            \convert pixels to char cells
+X:= Mouse(0)/8  - X0;           \convert pixels to 8x16-pixel character cells
 Y:= Mouse(1)/16 - Y0;
-if X>=32 & X<=34 & Y=0 then return 0;           \exit [X]
+if X>=32 & X<=34        & Y=0 then return 0;    \exit [X]
 if X>=10 & X<=10+StrMax & Y=4 then return 1;    \line 1
 if X>=10 & X<=10+StrMax & Y=6 then return 2;    \line 2
 return -1;                      \mouse not on any soft button
 ];
 
-proc ShowCursor(Flag);          \Turn cursor at insertion point on or off
+proc ShowCursor(Flag);          \Turn cursor at end of active String on or off
 int  Flag;
 [Cursor(10+StrInx(SN)+X0, 4+SN*2+Y0);
 ChOut(6, if Flag then ^_ else ^ );
 ];
 
-[SetVid($12);                   \640x480 graphics
-TrapC(true);                    \disable Ctrl+C
-Attrib($70);                    \black on gray
-SetWind(0+X0, 0+Y0, 35+X0, 8+Y0, 0, \fill\true);
-Cursor(33+X0, 0+Y0); Text(6, "X");
+[SetVid($12);                   \set 640x480 graphics
+TrapC(true);                    \prevent Ctrl+C from aborting the program
+Attrib($70);                    \set black-on-gray color attribute
+SetWind(0+X0, 0+Y0, 35+X0, 8+Y0, 0, \fill\true);        \draw gray rectangle
+Cursor(33+X0, 0+Y0); Text(6, "X");                      \draw exit button
 Cursor(2+X0, 2+Y0);  Text(6, "Please enter a string and 75000:");
 Cursor(2+X0, 4+Y0);  Text(6, "String:");
 Cursor(2+X0, 6+Y0);  Text(6, "Number:");
-
-Attrib($1F);                    \bright white on blue, for title
+Attrib($9F);                    \set bright white on light blue, for title bar
 Cursor(0+X0, 0+Y0);  Text(6, " User input/Graphical          ");
-
-Attrib($F0);                    \black on bright white
+Attrib($F0);                    \set black on bright white
 for SN:= 0 to 1 do              \initialize Strings
-    [StrInx(SN):= 0;
-    Cursor(10+X0, 4+SN*2+Y0);
+    [Cursor(10+X0, 4+SN*2+Y0);
     for I:= 0 to StrMax-1 do
-        [String(SN, I):= $20;  ChOut(6, ^ )];
+        [String(SN, I):= ^ ;  ChOut(6, ^ )];
+    ChOut(6, ^ );               \add one more for cursor underline at StrMax
+    StrInx(SN):= 0;
     ];
-SN:= 0;                         \select first, topmost String
+SN:= 0;                                 \select first (topmost) String
 ShowCursor(true);
-
-ShowMouse(true);
+ShowMouse(true);                        \turn on mouse pointer
 loop    [MoveMouse;                     \make pointer track mouse movements
-        Mouse:= GetMouse;
+        Mouse:= GetMouse;               \get pointer to mouse array information
         if Mouse(2) then                \a left or right mouse button is down
             [Button:= GetButton;        \get soft button at mouse pointer
-            while Mouse(2) do           \wait for mouse button's release
+            while Mouse(2) do           \wait for mouse button(s) to be released
                 [MoveMouse;
                 Mouse:= GetMouse;
                 ];
-            if Button = GetButton then  \if down Button = release button
-                [if Button = 0 then quit;
-                if Button # -1 then     \move cursor to active String
-                    [ShowCursor(false);
+            if Button = GetButton then  \if down Button = release button and it
+                [if Button = 0 then quit; \is the exit [X] button then quit loop
+                if Button # -1 then     \move cursor underline to active String
+                    [ShowMouse(false);  \don't overwrite mouse pointer
+                    ShowCursor(false);  \turn off cursor at old String position
                     SN:= Button-1;
-                    ShowCursor(true);
+                    ShowCursor(true);   \turn on cursor for selected String
+                    ShowMouse(true);    \mouse pointer is normally displayed
                     ];
                 ];
             ];
         if KeyHit then
             [ShowMouse(false);          \don't overwrite mouse pointer
-            C:= ChIn(1);                \get character from non-echoed keyboard
-            if SN = 0 and C >= $20 and C <= $7E or      \all printable ASCIIs
-               SN = 1 and C >= $30 and C <= $39 then    \only numeric digits
-                [String(SN, StrInx(SN)):= C;
-                if StrInx(SN) < StrMax-1 then StrInx(SN):= StrInx(SN)+1;
+            ShowCursor(false);          \remove cursor underline cuz it moves
+            Ch:= ChIn(1);               \get character from non-echoed keyboard
+            if SN=0 & Ch>=$20 & Ch<=$7E or      \allow all printable chars
+               SN=1 & Ch>=$30 & Ch<=$39 then    \allow only numeric digits
+                [if StrInx(SN) < StrMax then
+                    [String(SN, StrInx(SN)):= Ch;  StrInx(SN):= StrInx(SN)+1];
                 ]
-            else if C = \BS\$08 then    \delete back a character
-                [ShowCursor(false);
-                if StrInx(SN) > 0 then StrInx(SN):= StrInx(SN)-1;
-                ]
-            else if C = \tab\$09 then   \select next string
-                [ShowCursor(false);
-                SN:= rem((SN+1)/2);
-                ]
-            else if C = \Esc\$1B then quit;
+            else if Ch = \BS\$08 then   \delete back a character
+                [if StrInx(SN) > 0 then StrInx(SN):= StrInx(SN)-1]
+            else if Ch = \tab\$09 then  \select next string
+                SN:= rem((SN+1)/2)
+            else if Ch = \Esc\$1B then quit;
 
             Cursor(10+X0, 4+SN*2+Y0);   \show active String
             for I:= 0 to StrInx(SN)-1 do ChOut(6, String(SN, I));
-            ChOut(6, ^_);
+            ChOut(6, ^_);               \show cursor underline at end of String
             ShowMouse(true);
             ];
-        ];
+        ];  \loop
 SetVid(3);                              \restore normal text mode immediately
 ]
diff --git a/Task/Validate-International-Securities-Identification-Number/FutureBasic/validate-international-securities-identification-number.basic b/Task/Validate-International-Securities-Identification-Number/FutureBasic/validate-international-securities-identification-number.basic
new file mode 100644
index 0000000000..bd7516528c
--- /dev/null
+++ b/Task/Validate-International-Securities-Identification-Number/FutureBasic/validate-international-securities-identification-number.basic
@@ -0,0 +1,40 @@
+//
+// Validate International Securities Identification Number
+// At entry ISIN string
+// Exits with Boolean Valid or Invalid
+//
+local fn ISINisValid (ISIN as CFStringRef) as Boolean
+
+  // Base36 = @"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
+  Int r, v = 0, c, x2(9) = {0,2,4,6,8,1,3,5,7,9}
+  if len(ISIN) <> 12                            then return _False
+  if ucc(ISIN, 0) < _"A" || ucc(ISIN, 1) < _"A" then return _False
+  // convert Base 36 digits to Base 10
+  uint64 n = 0
+  for r = 0 to len(ISIN) - 1
+    c = ucc(ISIN, r)
+    select
+      case c >= _"A" && c <= _"Z" : n = n * 100 + c - 55
+      case c >= _"0" && c <= _"9" : n = n * 10  + c - 48
+      case else : return _False
+    end select
+  next
+  // Luhn test
+  while n
+    v += n % 10 + x2(n / 10 % 10)
+    n /= 100
+  wend
+end fn = !(v mod 10)
+
+window 1,@"Validate ISIN"
+
+//Test data
+CFStringRef cc(6) = {@"US0378331005", @"US0373831005", @"U50378331005", ¬
+@"US03378331005", @"AU0000XVGZA3", @"AU0000VXGZA3", @"FR0000988040"}
+for int x = 0 to 6
+  print cc(x),
+  if fn ISINisValid(cc(x)) then print @"Valid" else print @"Invalid"
+next
+
+handleEvents
diff --git a/Task/Video-display-modes/BBC-BASIC/video-display-modes.basic b/Task/Video-display-modes/BBC-BASIC/video-display-modes.basic
index e84c6ff6af..09df6c460e 100644
--- a/Task/Video-display-modes/BBC-BASIC/video-display-modes.basic
+++ b/Task/Video-display-modes/BBC-BASIC/video-display-modes.basic
@@ -1 +1 @@
-10 MODE 1: REM 320x256 4 colour graphics
+MODE 1: REM 320x256 4 color graphics
diff --git a/Task/Video-display-modes/GW-BASIC/video-display-modes.basic b/Task/Video-display-modes/GW-BASIC/video-display-modes.basic
index 9497a525df..a12698e916 100644
--- a/Task/Video-display-modes/GW-BASIC/video-display-modes.basic
+++ b/Task/Video-display-modes/GW-BASIC/video-display-modes.basic
@@ -1,2 +1 @@
-10 REM GW Basic can switch VGA modes
-20 SCREEN 18: REM Mode 12h 640x480 16 colour graphics
+SCREEN 9: REM 640x350, 16 colors
diff --git a/Task/Video-display-modes/Java/video-display-modes.java b/Task/Video-display-modes/Java/video-display-modes.java
index 1124b7cabc..0e5f88b50c 100644
--- a/Task/Video-display-modes/Java/video-display-modes.java
+++ b/Task/Video-display-modes/Java/video-display-modes.java
@@ -8,7 +8,7 @@ import java.util.concurrent.TimeUnit;
 import javax.swing.JFrame;
 import javax.swing.JLabel;
 
-public final  class VideoDisplay {
+public final class VideoDisplayModes {
 	
 	public static void main(String[] aArgs) throws InterruptedException  {	
 		GraphicsEnvironment environment = GraphicsEnvironment.getLocalGraphicsEnvironment();
@@ -36,10 +36,10 @@ public final  class VideoDisplay {
 	    }
 	   	
 	   	// Uncomment the line below to see an example of programmatically changing the video display.
-	   	// new VideoDisplay();		
+	   	// new VideoDisplayModes();		
 	}
 	
-	private VideoDisplay() throws InterruptedException {
+	private VideoDisplayModes() throws InterruptedException {
 		JFrame.setDefaultLookAndFeelDecorated(true);
     	JFrame frame = new JFrame("Video Display Demonstration");    	
     	frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
diff --git a/Task/Video-display-modes/Locomotive-Basic/video-display-modes.basic b/Task/Video-display-modes/Locomotive-Basic/video-display-modes.basic
index 1165254e05..e4cad6db86 100644
--- a/Task/Video-display-modes/Locomotive-Basic/video-display-modes.basic
+++ b/Task/Video-display-modes/Locomotive-Basic/video-display-modes.basic
@@ -1 +1 @@
-10 MODE 0: REM switch to mode 0
+mode 0   ' switch to mode 0
diff --git a/Task/Video-display-modes/M2000-Interpreter/video-display-modes.m2000 b/Task/Video-display-modes/M2000-Interpreter/video-display-modes.m2000
new file mode 100644
index 0000000000..73753bad78
--- /dev/null
+++ b/Task/Video-display-modes/M2000-Interpreter/video-display-modes.m2000
@@ -0,0 +1,40 @@
+GLOBAL OLDMODE
+WINDOW MODE, WINDOW
+MODULE SET_RES (X, Y) {
+	OLDMODE<=MODE
+	SCREEN.PIXELS X, Y
+	WINDOW 6, X*TWIPSX, Y*TWIPSY
+	FORM 60, 40	
+	FORM ;
+	MOTION  (X*TWIPSX-SCALE.X) DIV 2, (Y*TWIPSY-SCALE.Y) DIV 2	
+	BACK {CLS 0,0:REFRESH}
+}
+MODULE RESTRORE_RES {
+	SCREEN.PIXELS !
+	WINDOW OLDMODE, WINDOW
+}
+
+SET_RES 1024, 768
+PRINT "RES  1024X768"
+PRINT "WIDTH:";WIDTH
+PRINT "HEIGHT:";HEIGHT
+fOR I=1 TO 500: PRINT ""+(I MOD 10);: NEXT
+PRINT "PRESS ANY KEY"
+A$=KEY$
+RESTRORE_RES
+WINDOW MODE, 0
+PRINT "PRESS ANY KEY"
+A$=KEY$
+PRINT "WAIT..."
+WHILE INKEY$<>""
+	WAIT 50
+END WHILE
+SET_RES 1280, 800
+PRINT "RES  1280X800"
+PRINT "WIDTH:";WIDTH
+PRINT "HEIGHT:";HEIGHT
+fOR I=1 TO 500: PRINT ""+(I MOD 10);: NEXT
+PRINT "PRESS ANY KEY"
+A$=KEY$
+RESTRORE_RES
+WINDOW MODE, 0
diff --git a/Task/Video-display-modes/QBasic/video-display-modes.basic b/Task/Video-display-modes/QBasic/video-display-modes.basic
index 81dafd66b9..1e316298d1 100644
--- a/Task/Video-display-modes/QBasic/video-display-modes.basic
+++ b/Task/Video-display-modes/QBasic/video-display-modes.basic
@@ -1,2 +1 @@
-'QBasic can switch VGA modes
-SCREEN 18 'Mode 12h 640x480 16 colour graphics
+SCREEN 13   ' use 320x200 pixels, 40x25 characters, 256 colors
diff --git a/Task/Video-display-modes/Wren/video-display-modes-2.wren b/Task/Video-display-modes/Wren/video-display-modes-2.wren
deleted file mode 100644
index d834210a12..0000000000
--- a/Task/Video-display-modes/Wren/video-display-modes-2.wren
+++ /dev/null
@@ -1,66 +0,0 @@
-/* gcc Video_display_modes.c -o Video_display_modes -lwren -lm */
-
-#include 
-#include 
-#include 
-#include 
-#include "wren.h"
-
-void C_xrandr(WrenVM* vm) {
-     const char *arg = wrenGetSlotString(vm, 1);
-     char command[strlen(arg) + 8];
-     strcpy(command, "xrandr ");
-     strcat(command, arg);
-     system(command);
-}
-
-void C_usleep(WrenVM* vm) {
-    useconds_t usec = (useconds_t)wrenGetSlotDouble(vm, 1);
-    usleep(usec);
-}
-
-WrenForeignMethodFn bindForeignMethod(
-    WrenVM* vm,
-    const char* module,
-    const char* className,
-    bool isStatic,
-    const char* signature) {
-    if (strcmp(module, "main") == 0) {
-        if (strcmp(className, "C") == 0) {
-            if (isStatic && strcmp(signature, "xrandr(_)") == 0) return C_xrandr;
-            if (isStatic && strcmp(signature, "usleep(_)") == 0) return C_usleep;
-        }
-    }
-    return NULL;
-}
-
-static void writeFn(WrenVM* vm, const char* text) {
-    printf("%s", text);
-}
-
-char *readFile(const char *fileName) {
-    FILE *f = fopen(fileName, "r");
-    fseek(f, 0, SEEK_END);
-    long fsize = ftell(f);
-    rewind(f);
-    char *script = malloc(fsize + 1);
-    fread(script, 1, fsize, f);
-    fclose(f);
-    script[fsize] = 0;
-    return script;
-}
-
-int main(int argc, char **argv) {
-    WrenConfiguration config;
-    wrenInitConfiguration(&config);
-    config.writeFn = &writeFn;
-    config.bindForeignMethodFn = &bindForeignMethod;
-    WrenVM* vm = wrenNewVM(&config);
-    const char* module = "main";
-    const char* fileName = "Video_display_modes.wren";
-    char *script = readFile(fileName);
-    wrenInterpret(vm, module, script);
-    wrenFreeVM(vm);
-    free(script);
-    return 0;
-}
diff --git a/Task/Video-display-modes/Wren/video-display-modes-1.wren b/Task/Video-display-modes/Wren/video-display-modes.wren
similarity index 50%
rename from Task/Video-display-modes/Wren/video-display-modes-1.wren
rename to Task/Video-display-modes/Wren/video-display-modes.wren
index 81433e1a32..cd523426f7 100644
--- a/Task/Video-display-modes/Wren/video-display-modes-1.wren
+++ b/Task/Video-display-modes/Wren/video-display-modes.wren
@@ -1,22 +1,17 @@
-/* Video_display_modes.wren */
-
-class C {
-    foreign static xrandr(args)
-
-    foreign static usleep(usec)
-}
+import "os" for Process
+import "timer" for Timer
 
 // query supported display modes
-C.xrandr("-q")
+Process.exec("xrandr -q")
 
-C.usleep(3000)
+Timer.wait(3000)
 
 // change display mode to 1368x768
 System.print("\nChanging to 1368 x 768 mode.")
-C.xrandr("-s 1368x768")
+Process.exec("xrandr -s 1368x768")
 
-C.usleep(3000)
+Timer.wait(3000)
 
 // change it back again to 1920x1080
 System.print("\nReverting to 1920 x 1080 mode.")
-C.xrandr("-s 1920x1080")
+Process.exec("xrandr -s 1920x1080")
diff --git a/Task/Vigen-re-cipher-Cryptanalysis/Fortran/vigen-re-cipher-cryptanalysis.f b/Task/Vigen-re-cipher-Cryptanalysis/Fortran/vigen-re-cipher-cryptanalysis.f
new file mode 100644
index 0000000000..498a7ea28d
--- /dev/null
+++ b/Task/Vigen-re-cipher-Cryptanalysis/Fortran/vigen-re-cipher-cryptanalysis.f
@@ -0,0 +1,224 @@
+module vigenere_cipher
+  use, intrinsic :: iso_fortran_env, only: real64, int32
+  implicit none
+
+  private
+  public :: vigenere_decrypt
+
+  type :: FreqPair
+    character :: c
+    real(real64) :: freq
+  end type FreqPair
+
+contains
+
+  function frequency(input_text, input_len) result(freq_result)
+    integer(int32), intent(in) :: input_text(:), input_len
+    type(FreqPair), allocatable :: freq_result(:)
+    integer :: i
+
+    allocate(freq_result(26))
+    do i = 1, 26
+      freq_result(i)%c = achar(64 + i)
+      freq_result(i)%freq = 0.0_real64
+    end do
+
+    do i = 1, input_len
+      freq_result(input_text(i) - 64)%freq = freq_result(input_text(i) - 64)%freq + 1
+    end do
+  end function frequency
+
+  function correlation(input_text, input_len, sorted_targets) result(corr)
+    integer(int32), intent(in) :: input_text(:), input_len
+    real(real64), intent(in) :: sorted_targets(:)
+    real(real64) :: corr
+    type(FreqPair), allocatable :: freq(:)
+    integer :: i, j
+    type(FreqPair) :: temp
+
+    freq = frequency(input_text, input_len)
+
+    ! Sort freq by frequency
+    do i = 1, 25
+      do j = i + 1, 26
+        if (freq(j)%freq > freq(i)%freq) then
+          temp = freq(j)
+          freq(j) = freq(i)
+          freq(i) = temp
+        end if
+      end do
+    end do
+
+    corr = 0.0_real64
+    do i = 1, 26
+      corr = corr + freq(i)%freq * sorted_targets(i)
+    end do
+
+    deallocate(freq)
+  end function correlation
+
+  subroutine vigenere_decrypt(target_freqs, encoded, out_key, out_text)
+      implicit none
+    real(real64), intent(in) :: target_freqs(:)
+    character(len=*), intent(in) :: encoded
+    character(len=:), allocatable, intent(out) :: out_key, out_text
+    integer(int32), allocatable :: cleaned(:)
+    integer :: cleaned_len, i, j, k, best_len, key_len, shift
+    real(real64) :: best_corr, corr, max_corr
+    real(real64), allocatable :: sorted_targets(:)
+    integer(int32), allocatable :: pieces(:), piece_lens(:), current_piece(:)
+    character(len=:), allocatable :: temp_key
+
+    ! Clean input text
+    allocate(cleaned(len(encoded)))
+    cleaned_len = 0
+    do i = 1, len(encoded)
+      if (encoded(i:i) >= 'A' .and. encoded(i:i) <= 'Z') then
+        cleaned_len = cleaned_len + 1
+        cleaned(cleaned_len) = iachar(encoded(i:i))
+      end if
+    end do
+
+    ! Sort target frequencies
+    allocate(sorted_targets(26))
+    sorted_targets = target_freqs
+    call sort_array(sorted_targets)
+
+    ! Find best key length
+    best_len = 0
+    best_corr = -100.0_real64
+
+    do key_len = 2,cleaned_len/20
+      allocate(pieces(cleaned_len), piece_lens(key_len))
+      pieces = cleaned
+      piece_lens = 0
+      do j = 1, cleaned_len
+        piece_lens(mod(j-1, key_len) + 1) = piece_lens(mod(j-1, key_len) + 1) + 1
+      end do
+
+      corr = -0.5_real64 * key_len
+      do i = 1, key_len
+        allocate(current_piece(piece_lens(i)))
+        k = 0
+        do j = i, cleaned_len, key_len
+          k = k + 1
+          current_piece(k) = pieces(j)
+        end do
+        corr = corr + correlation(current_piece, piece_lens(i), sorted_targets)
+        deallocate(current_piece)
+      end do
+
+      if (corr > best_corr) then
+        best_len = key_len
+        best_corr = corr
+      end if
+
+      deallocate(pieces, piece_lens)
+    end do
+
+    ! Find key
+    allocate(character(len=best_len) :: temp_key)
+    do i = 1, best_len
+      allocate(pieces(cleaned_len/best_len + 1))
+      k = 0
+      do j = i, cleaned_len, best_len
+        k = k + 1
+        pieces(k) = cleaned(j)
+      end do
+
+      max_corr = 0.0_real64
+      do concurrent (shift = 0:25)
+        corr = 0.0_real64
+        do j = 1, k
+          corr = corr + target_freqs(mod(pieces(j) - 65 - shift + 26, 26) + 1)
+        end do
+        if (corr > max_corr) then
+          max_corr = corr
+          temp_key(i:i) = achar(shift + 65)
+        end if
+      end do
+      deallocate(pieces)
+    end do
+    out_key = temp_key
+
+    ! Decrypt
+    allocate(character(len=cleaned_len) :: out_text)
+    do i = 1, cleaned_len
+      k = iachar(out_key(mod(i-1, best_len) + 1:mod(i-1, best_len) + 1)) - 65
+      out_text(i:i) = achar(mod(cleaned(i) - 65 - k + 26, 26) + 65)
+    end do
+  end subroutine vigenere_decrypt
+
+  subroutine sort_array(arr)
+    real(real64), intent(inout) :: arr(:)
+    integer :: i, j
+    real(real64) :: temp
+
+    do i = 1, size(arr) - 1
+      do j = i + 1, size(arr)
+        if (arr(j) > arr(i)) then
+          temp = arr(j)
+          arr(j) = arr(i)
+          arr(i) = temp
+        end if
+      end do
+    end do
+  end subroutine sort_array
+
+end module vigenere_cipher
+
+program main
+  use vigenere_cipher
+  use, intrinsic :: iso_fortran_env, only: real64
+  implicit none
+
+  real(real64) :: english_freqs(26) = [ &
+    0.08167, 0.01492, 0.02782, 0.04253, 0.12702, 0.02228, 0.02015, &
+    0.06094, 0.06966, 0.00153, 0.00772, 0.04025, 0.02406, 0.06749, &
+    0.07507, 0.01929, 0.00095, 0.05987, 0.06327, 0.09056, 0.02758, &
+    0.00978, 0.02360, 0.00150, 0.01974, 0.00074 ]
+
+  character(len=*), parameter :: encoded = &
+    "MOMUD EKAPV TQEFM OEVHP AJMII CDCTI FGYAG JSPXY ALUYM NSMYH" // &
+    "VUXJE LEPXJ FXGCM JHKDZ RYICU HYPUS PGIGM OIYHF WHTCQ KMLRD" // &
+    "ITLXZ LJFVQ GHOLW CUHLO MDSOE KTALU VYLNZ RFGBX PHVGA LWQIS" // &
+    "FGRPH JOOFW GUBYI LAPLA LCAFA AMKLG CETDW VOELJ IKGJB XPHVG" // &
+    "ALWQC SNWBU BYHCU HKOCE XJEYK BQKVY KIIEH GRLGH XEOLW AWFOJ" // &
+    "ILOVV RHPKD WIHKN ATUHN VRYAQ DIVHX FHRZV QWMWV LGSHN NLVZS" // &
+    "JLAKI FHXUF XJLXM TBLQV RXXHR FZXGV LRAJI EXPRV OSMNP KEPDT" // &
+    "LPRWM JAZPK LQUZA ALGZX GVLKL GJTUI ITDSU REZXJ ERXZS HMPST" // &
+    "MTEOE PAPJH SMFNB YVQUZ AALGA YDNMP AQOWT UHDBV TSMUE UIMVH" // &
+    "QGVRW AEFSP EMPVE PKXZY WLKJA GWALT VYYOB YIXOK IHPDS EVLEV" // &
+    "RVSGB JOGYW FHKBL GLXYA MVKIS KIEHY IMAPX UOISK PVAGN MZHPW" // &
+    "TTZPV XFCCD TUHJH WLAPF YULTB UXJLN SIJVV YOVDJ SOLXG TGRVO" // &
+    "SFRII CTMKO JFCQF KTINQ BWVHG TENLH HOGCS PSFPV GJOKM SIFPR" // &
+    "ZPAAS ATPTZ FTPPD PORRF TAXZP KALQA WMIUD BWNCT LEFKO ZQDLX" // &
+    "BUXJL ASIMR PNMBF ZCYLV WAPVF QRHZV ZGZEF KBYIO OFXYE VOWGB" // &
+    "BXVCB XBAWG LQKCM ICRRX MACUO IKHQU AJEGL OIJHH XPVZW JEWBA" // &
+    "FWAML ZZRXJ EKAHV FASMU LVVUT TGK"
+
+  character(len=:), allocatable :: key, decoded
+  integer :: xx,yy
+  call system_clock(count=xx)
+
+  call vigenere_decrypt(english_freqs, encoded, key, decoded)
+  call system_clock(count=yy)
+
+  print *, "Key: ", key
+  print *, "Decoded text: "
+
+block
+    INTEGER :: start, end, length, chunk_size
+    ! Define the chunk size
+    chunk_size = 80
+    ! Get the length of the string
+    length = LEN_TRIM(decoded)
+
+    ! Print the string in chunks of 80 characters
+    DO start = 1, length, chunk_size
+        end = MIN(start + chunk_size - 1, length)
+        PRINT *, decoded(start:end)
+    END DO
+end block
+  print '(/,a,1x,i0,1x,a)', 'Decoded in =',(yy-xx), 'milliseconds'
+end program main
diff --git a/Task/Vigen-re-cipher-Cryptanalysis/FreeBASIC/vigen-re-cipher-cryptanalysis.basic b/Task/Vigen-re-cipher-Cryptanalysis/FreeBASIC/vigen-re-cipher-cryptanalysis.basic
new file mode 100644
index 0000000000..d38b66c9a7
--- /dev/null
+++ b/Task/Vigen-re-cipher-Cryptanalysis/FreeBASIC/vigen-re-cipher-cryptanalysis.basic
@@ -0,0 +1,168 @@
+Type FreqPair
+    As String * 1 c
+    As Double freq
+End Type
+
+Function frequency(inputText() As Integer, inputLen As Integer) As FreqPair Ptr
+    Dim As FreqPair Ptr result = Callocate(26 * Sizeof(FreqPair))
+    Dim As Integer i
+
+    For i = 0 To 25
+        result[i].c = Chr(65 + i)
+        result[i].freq = 0.0
+    Next
+
+    For i = 0 To inputLen - 1
+        result[inputText(i) - 65].freq += 1
+    Next
+
+    Return result
+End Function
+
+Function correlation(inputText() As Integer, inputLen As Integer, sorted_targets() As Double) As Double
+    Dim As FreqPair Ptr freq = frequency(inputText(), inputLen)
+    Dim As Integer i, j
+    Dim As Double result = 0.0
+
+    'Sort freq by frequency
+    For i = 0 To 24
+        For j = i + 1 To 25
+            If freq[j].freq > freq[i].freq Then Swap freq[j], freq[i]
+        Next
+    Next
+
+    For i = 0 To 25
+        result += freq[i].freq * sorted_targets(i)
+    Next
+
+    Deallocate(freq)
+    Return result
+End Function
+
+Sub vigenereDecrypt(targetFreqs() As Double, encoded As String, Byref outKey As String, Byref outText As String)
+    Dim As Integer cleaned(Len(encoded))
+    Dim As Integer cleanedLen = 0
+    Dim As Integer i, j, k
+
+    'Clean inputText
+    For i = 1 To Len(encoded)
+        Dim As String c = Mid(encoded, i, 1)
+        If c >= "A" And c <= "Z" Then
+            cleaned(cleanedLen) = Asc(c)
+            cleanedLen += 1
+        End If
+    Next
+
+    'Sort target frequencies
+    Dim As Double sorted_targets(25)
+    For i = 0 To 25
+        sorted_targets(i) = targetFreqs(i)
+    Next
+    For i = 0 To 24
+        For j = i + 1 To 25
+            If sorted_targets(j) > sorted_targets(i) Then Swap sorted_targets(j), sorted_targets(i)
+        Next
+    Next
+
+    'Find best key length
+    Dim As Integer bestLen = 0
+    Dim As Double bestCorr = -100.0
+
+    For keyLen As Integer = 2 To cleanedLen \ 20
+        Dim As Integer pieces(cleanedLen)
+        Dim As Integer pieceLens(keyLen)
+
+        For j = 0 To cleanedLen - 1
+            pieces(j) = cleaned(j)
+            pieceLens(j Mod keyLen) += 1
+        Next
+
+        Dim As Double corr = -0.5 * keyLen
+        For i = 0 To keyLen - 1
+            Dim As Integer currentPiece(cleanedLen)
+            Dim As Integer currentLen = 0
+
+            For j = i To cleanedLen - 1 Step keyLen
+                currentPiece(currentLen) = pieces(j)
+                currentLen += 1
+            Next
+
+            corr += correlation(currentPiece(), currentLen, sorted_targets())
+        Next
+
+        If corr > bestCorr Then
+            bestLen = keyLen
+            bestCorr = corr
+        End If
+    Next
+
+    'Find key
+    outKey = ""
+    For i = 0 To bestLen - 1
+        Dim As Integer piece(cleanedLen)
+        Dim As Integer pieceLen = 0
+
+        For j = i To cleanedLen - 1 Step bestLen
+            piece(pieceLen) = cleaned(j)
+            pieceLen += 1
+        Next
+
+        Dim As Double maxCorr = 0.0
+        Dim As Integer bestShift = 0
+
+        For shift As Integer = 0 To 25
+            Dim As Double corr = 0.0
+            For j = 0 To pieceLen - 1
+                k = (piece(j) - 65 - shift + 26) Mod 26
+                corr += targetFreqs(k)
+            Next
+            If corr > maxCorr Then
+                maxCorr = corr
+                bestShift = shift
+            End If
+        Next
+
+        outKey += Chr(bestShift + 65)
+    Next
+
+    'Decrypt
+    outText = ""
+    For i = 0 To cleanedLen - 1
+        k = Asc(Mid(outKey, (i Mod bestLen) + 1, 1)) - 65
+        outText &= Chr(((cleaned(i) - 65 - k + 26) Mod 26) + 65)
+    Next
+End Sub
+
+'Main program
+Dim As Double english_freqs(25) = { _
+0.08167, 0.01492, 0.02782, 0.04253, 0.12702, 0.02228, 0.02015, _
+0.06094, 0.06966, 0.00153, 0.00772, 0.04025, 0.02406, 0.06749, _
+0.07507, 0.01929, 0.00095, 0.05987, 0.06327, 0.09056, 0.02758, _
+0.00978, 0.02360, 0.00150, 0.01974, 0.00074 }
+
+Dim As String encoded = _
+"MOMUD EKAPV TQEFM OEVHP AJMII CDCTI FGYAG JSPXY ALUYM NSMYH" & _
+"VUXJE LEPXJ FXGCM JHKDZ RYICU HYPUS PGIGM OIYHF WHTCQ KMLRD" & _
+"ITLXZ LJFVQ GHOLW CUHLO MDSOE KTALU VYLNZ RFGBX PHVGA LWQIS" & _
+"FGRPH JOOFW GUBYI LAPLA LCAFA AMKLG CETDW VOELJ IKGJB XPHVG" & _
+"ALWQC SNWBU BYHCU HKOCE XJEYK BQKVY KIIEH GRLGH XEOLW AWFOJ" & _
+"ILOVV RHPKD WIHKN ATUHN VRYAQ DIVHX FHRZV QWMWV LGSHN NLVZS" & _
+"JLAKI FHXUF XJLXM TBLQV RXXHR FZXGV LRAJI EXPRV OSMNP KEPDT" & _
+"LPRWM JAZPK LQUZA ALGZX GVLKL GJTUI ITDSU REZXJ ERXZS HMPST" & _
+"MTEOE PAPJH SMFNB YVQUZ AALGA YDNMP AQOWT UHDBV TSMUE UIMVH" & _
+"QGVRW AEFSP EMPVE PKXZY WLKJA GWALT VYYOB YIXOK IHPDS EVLEV" & _
+"RVSGB JOGYW FHKBL GLXYA MVKIS KIEHY IMAPX UOISK PVAGN MZHPW" & _
+"TTZPV XFCCD TUHJH WLAPF YULTB UXJLN SIJVV YOVDJ SOLXG TGRVO" & _
+"SFRII CTMKO JFCQF KTINQ BWVHG TENLH HOGCS PSFPV GJOKM SIFPR" & _
+"ZPAAS ATPTZ FTPPD PORRF TAXZP KALQA WMIUD BWNCT LEFKO ZQDLX" & _
+"BUXJL ASIMR PNMBF ZCYLV WAPVF QRHZV ZGZEF KBYIO OFXYE VOWGB" & _
+"BXVCB XBAWG LQKCM ICRRX MACUO IKHQU AJEGL OIJHH XPVZW JEWBA" & _
+"FWAML ZZRXJ EKAHV FASMU LVVUT TGK"
+
+Dim As String key, decoded
+vigenereDecrypt(english_freqs(), encoded, key, decoded)
+
+Print "Key: "; key
+Print !"\nDecoded text: "; decoded
+
+Sleep
diff --git a/Task/Water-collected-between-towers/EDSAC-order-code/water-collected-between-towers.edsac b/Task/Water-collected-between-towers/EDSAC-order-code/water-collected-between-towers.edsac
index ea13eafe15..78d12e5dc2 100644
--- a/Task/Water-collected-between-towers/EDSAC-order-code/water-collected-between-towers.edsac
+++ b/Task/Water-collected-between-towers/EDSAC-order-code/water-collected-between-towers.edsac
@@ -1,12 +1,12 @@
 [Water collected between towers - Rosetta Code
  For EDSAC, Initial Orders 2.]
 
-      [Arrange the storage]
-          T45K P100F      [H parameter: library subroutine R4 to read integer]
-          T46K P200F      [N parameter: modified library s/r P7 to print integer]
-          T47K P300F      [M parameter: main routine]
-          T48K P900F      [& (delta) parameter: store for array of heights]
-          T49K P400F      [L parameter: subroutine to calculate amount of water]
+  [Arrange the storage]
+    T45K P100F  [H parameter: library subroutine R4 to read integer]
+    T46K P200F  [N parameter: modified library s/r P7 to print integer]
+    T47K P300F  [M parameter: main routine]
+    T48K P900F  [& (delta) parameter: store for array of heights]
+    T49K P400F  [L parameter: subroutine to calculate amount of water]
 [-----------------------------------------------------------------------
  Subroutine to calculate amount of water as a 35-bit integer.
  Heights are in an array of 35-bit integers, preceded by a count of heights.
@@ -76,7 +76,7 @@
    [71]   AF S94#@ G77@ A94#@ T94#@ E81@
    [77]   T4D AD S4D TD
    [81]   A71@ S92@ T71@ A93@ S71@ G70@
-[Exit from suubroutine]
+[Exit from subroutine]
    [87]   T4F             [clear acc on exit, as usual]
    [88]   ZF              [(planted) jump back to caller]
 [Constants]
@@ -95,7 +95,7 @@
     [3]   P2F             [to change address by 2]
     [4]   #F              [figure shift]
     [5]   K2048F          [letter shift]
-    [6]   DF[7] IF[8] YF
+    [6] DF [7] IF [8] YF  [letters D I Y]
     [9]   NF              [comma (in figures mode)]
    [10]   @F              [carriage return]
    [11]   &F              [line feed]
@@ -110,8 +110,8 @@
           A23@ T40@       [initialize T order to store data]
           AD              [load data count, 35-bit but with high half = 0]
    [23]   T#&             [store at start of data]
-   [24]   S&              [acc := 17-bit negative count of data]
-   [25]   LD              [shift to address field *** or use k1 to inc ?? ***]
+   [24]   S&              [acc := 17-bit negative data count; also letter S]
+   [25]   LD              [shift to address field; also letter L]
           G28@            [don't print comma before first height]
 [Loop over heights in current dataset]
    [27]   O9@             [print comma]
@@ -130,7 +130,7 @@
           O25@ O6@ O24@ O12@ O4@
           A57@ GN !1F     [print result, min width = 1; leaves acc = 0]
           O10@ O11@       [print CR, LF]
-   [62]   E15@            [loop back for next data set (also letter E)]
+   [62]   E15@            [loop back for next data set; also letter E]
 [Jump to here if data count = 0, means end of data]
    [63]   O13@            [print null to flush teleprinter buffer]
           ZF              [stop the machine]
@@ -138,7 +138,7 @@
  Library subroutine R4.
  Input of one signed integer, returned in 0D.]
           E25K TH
-          GK A3F T21@ T4D H6@ E11@ P5D JF T6F VD L4F A4D TD I4F A4F S5@ G7@ S5@ G20@ SD TD T6F EF
+    GKA3FT21@T4DH6@E11@P5DJFT6FVDL4FA4DTDI4FA4FS5@G7@S5@G20@SDTDT6FEF
 [-------------------------------------------------------------------------------
  Modification of library subroutine P7; prints integer N in range 0 <= N < 10^10.
  Prints 0 correctly, and allows caller to specify a minimum width.
@@ -147,7 +147,9 @@
          e.g. !5F means minimum width 5, pad on left with space.
  49 locations; even address; workspace: 0F, 1F, 4D, 6F, 7F]
           E25K TN
-          GK A48@ U4@ A27@ T35@ AF U4@ L256F S45@ T7F H46#@ ND YF LD T4D S45@ T1F H21@ S21@ A45@ G21@ U4@ TF V4D A1F G36@ S1F LD U1F O1F F1F S1F L4F T4D AF G18@ ZF S1F L8F T4D AF A7F G43@ O4@ T6F E33@ T46#Z PF T45Z P1024F P610D @524D P2F
+    GKA48@U4@A27@T35@AFU4@L256FS45@T7FH46#@NDYFLDT4DS45@T1FH21@
+    S21@A45@G21@U4@TFV4DA1FG36@S1FLDU1FO1FF1FS1FL4FT4DAFG18@ZF
+    S1FL8FT4DAFA7FG43@O4@T6FE33@T46#ZPFT45ZP1024FP610D@524DP2F
 [--------------------------------------------------------------------------------]
 [M parameter (main routine) again]
           E25K TM GK
diff --git a/Task/Web-scraping/FreeBASIC/web-scraping.basic b/Task/Web-scraping/FreeBASIC/web-scraping.basic
deleted file mode 100644
index 2a91f1e17a..0000000000
--- a/Task/Web-scraping/FreeBASIC/web-scraping.basic
+++ /dev/null
@@ -1,66 +0,0 @@
-#include "windows.bi"
-#include "win/wininet.bi"
-
-Const BUFFER_SIZE = 4096
-
-Function GetWebPage(url As String) As String
-    Dim As HINTERNET hInternet = InternetOpen("TimeGetter", INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0)
-    Dim As String resultado = ""
-
-    If hInternet Then
-        Dim As HINTERNET hConnect = InternetOpenUrl(hInternet, url, NULL, 0, INTERNET_FLAG_RELOAD, 0)
-
-        If hConnect Then
-            Dim As String buffer = Space(BUFFER_SIZE)
-            Dim As DWORD bytesRead
-
-            Do
-                If InternetReadFile(hConnect, Strptr(buffer), BUFFER_SIZE, @bytesRead) Then
-                    If bytesRead = 0 Then Exit Do
-                    resultado &= Left(buffer, bytesRead)
-                End If
-            Loop
-
-            InternetCloseHandle(hConnect)
-        End If
-        InternetCloseHandle(hInternet)
-    End If
-
-    Return resultado
-End Function
-
-Function ScrapeTime(pageAddress As String, timeZone As String) As String
-    Dim As String page = GetWebPage(pageAddress)
-
-    If Len(page) = 0 Then Return "Cannot connect"
-
-    Dim As Integer startPos = 1
-    Do
-        Dim As Integer endPos = Instr(startPos, page, "
")
-        If endPos = 0 Then endPos = Len(page)
-
-        Dim As String linea = Mid(page, startPos, endPos - startPos)
-
-        If Instr(linea, timeZone) Then
-            For i As Integer = 1 To Len(linea) - 7
-                Dim As String char1 = Mid(linea, i, 1)
-                Dim As String char2 = Mid(linea, i+4, 1)
-                If char1 >= "0" And char1 <= "9" And  Mid(linea, i+2, 1) = ":" And _
-                    char2 >= "0" And char2 <= "9" And  Mid(linea, i+5, 1) = ":" Then
-                    Return Mid(linea, i, 8)
-                End If
-            Next
-        End If
-
-        If endPos = Len(page) Then Exit Do
-        startPos = endPos + 4
-    Loop
-
-    Return "Time not found"
-End Function
-
-' Main program
-Dim As String url = "https://rosettacode.org/wiki/Talk:Web_scraping"
-Print ScrapeTime(url, "UTC")
-
-Sleep
diff --git a/Task/Web-scraping/Wren/web-scraping-1.wren b/Task/Web-scraping/Wren/web-scraping-1.wren
deleted file mode 100644
index 60bded3b8e..0000000000
--- a/Task/Web-scraping/Wren/web-scraping-1.wren
+++ /dev/null
@@ -1,48 +0,0 @@
-/* Web_scraping.wren */
-
-import "./pattern" for Pattern
-
-var CURLOPT_URL = 10002
-var CURLOPT_FOLLOWLOCATION = 52
-var CURLOPT_WRITEFUNCTION = 20011
-var CURLOPT_WRITEDATA = 10001
-
-var BUFSIZE = 16384 * 4
-
-foreign class Buffer {
-    construct new(size) {}
-
-    // returns buffer contents as a string
-    foreign value
-}
-
-foreign class Curl {
-    construct easyInit() {}
-
-    foreign easySetOpt(opt, param)
-
-    foreign easyPerform()
-
-    foreign easyCleanup()
-}
-
-var buffer = Buffer.new(BUFSIZE)
-var curl = Curl.easyInit()
-curl.easySetOpt(CURLOPT_URL, "https://rosettacode.org/wiki/Talk:Web_scraping")
-curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1)
-curl.easySetOpt(CURLOPT_WRITEFUNCTION, 0) // write function to be supplied by C
-curl.easySetOpt(CURLOPT_WRITEDATA, buffer)
-
-curl.easyPerform()
-curl.easyCleanup()
-
-var html = buffer.value
-var ix = html.indexOf("(UTC)")
-ix = html.indexOf("(UTC)", ix + 1) // skip the site notice
-if (ix == -1) {
-    System.print("UTC time not found.")
-    return
-}
-var p = Pattern.new("/d/d:/d/d, #12/d +1/a =4/d")
-var m = p.find(html[(ix - 30).max(0)...ix])
-System.print(m.text)
diff --git a/Task/Web-scraping/Wren/web-scraping-2.wren b/Task/Web-scraping/Wren/web-scraping-2.wren
deleted file mode 100644
index 67ab072199..0000000000
--- a/Task/Web-scraping/Wren/web-scraping-2.wren
+++ /dev/null
@@ -1,173 +0,0 @@
-/* gcc Web_scraping.c -o Web_scraping -lcurl -lwren -lm  */
-
-#include 
-#include 
-#include 
-#include 
-#include "wren.h"
-
-/* C <=> Wren interface functions */
-
-char *url, *read_file, *write_file;
-
-size_t bufsize;
-size_t lr = 0;
-
-size_t filterit(void *ptr, size_t size, size_t nmemb, void *stream) {
-    if ((lr + size*nmemb) > bufsize) return bufsize;
-    memcpy(stream+lr, ptr, size * nmemb);
-    lr += size * nmemb;
-    return size * nmemb;
-}
-
-void C_bufferAllocate(WrenVM* vm) {
-    bufsize = (int)wrenGetSlotDouble(vm, 1);
-    wrenSetSlotNewForeign(vm, 0, 0, bufsize);
-}
-
-void C_curlAllocate(WrenVM* vm) {
-    CURL** pcurl = (CURL**)wrenSetSlotNewForeign(vm, 0, 0, sizeof(CURL*));
-    *pcurl = curl_easy_init();
-}
-
-void C_value(WrenVM* vm) {
-    const char *s = (const char *)wrenGetSlotForeign(vm, 0);
-    wrenSetSlotString(vm, 0, s);
-}
-
-void C_easyPerform(WrenVM* vm) {
-    CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0);
-    curl_easy_perform(curl);
-}
-
-void C_easyCleanup(WrenVM* vm) {
-    CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0);
-    curl_easy_cleanup(curl);
-}
-
-void C_easySetOpt(WrenVM* vm) {
-    CURL* curl = *(CURL**)wrenGetSlotForeign(vm, 0);
-    CURLoption opt = (CURLoption)wrenGetSlotDouble(vm, 1);
-    if (opt < 10000) {
-        long lparam = (long)wrenGetSlotDouble(vm, 2);
-        curl_easy_setopt(curl, opt, lparam);
-    } else if (opt < 20000) {
-        if (opt == CURLOPT_WRITEDATA) {
-            char *buffer = (char *)wrenGetSlotForeign(vm, 2);
-            curl_easy_setopt(curl, opt, buffer);
-        } else if (opt == CURLOPT_URL) {
-            const char *url = wrenGetSlotString(vm, 2);
-            curl_easy_setopt(curl, opt, url);
-        }
-    } else if (opt < 30000) {
-        if (opt == CURLOPT_WRITEFUNCTION) {
-            curl_easy_setopt(curl, opt, &filterit);
-        }
-    }
-}
-
-WrenForeignClassMethods bindForeignClass(WrenVM* vm, const char* module, const char* className) {
-    WrenForeignClassMethods methods;
-    methods.allocate = NULL;
-    methods.finalize = NULL;
-    if (strcmp(module, "main") == 0) {
-        if (strcmp(className, "Buffer") == 0) {
-            methods.allocate = C_bufferAllocate;
-        } else if (strcmp(className, "Curl") == 0) {
-            methods.allocate = C_curlAllocate;
-        }
-    }
-    return methods;
-}
-
-WrenForeignMethodFn bindForeignMethod(
-    WrenVM* vm,
-    const char* module,
-    const char* className,
-    bool isStatic,
-    const char* signature) {
-    if (strcmp(module, "main") == 0) {
-        if (strcmp(className, "Buffer") == 0) {
-            if (!isStatic && strcmp(signature, "value") == 0)           return C_value;
-        } else if (strcmp(className, "Curl") == 0) {
-            if (!isStatic && strcmp(signature, "easySetOpt(_,_)") == 0) return C_easySetOpt;
-            if (!isStatic && strcmp(signature, "easyPerform()") == 0)   return C_easyPerform;
-            if (!isStatic && strcmp(signature, "easyCleanup()") == 0)   return C_easyCleanup;
-        }
-    }
-    return NULL;
-}
-
-static void writeFn(WrenVM* vm, const char* text) {
-    printf("%s", text);
-}
-
-void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) {
-    switch (errorType) {
-        case WREN_ERROR_COMPILE:
-            printf("[%s line %d] [Error] %s\n", module, line, msg);
-            break;
-        case WREN_ERROR_STACK_TRACE:
-            printf("[%s line %d] in %s\n", module, line, msg);
-            break;
-        case WREN_ERROR_RUNTIME:
-            printf("[Runtime Error] %s\n", msg);
-            break;
-    }
-}
-
-char *readFile(const char *fileName) {
-    FILE *f = fopen(fileName, "r");
-    fseek(f, 0, SEEK_END);
-    long fsize = ftell(f);
-    rewind(f);
-    char *script = malloc(fsize + 1);
-    fread(script, 1, fsize, f);
-    fclose(f);
-    script[fsize] = 0;
-    return script;
-}
-
-static void loadModuleComplete(WrenVM* vm, const char* module, WrenLoadModuleResult result) {
-    if( result.source) free((void*)result.source);
-}
-
-WrenLoadModuleResult loadModule(WrenVM* vm, const char* name) {
-    WrenLoadModuleResult result = {0};
-    if (strcmp(name, "random") != 0 && strcmp(name, "meta") != 0) {
-        result.onComplete = loadModuleComplete;
-        char fullName[strlen(name) + 6];
-        strcpy(fullName, name);
-        strcat(fullName, ".wren");
-        result.source = readFile(fullName);
-    }
-    return result;
-}
-
-int main(int argc, char **argv) {
-    WrenConfiguration config;
-    wrenInitConfiguration(&config);
-    config.writeFn = &writeFn;
-    config.errorFn = &errorFn;
-    config.bindForeignClassFn = &bindForeignClass;
-    config.bindForeignMethodFn = &bindForeignMethod;
-    config.loadModuleFn = &loadModule;
-    WrenVM* vm = wrenNewVM(&config);
-    const char* module = "main";
-    const char* fileName = "Web_scraping.wren";
-    char *script = readFile(fileName);
-    WrenInterpretResult result = wrenInterpret(vm, module, script);
-    switch (result) {
-        case WREN_RESULT_COMPILE_ERROR:
-            printf("Compile Error!\n");
-            break;
-        case WREN_RESULT_RUNTIME_ERROR:
-            printf("Runtime Error!\n");
-            break;
-        case WREN_RESULT_SUCCESS:
-            break;
-    }
-    wrenFreeVM(vm);
-    free(script);
-    return 0;
-}
diff --git a/Task/Web-scraping/Wren/web-scraping.wren b/Task/Web-scraping/Wren/web-scraping.wren
new file mode 100644
index 0000000000..74bf5a466e
--- /dev/null
+++ b/Task/Web-scraping/Wren/web-scraping.wren
@@ -0,0 +1,13 @@
+import "os" for Process
+import "./pattern" for Pattern
+
+var page = "https://rosettacode.org/wiki/Talk:Web_scraping"
+var html = Process.read("curl -s %(page)")
+var ix = html.indexOf("(UTC)")
+if (ix == -1) {
+    System.print("UTC time not found.")
+    return
+}
+var p = Pattern.new("/d/d:/d/d, #12/d +1/a =4/d")
+var m = p.find(html[(ix - 30).max(0)...ix])
+System.print(m.text)
diff --git a/Task/Weird-numbers/Arturo/weird-numbers.arturo b/Task/Weird-numbers/Arturo/weird-numbers.arturo
new file mode 100644
index 0000000000..262fc7f6e2
--- /dev/null
+++ b/Task/Weird-numbers/Arturo/weird-numbers.arturo
@@ -0,0 +1,47 @@
+semiperfect?: function [facts number].memoize [
+    sumAll: sum facts
+
+    if sumAll = number -> return true
+    if sumAll < number -> return false
+
+    current: first facts
+    remaining: drop facts
+
+    if number < current -> return semiperfect? remaining number
+    if number = current -> return true
+
+    if semiperfect? remaining number-current -> return true
+    return semiperfect? remaining number
+]
+
+findWeirdNumbers: function [limit][
+    sieve: repeat false limit
+
+    loop 2..limit-1 'num [
+        unless sieve\[num][
+            divisors: (factors num) -- num
+            sumDivisors: sum divisors
+
+            (sumDivisors =< num)? [
+                sieve\[num]: true
+            ][
+                if semiperfect? divisors num [
+                    j: num
+                    while [j < limit][
+                        sieve\[j]: true
+                        j: j + num
+                    ]
+                ]
+            ]
+        ]
+    ]
+
+    return drop.times:2 sieve
+]
+
+print "The first 25 weird numbers:"
+
+(findWeirdNumbers 17000) | map.with:'i 'x -> @[i+2,x]
+                         | select.first: 25 => [not? last &]
+                         | map => [first &]
+                         | print
diff --git a/Task/Weird-numbers/YAMLScript/weird-numbers.ys b/Task/Weird-numbers/YAMLScript/weird-numbers.ys
index 2bf68a1df2..7d70463afd 100644
--- a/Task/Weird-numbers/YAMLScript/weird-numbers.ys
+++ b/Task/Weird-numbers/YAMLScript/weird-numbers.ys
@@ -1,4 +1,4 @@
-!yamlscript/v0
+!YS-v0
 
 defn main(max=16500):
   weird =: sieve(max)
diff --git a/Task/Wieferich-primes/Ring/wieferich-primes.ring b/Task/Wieferich-primes/Ring/wieferich-primes.ring
new file mode 100644
index 0000000000..fc2d11c4b6
--- /dev/null
+++ b/Task/Wieferich-primes/Ring/wieferich-primes.ring
@@ -0,0 +1,27 @@
+load "stdlib.ring"
+
+see "working..." + nl
+
+for i = 1 to 5000
+    if isWeiferich(i)
+       see "" + i + nl
+    ok
+next
+
+see "done..." + nl
+
+function isWeiferich(p)
+    if not isPrime(p)
+       return False
+    ok
+    q = 1
+    p2 = pow(p,2)
+    while p > 1
+        q = (2 * q) % p2
+        p -= 1
+    end
+    if q = 1
+       return True
+    else
+       return False
+    ok
diff --git a/Task/Window-creation/XPL0/window-creation.xpl0 b/Task/Window-creation/XPL0/window-creation.xpl0
index 00479559c2..acd120e96f 100644
--- a/Task/Window-creation/XPL0/window-creation.xpl0
+++ b/Task/Window-creation/XPL0/window-creation.xpl0
@@ -1,43 +1,38 @@
-\12345678901234567890123456789012345
-\Window creation...............  X .
+\012345678901234567890123456789012345
+\ Window creation...............  X .
 
-def  X0=20, Y0=10;              \upper-left corner of window's position (chars)
-int  Mouse, Button, C;
+def  X0=20, Y0=10;              \position of upper-left corner of window (chars)
+int  Mouse, Button, X, Y;
 
 func GetButton;                 \Return soft button number at mouse pointer
-int  X, Y;
-[Mouse:= GetMouse;
-X:= Mouse(0)/8 - X0;            \convert pixels to char cells
+[Mouse:= GetMouse;              \get pointer to mouse array information
+X:= Mouse(0)/8  - X0;           \convert pixels to 8x16-pixel character cells
 Y:= Mouse(1)/16 - Y0;
-if X>=32 & X<=34 & Y=0 then return 0;           \exit [X]
+if X>=32 & X<=34 & Y=0 then return 0;   \exit [X]
 return -1;                      \mouse not on any soft button
 ];
 
-[SetVid($12);                   \640x480 graphics
-TrapC(true);                    \disable Ctrl+C
-Attrib($70);                    \black on gray
-SetWind(0+X0, 0+Y0, 35+X0, 8+Y0, 0, \fill\true);
-Cursor(33+X0, 0+Y0); Text(6, "X");
-
-Attrib($1F);                    \bright white on blue, for title
+[SetVid($12);                   \set 640x480 graphics
+TrapC(true);                    \prevent Ctrl+C from aborting the program
+Attrib($70);                    \set black-on-gray color attribute
+SetWind(0+X0, 0+Y0, 35+X0, 8+Y0, 0, \fill\true);        \draw gray rectangle
+Cursor(33+X0, 0+Y0);  Text(6, "X");                     \draw exit button
+Attrib($9F);                    \set bright white on light blue, for title bar
 Cursor(0+X0, 0+Y0);  Text(6, " Window creation               ");
-
-ShowMouse(true);
+ShowMouse(true);                        \turn on mouse pointer
 loop    [MoveMouse;                     \make pointer track mouse movements
-        Mouse:= GetMouse;
+        Mouse:= GetMouse;               \get pointer to mouse array information
         if Mouse(2) then                \a left or right mouse button is down
             [Button:= GetButton;        \get soft button at mouse pointer
-            while Mouse(2) do           \wait for mouse button's release
+            while Mouse(2) do           \wait for mouse button(s) to be released
                 [MoveMouse;
                 Mouse:= GetMouse;
                 ];
-            if Button = GetButton then  \if down Button = release button
-                if Button = 0 then quit;
-            ];
-        if KeyHit then
-            [C:= ChIn(1);               \get character from non-echoed keyboard
-            if C = \Esc\$1B then quit;
+            if Button = GetButton then  \if down Button = release button and it
+                if Button = 0 then quit; \is the exit [X] button then quit loop
             ];
+        if KeyHit then                  \get character from non-echoed keyboard
+            if ChIn(1) = \Esc\$1B then quit; \Esc key also exits program
         ];
 SetVid(3);                              \restore normal text mode immediately
 ]
diff --git a/Task/Window-management/M2000-Interpreter/window-management.m2000 b/Task/Window-management/M2000-Interpreter/window-management.m2000
new file mode 100644
index 0000000000..15503b0c16
--- /dev/null
+++ b/Task/Window-management/M2000-Interpreter/window-management.m2000
@@ -0,0 +1,63 @@
+Module WindowManagment{
+	Declare Form1 Form
+	With Form1, "UseIcon", True, "UseReverse", True
+	With Form1, "Title" As Caption$, "Visible" As Visible,"TitleHeight" As tHeight
+	With Form1, "Sizable", True, "Height" as WHeight, "Width" as WWidth
+	Print "First Window Caption: ";Caption$
+	Print "Title Height: ";tHeight
+	Print "Window Width: ";WWidth
+	Print "Window Height: ";WHeight
+	NotNow=true
+	Function Form1.Unload {
+	      Read New &Ok
+	      if NotNow Else visible=false
+	      Ok=true
+	}
+	Caption$="Window Managment"
+	Print "Show - no modal"
+	Method Form1,"Show"   ' , 1 for modal opening
+	Wait 3000
+	Print "Show on TaskBar also"
+	Method Form1,"ShowTaskBar"
+	Wait 5000 ' 10 second
+	Print "Minimize Window"
+	Method form1,"Minimize"
+	Wait 2000
+	Print "Show again"
+	Method Form1, "Show"
+	Wait 3000
+	Print "Maximize Window"
+	Method Form1, "Maximize", true as res
+	print res
+	Wait 5000
+	Print "Restore to normal"
+	Method Form1, "Maximize", false as res
+	print res
+	Wait 5000
+	Print "Move Window to 0,0"
+	Method Form1, "Show"
+	Method Form1, "move", 0,0 ', 6000, Wheight*2
+	Wait 5000
+	Print "Resize Window"
+	NotNow=false
+	Method Form1, "move", 0,0 , WWidth*1.5, Wheight*2
+	Print "Click Unload (is a fake unload)"
+	profiler ' hires timer
+	do
+		Wait 10
+	Until timecount>5000 or not visible
+	visible=false
+	Wait 3000
+	Print "Modal view - Wait user to close window"
+	Print "Click Unload - isn't fake now"
+	' We have an event to stop unloading
+	' Modal show just release inner loop when we press unload
+	Method Form1,"Show", 1 'for modal opening
+	wait 5000
+	' to prove it lets show window again
+	print "ho ho ho - last time...Click Unload"
+	Method Form1,"Show", 1 'for modal opening
+	' So here we unload the Form1 by software
+	Declare Form1 Nothing
+}
+WindowManagment
diff --git a/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file.pas b/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-1.pas
similarity index 100%
rename from Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file.pas
rename to Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-1.pas
diff --git a/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-2.pas b/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-2.pas
new file mode 100644
index 0000000000..da3d6b5d84
--- /dev/null
+++ b/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-2.pas
@@ -0,0 +1,3 @@
+create or replace table t (x DOUBLE, y DOUBLE);
+
+insert into t select unnest ([1, 2, 3, 1e11]) as x, sqrt(x) as y;
diff --git a/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-3.pas b/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-3.pas
new file mode 100644
index 0000000000..70596cc0cf
--- /dev/null
+++ b/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-3.pas
@@ -0,0 +1,6 @@
+.header off
+.mode list
+.output output.tsv
+select format('{:.3f}', x) || chr(9) || format('{:.5f}', y) from t;
+.output
+.shell cat output.tsv
diff --git a/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-4.pas b/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-4.pas
new file mode 100644
index 0000000000..c9fce11703
--- /dev/null
+++ b/Task/Write-float-arrays-to-a-text-file/Delphi/write-float-arrays-to-a-text-file-4.pas
@@ -0,0 +1,5 @@
+create or replace table neat (x DECIMAL(38,3), y DECIMAL(38,5));
+insert into neat from t;
+from neat;
+copy neat to 'output.tsv' (HEADER true, DELIMITER '\t');
+.shell cat output.tsv
diff --git a/Task/Write-language-name-in-3D-ASCII/M2000-Interpreter/write-language-name-in-3d-ascii.m2000 b/Task/Write-language-name-in-3D-ASCII/M2000-Interpreter/write-language-name-in-3d-ascii.m2000
new file mode 100644
index 0000000000..6340d4d51f
--- /dev/null
+++ b/Task/Write-language-name-in-3D-ASCII/M2000-Interpreter/write-language-name-in-3d-ascii.m2000
@@ -0,0 +1,19 @@
+Bold 0
+Font "COURIER NEW"
+Form 74, 8;  ' ; set linespace to 0 ' center form to current monitor
+Form  ' cut the border so only 74X8 lines on a non head window displayed
+' ASCII ART - 3D LANGUAGE NAME
+Desktop 200 ' Opacity at 200/255*100%
+?"   _______  ______      _______  _________   _________   _________"
+?"  |\   ___\/ ___  \    /  __  /||\  ____  \ |\  ____  \ |\  ____  \"
+?"  \ \  \_|\__\_|\  \  /_/|_/ / |\ \ \___|\ \\ \ \___|\ \\ \ \___|\ \"
+?"   \ \  \\|__| \ \  \ |_|// / /  \ \ \  \ \ \\ \ \  \ \ \\ \ \  \ \ \"
+?"    \ \  \      \ \  \   / /_/____\ \ \__\_\ \\ \ \__\_\ \\ \ \__\_\ \"
+?"     \ \__\      \ \__\ |\________\\ \________\\ \________\\ \________\"
+?"      \|__|       \|__| \|________| \|________| \|________| \|________|"
+Push Key$: Drop
+Desktop 255 ' 100% opacity
+Font "Verdana"
+Bold 1
+Form;  ' enable border -  at screen size
+Form 60, 32
diff --git a/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-2.py b/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-2.py
index 45150d043c..b8acde2aae 100644
--- a/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-2.py
+++ b/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-2.py
@@ -46,7 +46,6 @@ charSet4 = [
 "   |__/   \________/   |__/             ",
 ]
 
-# ...then the sets are combined back by barbequing them together!
 charTable = [(charSet1[i] +
               charSet2[i] +
               charSet3[i] +
diff --git a/Task/Yahoo-search-interface/FutureBasic/yahoo-search-interface.basic b/Task/Yahoo-search-interface/FutureBasic/yahoo-search-interface.basic
new file mode 100644
index 0000000000..5fe89471b6
--- /dev/null
+++ b/Task/Yahoo-search-interface/FutureBasic/yahoo-search-interface.basic
@@ -0,0 +1,21 @@
+include "Tlbx WebKit.incl"
+
+_window = 1
+begin enum 1
+  _webView
+end enum
+
+void local fn BuildWindow
+  CGRect r = ( 0, 0, 700, 400 )
+  window _window, @"WKWebView", r
+
+  wkwebview _webView, r
+  ViewSetAutoresizingMask( _webView, NSViewWidthSizable + NSViewHeightSizable )
+  CFURLRef url = fn URLWithString( @"https://search.yahoo.com/" )
+  URLRequestRef request = fn URLRequestWithURL( url )
+  fn WKWebViewLoadRequest( _webView, request )
+end fn
+
+fn BuildWindow
+
+HandleEvents
diff --git a/Task/Yin-and-yang/Commodore-BASIC/yin-and-yang-4.basic b/Task/Yin-and-yang/Commodore-BASIC/yin-and-yang-4.basic
new file mode 100644
index 0000000000..e0ba892dd3
--- /dev/null
+++ b/Task/Yin-and-yang/Commodore-BASIC/yin-and-yang-4.basic
@@ -0,0 +1,15 @@
+0 REM COMMANDER X-16
+10 SCREEN 128
+20 RECT 0,0,319,239,0
+30 X=100:Y=120:XR=98:YR=98:GOSUB 100
+40 X=260:Y=180:XR=48:YR=48:GOSUB 100
+50 GET K$: IF K$="" THEN 50
+60 END
+100 OVAL X-XR,Y-YR,X+XR,Y+YR,1
+110 RECT X,Y-YR,X+YR,Y+YR,0
+120 OVAL X-XR/2,Y-YR,X+XR/2,Y,1
+130 OVAL X-XR/2,Y,X+XR/2,Y+YR,0
+140 RING X-XR,Y-YR,X+XR,Y+YR,1
+150 OVAL X-XR/8,Y-YR/2-YR/8,X+XR/8,Y-YR/2+YR/8,0
+160 OVAL X-XR/8,Y+YR/2-YR/8,X+XR/8,Y+YR/2+YR/8,1
+170 RETURN
diff --git a/Task/Yin-and-yang/FreeBASIC/yin-and-yang.basic b/Task/Yin-and-yang/FreeBASIC/yin-and-yang.basic
index d5f8fa7752..bbf3d40164 100644
--- a/Task/Yin-and-yang/FreeBASIC/yin-and-yang.basic
+++ b/Task/Yin-and-yang/FreeBASIC/yin-and-yang.basic
@@ -14,4 +14,5 @@ End Sub
 
 Taijitu(110, 110, 45)
 Taijitu(500, 300, 138)
+Sleep
 End
diff --git a/Task/Yin-and-yang/Nim/yin-and-yang.nim b/Task/Yin-and-yang/Nim/yin-and-yang.nim
index efee2bee37..8f73b61fd3 100644
--- a/Task/Yin-and-yang/Nim/yin-and-yang.nim
+++ b/Task/Yin-and-yang/Nim/yin-and-yang.nim
@@ -1,24 +1,24 @@
-import gintro/cairo
+import cairo
 
-proc draw(ctx: Context; x, y, r: float) =
+proc draw(ctx: ptr Context; x, y, r: float) =
   ctx.arc(x, y, r + 1, 1.571, 7.854)
-  ctx.setSource(0.0, 0.0, 0.0)
+  ctx.setSourceRgb(0.0, 0.0, 0.0)
   ctx.fill()
   ctx.arcNegative(x, y - r / 2, r / 2, 1.571, 4.712)
   ctx.arc(x, y + r / 2, r / 2, 1.571, 4.712)
   ctx.arcNegative(x, y, r, 4.712, 1.571)
-  ctx.setSource(1.0, 1.0, 1.0)
+  ctx.setSourceRgb(1.0, 1.0, 1.0)
   ctx.fill()
   ctx.arc(x, y - r / 2, r / 5, 1.571, 7.854)
-  ctx.setSource(0.0, 0.0, 0.0)
+  ctx.setSourceRgb(0.0, 0.0, 0.0)
   ctx.fill()
   ctx.arc(x, y + r / 2, r / 5, 1.571, 7.854)
-  ctx.setSource(1.0, 1.0, 1.0)
+  ctx.setSourceRgb(1.0, 1.0, 1.0)
   ctx.fill()
 
-let surface = imageSurfaceCreate(argb32, 200, 200)
-let context = newContext(surface)
+let surface = imageSurfaceCreate(FormatArgb32, 200, 200)
+let context = create(surface)
 context.draw(120, 120, 75)
 context.draw(35, 35, 30)
 let status = surface.writeToPng("yin-yang.png")
-assert status == Status.success
+assert status == StatusSuccess
diff --git a/Task/Yin-and-yang/UNIX-Shell/yin-and-yang.sh b/Task/Yin-and-yang/UNIX-Shell/yin-and-yang.sh
index d4b26c6e90..1d6a476124 100644
--- a/Task/Yin-and-yang/UNIX-Shell/yin-and-yang.sh
+++ b/Task/Yin-and-yang/UNIX-Shell/yin-and-yang.sh
@@ -4,19 +4,19 @@ in_circle() { #(cx, cy, r, x y)
   # on (cx,cy)
   # (but really scaled to an ellipse with vertical minor semiaxis r and
   # horizontal major semiaxis 2r)
-  local -i cx=$1 cy=$2 r=$3 x=$4 y=$5
-  local -i dx dy
+  typeset -i cx=$1 cy=$2 r=$3 x=$4 y=$5
+  typeset -i dx dy
   (( dx=(x-cx)/2, dy=y-cy, dx*dx + dy*dy <= r*r ))
 }
 
 taijitu() { #radius
-  local -i radius=${1:-17}
-  local -i x1=0 y1=0 r1=radius            # outer circle
-  local -i x2=0 y2=-radius/2 r2=radius/6  # upper eye
-  local -i x3=0 y3=-radius/2 r3=radius/2  # upper half
-  local -i x4=0 y4=+radius/2 r4=radius/6  # lower eye
-  local -i x5=0 y5=+radius/2 r5=radius/2  # lower half
-  local -i x y
+  typeset -i radius=${1:-17}
+  typeset -i x1=0 y1=0 r1=radius            # outer circle
+  typeset -i x2=0 y2=-radius/2 r2=radius/6  # upper eye
+  typeset -i x3=0 y3=-radius/2 r3=radius/2  # upper half
+  typeset -i x4=0 y4=+radius/2 r4=radius/6  # lower eye
+  typeset -i x5=0 y5=+radius/2 r5=radius/2  # lower half
+  typeset -i x y
   for (( y=radius; y>=-radius; --y )); do
     for (( x=-2*radius; x<=2*radius; ++x)); do
       if ! in_circle $x1 $y1 $r1 $x $y; then
diff --git a/Task/Zumkeller-numbers/Arturo/zumkeller-numbers.arturo b/Task/Zumkeller-numbers/Arturo/zumkeller-numbers.arturo
new file mode 100644
index 0000000000..4e978ca0d6
--- /dev/null
+++ b/Task/Zumkeller-numbers/Arturo/zumkeller-numbers.arturo
@@ -0,0 +1,27 @@
+prettyPrint: function [data,cols,padding][
+    data | split.every: cols
+         | map => [join map & 'x -> pad to :string x padding]
+         | print.lines
+]
+
+zumkeller?: function [n][
+    divSum: sum divs: <= factors n
+    if nand? [even? divSum][divSum >= 2*n] -> return false
+
+    half: divSum/2
+    loop 1..(size divs)/2 'combiSize [
+        if some? combine.by:combiSize divs 'combo ->
+            half = sum combo ->
+                return true
+    ]
+
+    return false
+]
+
+print "First 220 Zumkeller numbers:"
+(1..∞) | select.first: 220 => zumkeller?
+       | prettyPrint 14 4
+
+print "\nFirst 40 odd Zumkeller numbers:"
+(1..∞) | select.first: 40 'n -> and? [odd? n][zumkeller? n]
+       | prettyPrint 10 6