Add Forth solutions

4 files changed, 243 insertions, 2 deletions

diff --git a/challenge-001/paulo-custodio/forth/ch-1.fs b/challenge-001/paulo-custodio/forth/ch-1.fs
index 6f8220bcf9..0c41bf47c7 100644
--- a/challenge-001/paulo-custodio/forth/ch-1.fs
+++ b/challenge-001/paulo-custodio/forth/ch-1.fs
@@ -3,8 +3,8 @@
 \ Challenge 001
 \
 \ Challenge #1
-\ Write a script to replace the character ‘e’ with ‘E’ in the string
-\ ‘Perl Weekly Challenge’. Also print the number of times the character ‘e’
+\ Write a script to replace the character 'e' with 'E' in the string
+\ 'Perl Weekly Challenge'. Also print the number of times the character 'e'
 \ is found in the string.
 
 \ init PAD as empty string
diff --git a/challenge-242/paulo-custodio/forth/ch-1.fs b/challenge-242/paulo-custodio/forth/ch-1.fs
new file mode 100644
index 0000000000..6de8f3a904
--- /dev/null
+++ b/challenge-242/paulo-custodio/forth/ch-1.fs
@@ -0,0 +1,127 @@
+#! /usr/bin/env gforth
+
+\ Challenge 242
+\
+\ Task 1: Missing Members
+\ Submitted by: Mohammad S Anwar
+\ You are given two arrays of integers.
+\
+\ Write a script to find out the missing members in each other arrays.
+\
+\ Example 1
+\ Input: @arr1 = (1, 2, 3)
+\        @arr2 = (2, 4, 6)
+\ Output: ([1, 3], [4, 6])
+\
+\ (1, 2, 3) has 2 members (1, 3) missing in the array (2, 4, 6).
+\ (2, 4, 6) has 2 members (4, 6) missing in the array (1, 2, 3).
+\ Example 2
+\ Input: @arr1 = (1, 2, 3, 3)
+\        @arr2 = (1, 1, 2, 2)
+\ Output: ([3])
+\
+\ (1, 2, 3, 3) has 2 members (3, 3) missing in the array (1, 1, 2, 2). Since they are same, keep just one.
+\ (1, 1, 2, 2) has 0 member missing in the array (1, 2, 3, 3).
+
+CREATE arr1 256 CELLS ALLOT
+CREATE arr2 256 CELLS ALLOT
+
+: array_size ( arr-addr -- size-addr ) ;
+: array[] ( arr-addr i -- elem-addr ) 1+ CELLS + ;
+
+: array_push_back ( arr-addr n -- )
+    { arr n }
+    arr array_size @    ( size )
+    arr SWAP array[]    ( elem-addr )
+    n SWAP !
+    arr array_size 1 SWAP +!
+;
+
+: array_find ( arr-addr n -- f )
+    { arr n }
+    FALSE { found }
+    arr array_size @ 0 ?DO
+        arr I array[] @  n = IF TRUE TO found LEAVE THEN
+    LOOP
+    found
+;
+
+: array_push_back_if_new ( arr-add n -- )
+    { arr n }
+    arr n array_find 0= IF
+        arr n array_push_back
+    THEN
+;
+
+: is_digit ( c -- f )
+    DUP '0' >= SWAP '9' <= AND
+;
+
+: starts_with_digit ( addr len -- f )
+    0 > SWAP C@ is_digit AND
+;
+
+: skip_non_digits ( addr len -- addr len )
+    BEGIN DUP WHILE
+        2DUP starts_with_digit IF EXIT THEN
+        1 /STRING
+    REPEAT
+;
+
+: parse_number ( addr len -- addr len number t | addr len f )
+    0 { num }
+    skip_non_digits
+    2DUP starts_with_digit IF
+        BEGIN 2DUP starts_with_digit WHILE
+            OVER C@ '0' -  num BASE *  + TO num
+            1 /STRING
+        REPEAT
+        num TRUE
+    ELSE
+        FALSE
+    THEN
+;
+
+: array_parse_nums ( arr-add str-addr size -- )
+    { arr str len }
+    BEGIN str len parse_number WHILE
+        arr SWAP array_push_back_if_new
+        TO len TO str
+    REPEAT
+    2DROP
+;
+
+: collect_args ( -- )
+    arr1 NEXT-ARG array_parse_nums
+    arr2 NEXT-ARG array_parse_nums
+;
+
+: print_missing ( arr1 arr2 is-first -- )
+    { arr1 arr2 is-first }
+    FALSE { found }
+    arr1 array_size @ 0 ?DO
+        arr1 I array[] @
+        arr2 SWAP array_find 0= IF
+            found 0= IF
+                is-first 0= IF ." , " THEN
+                ." ["
+            ELSE
+                ." , "
+            THEN
+            TRUE TO found
+            arr1 I array[] @ .
+        THEN
+    LOOP
+    found IF ." ]" THEN
+;
+
+: output ( -- )
+    ." ("
+    arr1 arr2 TRUE  print_missing
+    arr2 arr1 FALSE print_missing
+    ." )" CR
+;
+
+collect_args
+output
+BYE
diff --git a/challenge-243/paulo-custodio/forth/ch-1.fs b/challenge-243/paulo-custodio/forth/ch-1.fs
new file mode 100644
index 0000000000..5325b2cc8b
--- /dev/null
+++ b/challenge-243/paulo-custodio/forth/ch-1.fs
@@ -0,0 +1,58 @@
+#! /usr/bin/env gforth
+
+\ Challenge 243
+\
+\ Task 1: Reverse Pairs
+\ Submitted by: Mohammad S Anwar
+\ You are given an array of integers.
+\
+\ Write a script to return the number of reverse pairs in the given array.
+\
+\ A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j].
+\
+\ Example 1
+\ Input: @nums = (1, 3, 2, 3, 1)
+\ Output: 2
+\
+\ (1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1
+\ (3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1
+\ Example 2
+\ Input: @nums = (2, 4, 3, 5, 1)
+\ Output: 3
+\
+\ (1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1
+\ (2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1
+\ (3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1
+
+CREATE nums 256 CELLS ALLOT
+0 VALUE nums_size
+
+: nums[] ( i -- addr )
+    CELLS nums +
+;
+
+: collect_args ( -- )
+    BEGIN NEXT-ARG DUP WHILE
+        0 0 2SWAP >NUMBER 2DROP DROP
+        nums_size nums[] !
+        nums_size 1+ TO nums_size
+    REPEAT
+    2DROP
+;
+
+: count_reverse_pairs ( -- n )
+    0 { count }
+    nums_size 1- 0 DO
+        nums_size I 1+ DO
+            J nums[] @  I nums[] @ 2* > IF
+                count 1+ TO count
+            THEN
+        LOOP
+    LOOP
+    count
+;
+
+\ main
+collect_args
+count_reverse_pairs . CR
+BYE
diff --git a/challenge-243/paulo-custodio/forth/ch-2.fs b/challenge-243/paulo-custodio/forth/ch-2.fs
new file mode 100644
index 0000000000..d762dbf362
--- /dev/null
+++ b/challenge-243/paulo-custodio/forth/ch-2.fs
@@ -0,0 +1,56 @@
+#! /usr/bin/env gforth
+
+\ Challenge 243
+\
+\ Task 1: Reverse Pairs
+\ Submitted by: Mohammad S Anwar
+\ You are given an array of integers.
+\
+\ Write a script to return the number of reverse pairs in the given array.
+\
+\ A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j].
+\
+\ Example 1
+\ Input: @nums = (1, 3, 2, 3, 1)
+\ Output: 2
+\
+\ (1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1
+\ (3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1
+\ Example 2
+\ Input: @nums = (2, 4, 3, 5, 1)
+\ Output: 3
+\
+\ (1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1
+\ (2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1
+\ (3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1
+
+CREATE nums 256 CELLS ALLOT
+0 VALUE nums_size
+
+: nums[] ( i -- addr )
+    CELLS nums +
+;
+
+: collect_args ( -- )
+    BEGIN NEXT-ARG DUP WHILE
+        0 0 2SWAP >NUMBER 2DROP DROP
+        nums_size nums[] !
+        nums_size 1+ TO nums_size
+    REPEAT
+    2DROP
+;
+
+: sum_floor ( -- n )
+    0 { sum }
+    nums_size 0 DO
+        nums_size 0 DO
+            sum  J nums[] @  I nums[] @  /  +  TO sum
+        LOOP
+    LOOP
+    sum
+;
+
+\ main
+collect_args
+sum_floor . CR
+BYE