Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #24195

Re: project euler problems in forth

Show all headers | View raw

WJ wrote:

> > What is the millionth lexicographic permutation of the digits 0, 1, 2,
> > 3, 4, 5, 6, 7, 8 and 9?
> > 
> > 024.fs
> > 
> > #! /usr/bin/gforth
> > 
> > ( more reading shows my intuition was ok )
> > ( - see http://en.wikipedia.org/wiki/Factorial_number_system )
> > ( - and http://en.wikipedia.org/wiki/Permutation )
> > 
> > include cdump.fs
> > 
> > cdump.fs
> > 
> > : cdump ( ptr count -- )
> > ( dumps count bytes from ptr )
> >   0 do
> >     dup i + c@ 1 u.r
> >   loop
> >   drop cr
> > ;
> > include add_digit_strings.fs
> > 
> > add_digit_strings.fs
> > 
> > #! /usr/bin/gforth
> > 
> > ( add 2 strings )
> > 
> > : get_last_ptr ( start_ptr len -- last_ptr len )
> >   dup rot + 1 - swap 
> > ;
> > 
> > : add_strings_short_to_long ( sptr1 slen1 lptr2 llen2 -- )
> >   drop rot rot 0 swap
> >   0 do
> >     rot rot 2dup 
> >     c@ swap c@ + 
> >     2swap rot rot + 10 /mod
> >     rot rot swap dup rot rot c!
> >     1 - rot 1 - rot
> >   loop
> >   if
> >     drop dup c@ 1+ swap c!
> >   else
> >     2drop
> >   then
> > ;
> > 
> > : add_strings ( ptr1 len1 ptr2 len2 -- )
> > ( add strings - result stored to longer string or second string if equal size )
> >   2over 2over
> >   rot 2swap 2drop
> >   <
> >   if
> >     2swap
> >   then
> >   get_last_ptr 2swap get_last_ptr 2swap
> >   add_strings_short_to_long
> > ;
> > create str1 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 1 c, 
> > 10 constant len1
> > create str2 2 c, 7 c, 8 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c,
> > 10 constant len2
> > 
> > variable flag
> > 
> > : contains ( num ptr len -- flag )
> > 0 flag c!
> > 0 do
> >   dup i + c@ 
> >   rot dup rot =
> >   if
> >    1 flag c!
> >    leave
> >   else
> >     swap
> >   then
> > loop
> > 2drop
> > flag c@
> > ;
> > 
> > : test_add_strings ( -- )
> > 2080 ( we have 2080 more permutations after 2780000000 )
> > begin
> >   str1 len1 str2 len2 add_strings
> >   0 str2 10 contains if
> >   1 str2 10 contains if
> >   2 str2 10 contains if
> >   3 str2 10 contains if
> >   4 str2 10 contains if
> >   5 str2 10 contains if
> >   6 str2 10 contains if
> >   7 str2 10 contains if
> >   8 str2 10 contains if
> >   9 str2 10 contains if
> >     1 -
> >   then then then then then
> >   then then then then then
> >   dup
> >   0 =
> > until
> > str2 10 cdump
> > ;
> > 
> > test_add_strings
> 
> 
> 
> Factor:
> 
> USING: locals ;
> 
> :: perms ( pool accum -- )
>   pool empty?
>   [ "count" inc
>     "count" get 1,000,000 = [ accum . ] when ]
>   [ pool
>     [| el |  el pool remove  accum el suffix  perms ]
>     each ]
>   if ;
> 
> : problem24 ( -- )
>   0 "count" set
>   10 iota { } perms ;
> 
> problem24
> 
> { 2 7 8 3 9 1 5 4 6 0 }

Julia:

julia> nthperm( [0:9], 1_000_000 )'
1x10 Int32 Array:
 2  7  8  3  9  1  5  4  6  0

Back to comp.lang.forth | Previous | Next | Find similar

Thread

Re: project euler problems in forth "WJ" <w_a_x_man@yahoo.com> - 2013-07-06 05:53 +0000

csiph-web