25 lines
877 B
Forth
25 lines
877 B
Forth
2000 cells constant /hamming
|
|
create hamming /hamming allot
|
|
( n1 n2 n3 n4 n5 n6 n7 -- n3 n4 n5 n6 n1 n2 n8)
|
|
: min? >r dup r> min >r 2rot r> ;
|
|
|
|
: hit? ( n1 n2 n3 n4 n5 n6 n7 n8 -- n3 n4 n9 n10 n1 n2 n7)
|
|
>r 2dup = \ compare number with found minimum
|
|
if -rot drop 1+ hamming over cells + @ r@ * rot then
|
|
r> drop >r 2rot r>
|
|
; \ if so, increment and rotate
|
|
|
|
: hamming# ( n1 -- n2)
|
|
1 hamming ! >r \ set first cell and initialize parms
|
|
0 5 over 3 over 2
|
|
r@ 1 ?do \ determine minimum and set cell
|
|
dup min? min? min? dup hamming i cells + !
|
|
2 hit? 5 hit? 3 hit? drop
|
|
loop \ find if minimum equals value
|
|
2drop 2drop 2drop hamming r> 1- cells + @
|
|
; \ clean up stack and fetch hamming number
|
|
|
|
: test
|
|
cr 21 1 ?do i . i hamming# . cr loop
|
|
1691 hamming# . cr
|
|
;
|