Add Forth and BASIC solutions

4 files changed, 422 insertions, 0 deletions

diff --git a/challenge-204/paulo-custodio/basic/ch-1.bas b/challenge-204/paulo-custodio/basic/ch-1.bas
new file mode 100644
index 0000000000..d65d077051
--- /dev/null
+++ b/challenge-204/paulo-custodio/basic/ch-1.bas
@@ -0,0 +1,63 @@
+' Challenge 204
+'
+' Task 1: Monotonic Array
+' Submitted by: Mohammad S Anwar
+'
+' You are given an array of integers.
+'
+' Write a script to find out if the given array is Monotonic. Print 1 if it is otherwise 0.
+'
+'     An array is Monotonic if it is either monotone increasing or decreasing.
+'
+' Monotone increasing: for i <= j , nums[i] <= nums[j]
+' Monotone decreasing: for i <= j , nums[i] >= nums[j]
+'
+'
+' Example 1
+'
+' Input: @nums = (1,2,2,3)
+' Output: 1
+'
+' Example 2
+'
+' Input: @nums = (1,3,2)
+' Output: 0
+'
+' Example 3
+'
+' Input: @nums = (6,5,5,4)
+' Output: 1
+
+' read command line arguments
+sub read_args(nums() as integer)
+    dim i as integer
+
+    i=0
+    do while command(i+1)<>""
+        redim preserve nums(i) as integer
+        nums(i) = val(command(i+1))
+        i=i+1
+    loop
+end sub
+
+' check if is monotonic
+function is_monotonic(nums() as integer) as integer
+    dim i as integer, delta as integer, climbing as integer, descending as integer
+
+    for i=0 to ubound(nums)-1
+        delta=nums(i+1)-nums(i)
+        if delta>0 then climbing=1
+        if delta<0 then descending=1
+    next
+
+    if climbing=1 and descending=1 then
+        is_monotonic=0
+    else
+        is_monotonic=1
+    end if
+end function
+
+
+dim nums() as integer
+read_args nums()
+print is_monotonic(nums())
diff --git a/challenge-204/paulo-custodio/basic/ch-2.bas b/challenge-204/paulo-custodio/basic/ch-2.bas
new file mode 100644
index 0000000000..5025ea571b
--- /dev/null
+++ b/challenge-204/paulo-custodio/basic/ch-2.bas
@@ -0,0 +1,126 @@
+' Challenge 204
+'
+' Task 2: Reshape Matrix
+' Submitted by: Mohammad S Anwar
+'
+' You are given a matrix (m x n) and two integers (r) and (c).
+'
+' Write a script to reshape the given matrix in form (r x c) with the original value in the given matrix. If you can’t reshape print 0.
+'
+' Example 1
+'
+' Input: [ 1 2 ]
+'        [ 3 4 ]
+'
+'        $matrix = [ [ 1, 2 ], [ 3, 4 ] ]
+'        $r = 1
+'        $c = 4
+'
+' Output: [ 1 2 3 4 ]
+'
+' Example 2
+'
+' Input: [ 1 2 3 ]
+'        [ 4 5 6 ]
+'
+'        $matrix = [ [ 1, 2, 3 ] , [ 4, 5, 6 ] ]
+'        $r = 3
+'        $c = 2
+'
+' Output: [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ]
+'
+'         [ 1 2 ]
+'         [ 3 4 ]
+'         [ 5 6 ]
+'
+' Example 3
+'
+' Input: [ 1 2 ]
+'
+'        $matrix = [ [ 1, 2 ] ]
+'        $r = 3
+'        $c = 2
+'
+' Output: 0
+
+dim nums() as integer
+dim rows as integer, cols as integer
+
+sub push_num(nums() as integer, n as integer)
+    redim preserve nums(ubound(nums)+1) as integer
+    nums(ubound(nums)) = n
+end sub
+
+sub remove_char(s as string, c as string)
+    dim p as integer
+
+    p=instr(s,c)
+    do while p>0
+        s=left(s,p-1)+" "+mid(s,p+1)
+        p=instr(s,c)
+    loop
+end sub
+
+function parse_number(byref s as string, byref n as integer) as boolean
+    dim p as integer
+
+    s=trim(s)
+    if left(s,1)>="0" and left(s,1)<="9" then
+        p=1
+        do while mid(s,p,1)>="0" and mid(s,p,1)<="9"
+            p=p+1
+        loop
+        n=val(left(s,p-1))
+        s=mid(s,p+1)
+        parse_number=true
+    else
+        parse_number=false
+    end if
+end function
+
+function parse_line(nums() as integer, s as string) as boolean
+    dim p as integer, n as integer
+
+    s=trim(s)
+    if left(s,1)="[" then
+        remove_char s,"["
+        remove_char s,"]"
+        do while parse_number(s, n)
+            push_num nums(), n
+        loop
+        parse_line=true
+    else
+        parse_line=false
+    endif
+end function
+
+sub parse_input(nums() as integer, byref rows as integer, byref cols as integer)
+    dim s as string
+
+    open cons for input as #1
+    line input #1,s
+    do while parse_line(nums(), s)
+        line input #1,s
+    loop
+    parse_number s,rows
+    parse_number s,cols
+end sub
+
+sub print_matrix(nums() as integer, rows as integer, cols as integer)
+    dim i as integer, j as integer
+
+    if rows*cols=ubound(nums)+1 then
+        for i=0 to rows-1
+            print "[";
+            for j=0 to cols-1
+                print nums(i*cols+j);
+            next
+            print "]"
+        next
+    else
+        print 0
+    end if
+end sub
+
+parse_input nums(), rows, cols
+print_matrix nums(), rows, cols
diff --git a/challenge-204/paulo-custodio/forth/ch-1.fs b/challenge-204/paulo-custodio/forth/ch-1.fs
new file mode 100644
index 0000000000..440d9bcd41
--- /dev/null
+++ b/challenge-204/paulo-custodio/forth/ch-1.fs
@@ -0,0 +1,70 @@
+#! /usr/bin/env gforth
+
+\ Challenge 204
+\
+\ Task 1: Monotonic Array
+\ Submitted by: Mohammad S Anwar
+\
+\ You are given an array of integers.
+\
+\ Write a script to find out if the given array is Monotonic. Print 1 if it is otherwise 0.
+\
+\     An array is Monotonic if it is either monotone increasing or decreasing.
+\
+\ Monotone increasing: for i <= j , nums[i] <= nums[j]
+\ Monotone decreasing: for i <= j , nums[i] >= nums[j]
+\
+\
+\ Example 1
+\
+\ Input: @nums = (1,2,2,3)
+\ Output: 1
+\
+\ Example 2
+\
+\ Input: @nums = (1,3,2)
+\ Output: 0
+\
+\ Example 3
+\
+\ Input: @nums = (6,5,5,4)
+\ Output: 1
+
+
+\ array of numbers, setup by collect-args
+0 VALUE items                       \ array of numbers
+0 VALUE num_items                   \ number of elements
+
+: items[] ( i -- addr )
+    CELLS items +
+;
+
+
+\ collect arguments from input and store in items
+: collect_args ( -- )
+    HERE TO items
+    BEGIN NEXT-ARG DUP WHILE        \ while argments
+        0 0 2SWAP >NUMBER 2DROP DROP ,
+    REPEAT
+    2DROP
+    HERE items - CELL / TO num_items
+;
+
+
+\ check if list is monotonic
+: is_monotonic ( -- f )
+    num_items 2 < IF 1
+    ELSE
+        0 0 { climbing descending }
+        num_items 1- 0 DO
+            I 1+ items[] @
+            I items[] @
+            2DUP > IF 1 TO climbing THEN
+            < IF 1 TO descending THEN
+        LOOP
+        climbing descending AND IF 0 ELSE 1 THEN
+    ENDIF
+;
+
+collect_args is_monotonic . CR
+BYE
diff --git a/challenge-204/paulo-custodio/forth/ch-2.fs b/challenge-204/paulo-custodio/forth/ch-2.fs
new file mode 100644
index 0000000000..08442d965e
--- /dev/null
+++ b/challenge-204/paulo-custodio/forth/ch-2.fs
@@ -0,0 +1,163 @@
+#! /usr/bin/env gforth
+
+\ Challenge 204
+\
+\ Task 2: Reshape Matrix
+\ Submitted by: Mohammad S Anwar
+\
+\ You are given a matrix (m x n) and two integers (r) and (c).
+\
+\ Write a script to reshape the given matrix in form (r x c) with the original value in the given matrix. If you can’t reshape print 0.
+\
+\ Example 1
+\
+\ Input: [ 1 2 ]
+\        [ 3 4 ]
+\
+\        $matrix = [ [ 1, 2 ], [ 3, 4 ] ]
+\        $r = 1
+\        $c = 4
+\
+\ Output: [ 1 2 3 4 ]
+\
+\ Example 2
+\
+\ Input: [ 1 2 3 ]
+\        [ 4 5 6 ]
+\
+\        $matrix = [ [ 1, 2, 3 ] , [ 4, 5, 6 ] ]
+\        $r = 3
+\        $c = 2
+\
+\ Output: [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ]
+\
+\         [ 1 2 ]
+\         [ 3 4 ]
+\         [ 5 6 ]
+\
+\ Example 3
+\
+\ Input: [ 1 2 ]
+\
+\        $matrix = [ [ 1, 2 ] ]
+\        $r = 3
+\        $c = 2
+\
+\ Output: 0
+
+\ array of numbers, setup by collect-args
+CREATE items 256 CELLS ALLOT
+0 VALUE num_items                   \ number of elements
+
+: items[] ( i -- addr )
+    CELLS items +
+;
+
+: push_item ( n -- )
+    num_items items[] !
+    num_items 1+ TO num_items
+;
+
+0 VALUE out_rows
+0 VALUE out_cols
+
+\ scanner
+1024 CONSTANT max_line
+CREATE line  max_line ALLOT
+line VALUE line_ptr
+0 VALUE line_len
+9 CONSTANT TAB
+0 CONSTANT EOL
+
+\ read next line, return false on eof
+: read_line ( -- ok )
+    line TO line_ptr
+    line max_line stdin READ-LINE THROW     ( len flag )
+    SWAP
+    DUP TO line_len
+    line + EOL SWAP C!                      \ store end marker
+;
+
+\ get current char, 0 at end of line
+: cur_char ( -- ch )
+    line_ptr C@
+;
+
+\ next non-blank char, 0 at end of line
+: next_char ( -- ch )
+    0 { ch }
+    BEGIN
+        cur_char TO ch
+        ch EOL = IF EXIT THEN
+        ch BL =  ch TAB =  OR
+    WHILE
+        line_ptr 1+ TO line_ptr
+    REPEAT
+    ch
+;
+
+: parse_char { ch -- ok }
+    next_char ch = IF
+        line_ptr 1+ TO line_ptr
+        TRUE
+    ELSE
+        FALSE
+    THEN
+;
+
+: parse_number ( -- n true | 0 false )
+    next_char DUP '0' >= SWAP '9' <= AND IF
+        0 0 line_ptr  line_len  line_ptr line - -   ( 0. addr len )
+        >NUMBER DROP TO line_ptr
+        DROP TRUE
+    ELSE
+        0 0
+    THEN
+;
+
+
+\ parse input
+: parse_matrix_line ( -- ok )
+    '[' parse_char IF
+        BEGIN parse_number WHILE
+            push_item
+        REPEAT
+        DROP
+        ']' parse_char DROP
+        TRUE
+    ELSE
+        FALSE
+    THEN
+;
+
+: parse_matrix ( -- )
+    BEGIN read_line WHILE
+        parse_matrix_line 0= IF EXIT THEN
+    REPEAT
+;
+
+: parse_input ( -- )
+    parse_matrix
+    parse_number DROP TO out_rows
+    parse_number DROP TO out_cols
+;
+
+
+\ print output
+: output_matrix ( -- )
+    out_rows out_cols *  num_items = IF
+        out_rows 0 DO
+            '[' EMIT
+            out_cols 0 DO
+                J out_cols * I + items[] @ .
+            LOOP
+            ']' EMIT CR
+        LOOP
+    ELSE
+        0 . CR
+    THEN
+;
+
+
+parse_input output_matrix
+BYE