Initial data commit
This commit is contained in:
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
|
|
@ -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 / ;
|
||||
|
|
@ -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 / ;
|
||||
|
|
@ -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
|
||||
Loading…
Add table
Add a link
Reference in a new issue