tasks a-s

Task/Remove-duplicate-elements/Forth/remove-duplicate-elements-1.fth

@@ -0,0 +1,19 @@
+\ Increments a2 until it no longer points to the same value as a1
+\ a3 is the address beyond the data a2 is traversing.
+: skip-dups ( a1 a2 a3 -- a1 a2+n )
+    dup rot ?do
+      over @ i @ <> if drop i leave then
+    cell +loop ;
+
+\ Compress an array of cells by removing adjacent duplicates
+\ Returns the new count
+: uniq ( a n -- n2 )
+   over >r             \ Original addr to return stack
+   cells over + >r     \ "to" addr now on return stack, available as r@
+   dup begin           ( write read )
+      dup r@ <
+   while
+      2dup @ swap !    \ copy one cell
+      cell+ r@ skip-dups
+      cell 0 d+        \ increment write ptr only
+   repeat  r> 2drop  r> - cell / ;

Task/Remove-duplicate-elements/Forth/remove-duplicate-elements-2.fth

@@ -0,0 +1,12 @@
+: uniqv { a n \ r e -- n }
+    a n cells+ to e
+    a dup to r
+    \ the write address lives on the stack
+    begin
+      r e <
+    while
+      r @ over !
+      r cell+ e skip-dups to r
+      cell+
+    repeat
+    a - cell / ;

Task/Remove-duplicate-elements/Forth/remove-duplicate-elements-3.fth

@@ -0,0 +1,5 @@
+create test 1 , 2 , 3 , 2 , 6 , 4 , 5 , 3 , 6 ,
+here test - cell / constant ntest
+: .test ( n -- ) 0 ?do test i cells + ? loop ;
+
+test ntest 2dup cell-sort uniq .test

Task/Remove-duplicate-elements/Forth/remove-duplicate-elements-4.fth

@@ -0,0 +1 @@
+1 2 3 4 5 6 ok