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


Groups > comp.lang.forth > #41078 > unrolled thread

Strings and numbers

Started bySteve Graham <solitary.wanderer52@gmail.com>
First post2015-08-03 13:24 -0700
Last post2015-11-29 18:09 +0000
Articles 20 on this page of 24 — 8 participants

Back to article view | Back to comp.lang.forth


Contents

  Strings and numbers Steve Graham <solitary.wanderer52@gmail.com> - 2015-08-03 13:24 -0700
    Re: Strings and numbers Julian Fondren <julian.fondren@gmail.com> - 2015-08-03 13:51 -0700
      Re: Strings and numbers "Rod Pemberton" <boo@fasdfrewar.cdm> - 2015-08-03 17:38 -0400
      Re: Strings and numbers Steve Graham <solitary.wanderer52@gmail.com> - 2015-08-03 14:44 -0700
    Re: Strings and numbers Paul Rubin <no.email@nospam.invalid> - 2015-08-03 20:59 -0700
      Re: Strings and numbers Steve Graham <solitary.wanderer52@gmail.com> - 2015-08-04 12:19 -0700
        Re: Strings and numbers "WJ" <w_a_x_man@yahoo.com> - 2015-08-07 09:29 +0000
          Re: Strings and numbers "WJ" <w_a_x_man@yahoo.com> - 2015-09-04 15:14 +0000
            Re: Strings and numbers "WJ" <w_a_x_man@yahoo.com> - 2015-09-07 19:34 +0000
              Re: Strings and numbers Julian Fondren <julian.fondren@gmail.com> - 2015-09-08 11:48 -0700
              Re: Strings and numbers Paul Rubin <no.email@nospam.invalid> - 2015-09-09 00:41 -0700
                Re: Strings and numbers Richard Todd <richard.wesley.todd@gmail.com> - 2015-09-10 00:32 -0700
                  Re: Strings and numbers Richard Todd <richard.wesley.todd@gmail.com> - 2015-09-10 10:29 -0700
                    Re: Strings and numbers Paul Rubin <no.email@nospam.invalid> - 2015-09-10 17:22 -0700
                      Re: Strings and numbers Richard Todd <richard.wesley.todd@gmail.com> - 2015-09-10 21:34 -0700
                        Re: Strings and numbers humptydumpty <ouatubi@gmail.com> - 2015-09-11 02:16 -0700
                          Re: Strings and numbers humptydumpty <ouatubi@gmail.com> - 2015-09-11 07:33 -0700
                            Re: Strings and numbers Paul Rubin <no.email@nospam.invalid> - 2015-09-13 00:12 -0700
                              Re: Strings and numbers humptydumpty <ouatubi@gmail.com> - 2015-09-13 02:09 -0700
                        Re: Strings and numbers Paul Rubin <no.email@nospam.invalid> - 2015-09-11 15:53 -0700
                          Re: Strings and numbers Andrew Haley <andrew29@littlepinkcloud.invalid> - 2015-12-18 16:02 -0600
              Re: Strings and numbers "WJ" <w_a_x_man@yahoo.com> - 2015-09-12 23:38 +0000
                Re: Strings and numbers "WJ" <w_a_x_man@yahoo.com> - 2015-09-13 19:41 +0000
              Re: Strings and numbers "WJ" <w_a_x_man@yahoo.com> - 2015-11-29 18:09 +0000

Page 1 of 2  [1] 2  Next page →


#41078 — Strings and numbers

FromSteve Graham <solitary.wanderer52@gmail.com>
Date2015-08-03 13:24 -0700
SubjectStrings and numbers
Message-ID<d0c75445-60e3-402a-93a5-8f68501b28ba@googlegroups.com>
I am working on a problem which involves numbers from 1234567890 up to 987,654,321.  I need to be able to:
1) Convert between the number and its string equivalent; and 
1) Divide the number by integers from 2 to 9 yielding a remainder.

Any tips on how to do this would be appreciated.

Steve

[toc] | [next] | [standalone]


#41079

FromJulian Fondren <julian.fondren@gmail.com>
Date2015-08-03 13:51 -0700
Message-ID<76f7d2ca-9052-47c7-a8a5-f9ee53b1f6ed@googlegroups.com>
In reply to#41078
On Monday, August 3, 2015 at 3:24:08 PM UTC-5, Steve Graham wrote:
> I am working on a problem which involves numbers from 1234567890 up to 987,654,321.  I need to be able to:
> 1) Convert between the number and its string equivalent; and 
> 1) Divide the number by integers from 2 to 9 yielding a remainder.

Hello,

Do you have 16-bit cells?  If you don't, then two's
complement ranges for 32-bit numbers are [0,2_147_483_647]
and [0,4_294_967_295] ([0,$ffff_ffff] and [0,$7fff_ffff]).
So, large enough for your purposes.

(Assuming that you realize that 987654321 < 1234567890.  If
you want numbers larger than $ffff_ffff, you'll need to use
double numbers.  ANS Forth sort of favors double numbers -
note that the essential words below all involve double
numbers, not just single numbers - so the answer will be
about the same.)

You can use ANS Forth's pictured numeric output words to
produce a string, >NUMBER to produce a number from a string,
and /MOD for division with a remainder.

  : (u.) ( u -- c-addr u )  0 <# #s #> ;
  : number ( c-addr u -- u )
    0. 2swap >number abort" not a number" 2drop ;

  s" 1234567890" number 7 /mod
  cr (u.) type cr (u.) type

Outputs:

  176366841
  3 ok


-- Julian

[toc] | [prev] | [next] | [standalone]


#41081

From"Rod Pemberton" <boo@fasdfrewar.cdm>
Date2015-08-03 17:38 -0400
Message-ID<op.x2taenlvyfako5@localhost>
In reply to#41079
On Mon, 03 Aug 2015 16:51:41 -0400, Julian Fondren <julian.fondren@gmail.com> wrote:

> On Monday, August 3, 2015 at 3:24:08 PM UTC-5, Steve Graham wrote:

>> I am working on a problem which involves numbers from 1234567890
>> up to 987,654,321.  I need to be able to:
>> 1) Convert between the number and its string equivalent; and
>> 1) Divide the number by integers from 2 to 9 yielding a remainder.
>
> Hello,
>
> Do you have 16-bit cells?  If you don't, then two's
> complement ranges for 32-bit numbers are [0,2_147_483_647]

Did you mean [-2_147_483_648,+2_147_483_647] for 32-bit signed?


Rod Pemberton

-- 
Scientists now say we'll experience a mini-ice in 2030.
So, I guess we need more global warming today ...

[toc] | [prev] | [next] | [standalone]


#41082

FromSteve Graham <solitary.wanderer52@gmail.com>
Date2015-08-03 14:44 -0700
Message-ID<eb094b55-67dc-48cc-b647-f89c31aa6e5d@googlegroups.com>
In reply to#41079
On Monday, August 3, 2015 at 1:51:43 PM UTC-7, Julian Fondren wrote:
> On Monday, August 3, 2015 at 3:24:08 PM UTC-5, Steve Graham wrote:
> > I am working on a problem which involves numbers from 1234567890 up to 987,654,321.  I need to be able to:
> > 1) Convert between the number and its string equivalent; and 
> > 1) Divide the number by integers from 2 to 9 yielding a remainder.
> 
> Hello,
> 
> Do you have 16-bit cells?  If you don't, then two's
> complement ranges for 32-bit numbers are [0,2_147_483_647]
> and [0,4_294_967_295] ([0,$ffff_ffff] and [0,$7fff_ffff]).
> So, large enough for your purposes.
> 
> (Assuming that you realize that 987654321 < 1234567890.  If
> you want numbers larger than $ffff_ffff, you'll need to use
> double numbers.  ANS Forth sort of favors double numbers -
> note that the essential words below all involve double
> numbers, not just single numbers - so the answer will be
> about the same.)
> 
> You can use ANS Forth's pictured numeric output words to
> produce a string, >NUMBER to produce a number from a string,
> and /MOD for division with a remainder.
> 
>   : (u.) ( u -- c-addr u )  0 <# #s #> ;
>   : number ( c-addr u -- u )
>     0. 2swap >number abort" not a number" 2drop ;
> 
>   s" 1234567890" number 7 /mod
>   cr (u.) type cr (u.) type
> 
> Outputs:
> 
>   176366841
>   3 ok
> 
> 
> -- Julian

Thank you, Julian.

Steve

[toc] | [prev] | [next] | [standalone]


#41085

FromPaul Rubin <no.email@nospam.invalid>
Date2015-08-03 20:59 -0700
Message-ID<87egjjk8kn.fsf@jester.gateway.sonic.net>
In reply to#41078
Steve Graham <solitary.wanderer52@gmail.com> writes:
> I am working on a problem which involves numbers from 1234567890 up to
> 987,654,321.  I need to be able to:
> 1) Convert between the number and its string equivalent; and 
> 1) Divide the number by integers from 2 to 9 yielding a remainder.
> Any tips on how to do this would be appreciated.

Sounds like you're doing Euler problem 21.  You don't really need to
mess with those string conversions.  You can do the problem without a
computer too: the needed calculations are within range of pen and paper.

[toc] | [prev] | [next] | [standalone]


#41102

FromSteve Graham <solitary.wanderer52@gmail.com>
Date2015-08-04 12:19 -0700
Message-ID<bc852ff3-f547-4e0c-ab68-72b3e9c25618@googlegroups.com>
In reply to#41085
http://programmingpraxis.com/2015/07/21/a-number-puzzle/#comments

[toc] | [prev] | [next] | [standalone]


#41152

From"WJ" <w_a_x_man@yahoo.com>
Date2015-08-07 09:29 +0000
Message-ID<mq1tq2$jv0$1@dont-email.me>
In reply to#41102
Steve Graham wrote:

> 
> http://programmingpraxis.com/2015/07/21/a-number-puzzle/#comments



| Find a 10-digit number, with all digits unique, such that the first n
| digits of the number are divisible by n. For instance, in the 3-digit
| number 345, the 1-digit prefix, 3, is divisible by 1, the 2-digit
| prefix, 34, is divisible by 2, and the 3-digit prefix, 345, is
| divisible by 3.

Gauche Scheme:

(define (next divisor integer digits)
  (filter-map
    (lambda (d)
      (let1 new-int (+ (* 10 integer) d)
        (and (zero? (mod new-int divisor))
             (list new-int (delete d digits)))))
    digits))


;; Recursion.
(let go ((divisor 1) (candidates (list (list 0 (iota 10)))))
  (if (> divisor 10)
    (caar candidates)
    (go (+ divisor 1)
        (append-map
          (lambda (x) (apply next divisor x))
          candidates))))

3816547290

-- 
The report card by the American Society of Civil Engineers showed the national
infrastructure a single grade above failure, a step from declining to the point
where everyday things simply stop working the way people expect them to. ---
washingtonpost.com/local/trafficandcommuting/us-infrastructure-gets-d-in-annual-report/2013/03/19/c48cb010-900b-11e2-9cfd-36d6c9b5d7ad_story.html

[toc] | [prev] | [next] | [standalone]


#41724

From"WJ" <w_a_x_man@yahoo.com>
Date2015-09-04 15:14 +0000
Message-ID<msccfm$c7p$1@dont-email.me>
In reply to#41152
WJ wrote:

> Steve Graham wrote:
> 
> > 
> > http://programmingpraxis.com/2015/07/21/a-number-puzzle/#comments
> 
> 
> 
> >  Find a 10-digit number, with all digits unique, such that the first n
> >  digits of the number are divisible by n. For instance, in the 3-digit
> >  number 345, the 1-digit prefix, 3, is divisible by 1, the 2-digit
> >  prefix, 34, is divisible by 2, and the 3-digit prefix, 345, is
> >  divisible by 3.
> 
> Gauche Scheme:
> 
> (define (next divisor integer digits)
>   (filter-map
>     (lambda (d)
>       (let1 new-int (+ (* 10 integer) d)
>         (and (zero? (mod new-int divisor))
>              (list new-int (delete d digits)))))
>     digits))
> 
> 
> ;; Recursion.
> (let go ((divisor 1) (candidates (list (list 0 (iota 10)))))
>   (if (> divisor 10)
>     (caar candidates)
>     (go (+ divisor 1)
>         (append-map
>           (lambda (x) (apply next divisor x))
>           candidates))))
> 
> 3816547290

Ruby:

def next_digit( divisor, digits_so_far )
  number_so_far = digits_so_far.join.to_i * 10
  ((0..9).to_a - digits_so_far).select{|d|
    ((number_so_far + d).modulo divisor).zero? }.
    map{|d| digits_so_far + [d]}
end

candidates = [[]]
1.upto(10){|divisor|
  candidates = candidates.map{|digit_list|
    next_digit( divisor, digit_list) }.flatten(1) }
candidates

 ===>
[[3, 8, 1, 6, 5, 4, 7, 2, 9, 0]]

-- 
[Y]ou can never fix a decaying empire; the empire can only fall when the time
comes.  You cannot fix the empire by sending good and honest men to the capital,
because the simple logic of the system corrupts everyone along the way.
www.kolumbus.fi/aquilon/america-middle-class-and-the-end-of-growth.htm

[toc] | [prev] | [next] | [standalone]


#41829

From"WJ" <w_a_x_man@yahoo.com>
Date2015-09-07 19:34 +0000
Message-ID<mskosf$1tr$1@dont-email.me>
In reply to#41724
WJ wrote:

> WJ wrote:
> 
> > Steve Graham wrote:
> > 
> > > 
> > > http://programmingpraxis.com/2015/07/21/a-number-puzzle/#comments
> > 
> > 
> > 
> > >  Find a 10-digit number, with all digits unique, such that the first n
> > >  digits of the number are divisible by n. For instance, in the 3-digit
> > >  number 345, the 1-digit prefix, 3, is divisible by 1, the 2-digit
> > >  prefix, 34, is divisible by 2, and the 3-digit prefix, 345, is
> > >  divisible by 3.
> > 
> > Gauche Scheme:
> > 
> > (define (next divisor integer digits)
> >   (filter-map
> >     (lambda (d)
> >       (let1 new-int (+ (* 10 integer) d)
> >         (and (zero? (mod new-int divisor))
> >              (list new-int (delete d digits)))))
> >     digits))
> > 
> > 
> > ;; Recursion.
> > (let go ((divisor 1) (candidates (list (list 0 (iota 10)))))
> >   (if (> divisor 10)
> >     (caar candidates)
> >     (go (+ divisor 1)
> >         (append-map
> >           (lambda (x) (apply next divisor x))
> >           candidates))))
> > 
> > 3816547290
> 
> Ruby:
> 
> def next_digit( divisor, digits_so_far )
>   number_so_far = digits_so_far.join.to_i * 10
>   ((0..9).to_a - digits_so_far).select{|d|
>     ((number_so_far + d).modulo divisor).zero? }.
>     map{|d| digits_so_far + [d]}
> end
> 
> candidates = [[]]
> 1.upto(10){|divisor|
>   candidates = candidates.map{|digit_list|
>     next_digit( divisor, digit_list) }.flatten(1) }
> candidates
> 
>  ===>
> [[3, 8, 1, 6, 5, 4, 7, 2, 9, 0]]

No one has yet posted a Forth solution.  Perhaps this Ruby version
will be more understandable than the previous one.

def divisible( n, divisor )
  n.modulo(divisor).zero?
end

def one_more_digit( divisor, digits_so_far )
  digits_avail = (0 .. 9).to_a - digits_so_far
  base_for_new_number = digits_so_far.join.to_i * 10
  digits_avail.select{ |d| divisible( base_for_new_number + d, divisor )}.
    map{|d| digits_so_far + [d] }
end


Here's an example of how this function works:

one_more_digit( 4, [3, 8, 1] )
    ==>[[3, 8, 1, 2], [3, 8, 1, 6]]



candidates = [[]]
1.upto(10){|divisor|
  candidates = candidates.map{|digit_list|
    one_more_digit( divisor, digit_list) }.flatten(1) }
candidates

[[3, 8, 1, 6, 5, 4, 7, 2, 9, 0]]

Here's an example of how the "flatten" command works in Ruby:

[[[3, 8, 1, 2], [3, 8, 1, 6]]].flatten
    ==>[3, 8, 1, 2, 3, 8, 1, 6]
[[[3, 8, 1, 2], [3, 8, 1, 6]]].flatten(1)
    ==>[[3, 8, 1, 2], [3, 8, 1, 6]]

[toc] | [prev] | [next] | [standalone]


#41857

FromJulian Fondren <julian.fondren@gmail.com>
Date2015-09-08 11:48 -0700
Message-ID<2b25b951-5ca2-4e81-8087-276959555b46@googlegroups.com>
In reply to#41829
On Monday, September 7, 2015 at 2:36:32 PM UTC-5, WJ wrote:
> WJ wrote:
> No one has yet posted a Forth solution.  Perhaps this Ruby version
> will be more understandable than the previous one.

Nope.  It's just a little less curvy than the previous version:

        _                      _  _     
        _  _            _  _           _      
            _          _  _               
            _  _                                 
                  _  _          
    

       _    _                      _  _     
        _                   _          _  _   
      _   _   _               _  _           _      
        _                                 _   _   _                       
                  _  _           
   


Puzzles like this are like candy.  They're enjoyable
while you're doing them.  And then: you have nothing
at all to show for it.


-- Julian

[toc] | [prev] | [next] | [standalone]


#41884

FromPaul Rubin <no.email@nospam.invalid>
Date2015-09-09 00:41 -0700
Message-ID<877fo0t4y0.fsf@jester.gateway.pace.com>
In reply to#41829
"WJ" <w_a_x_man@yahoo.com> writes:
>> > > http://programmingpraxis.com/2015/07/21/a-number-puzzle/#comments
> No one has yet posted a Forth solution.

\ http://programmingpraxis.com/2015/07/21/a-number-puzzle

: .bit ( i -- n ) 1 swap lshift ;	   \ bits are numbered from 0
: clear-bit ( n i -- n ) .bit invert and ;	  \ clear bit i in n
: test-bit ( n i -- flag ) .bit and 0<> ;	  \ true if bit i is 1
: append-digit ( n i -- n ) swap 10 * + ;

: num { r n s -- n }
    s 0= if n else
	10 0 do 
	    n i append-digit
	    s i test-bit
	    over r mod 0= and if
		r 1+ swap  s i clear-bit recurse
	    else drop
	    then
	loop
    then ;

: go 1 0 $3ff num . ;
go

[toc] | [prev] | [next] | [standalone]


#41921

FromRichard Todd <richard.wesley.todd@gmail.com>
Date2015-09-10 00:32 -0700
Message-ID<99b72d58-0b1a-4e09-9c34-42ebb844fff8@googlegroups.com>
In reply to#41884
On Wednesday, September 9, 2015 at 2:41:45 AM UTC-5, Paul Rubin wrote:
> \ http://programmingpraxis.com/2015/07/21/a-number-puzzle
> 
> : .bit ( i -- n ) 1 swap lshift ;	   \ bits are numbered from 0
> : clear-bit ( n i -- n ) .bit invert and ;	  \ clear bit i in n
> : test-bit ( n i -- flag ) .bit and 0<> ;	  \ true if bit i is 1
> : append-digit ( n i -- n ) swap 10 * + ;
> 
> : num { r n s -- n }
>     s 0= if n else
> 	10 0 do 
> 	    n i append-digit
> 	    s i test-bit
> 	    over r mod 0= and if
> 		r 1+ swap  s i clear-bit recurse
> 	    else drop
> 	    then
> 	loop
>     then ;
> 
> : go 1 0 $3ff num . ;
> go

I did my version on gforth, which is 32-bit... and the
answer is too large for a cell.  Luckily the last digit
has to be a '0', so I compute all but the last digit in 
a cell, and then convert to a double to multiply by 10
at the end.

\ low-level bit tracking
VARIABLE bits  0 bits !  \ which digits we've chosen
VARIABLE #bits 0 #bits ! \ how many digits we've chosen
: >bit ( n -- bit ) 1 swap lshift ;
: btest ( n -- t/f ) >bit  bits @  AND  0= ;
: bset ( n -- ) >bit         bits @  OR   bits ! ;
: bclr ( n -- ) >bit invert  bits @  AND  bits ! ;
: next-avail ( n -- n' ) BEGIN 1+ dup btest UNTIL ;

\ backtrack backs up a digit... add-digit pushes forward
: backtrack  ( n -- n' ) 10 /  -1 #bits +! ;
: add-digit  ( n -- n' )
    10 *  0 next-avail  dup bset  +  1 #bits +! ;

\ the next three words search for the next number
\ to test while we are not divisible, backtracking
\ if necessary
: next-digit ( n0 digit -- n' failed? )
   next-avail dup 10 < IF dup bset + false
                     ELSE drop true THEN ;
: split-digit ( n -- n0 digit )
   dup 10 MOD  dup bclr  tuck -  swap ;
: next-num  ( n -- n' )
   split-digit next-digit IF backtrack recurse THEN ;

\ here is the main loop, trying numbers until
\ we get the solution.
: divisible? ( n -- t/f ) #bits @  MOD   0= ;
: done? ( -- t/f ) #bits @  9 =  ;
: try-nums ( n -- n' t/f )
   dup divisible?  IF done? IF true ELSE add-digit false THEN
                 ELSE next-num false THEN ;

\ on 32-bit gforth, the final answer is too big for a
\ cell, so we have to go to doubles...
\ well, there's no d*, but there is d+ and d2*,
\ so we use the formula:  (x*2*2 + x)*2 = x*10
: d10* ( d -- d*10 ) 2dup d2* d2* d+ d2* ;

: solve ( -- )
   0 add-digit BEGIN try-nums UNTIL 0 d10* d. ;

[toc] | [prev] | [next] | [standalone]


#41923

FromRichard Todd <richard.wesley.todd@gmail.com>
Date2015-09-10 10:29 -0700
Message-ID<f8c62977-77d0-47ca-9f21-3c9589ec49a0@googlegroups.com>
In reply to#41921
I spent a few minutes with Paul's answer, because it's
so much nicer-looking than mine.  FWIW, here's a small
modification that makes it run on gforth on my machine:

: .bit ( i -- n ) 1 swap lshift ;          \ bits are numbered from 0
: clear-bit ( n i -- n ) .bit invert and ; \ clear bit i in n
: test-bit ( n i -- flag ) .bit and 0<> ;  \ true if bit i is 1
: append-digit ( n i -- n ) swap 10 * + ;

: num { r n s -- n }
    s 0= if n else
        10 1 do
            n i append-digit
            s i test-bit
            over r mod 0= and if
                r 1+ swap  s i clear-bit recurse
            else drop
            then
        loop
    then ;

: d10*  2dup d2* d2* d+ d2* ;
: go 1 0 $3fe num 0 d10* d. ;

This is a really interesting program to me, because
I could never have written it.  It keeps searching
after it finds the solution -- an option I would
never have considered, but which really simplifies the 
logic.  Also, num usually returns nothing, but on 
one one call in the middle of the sequence it 
leaves 'n' on the stack. Really nice!  My program
is over-engineered and convoluted by comparison.

[toc] | [prev] | [next] | [standalone]


#41935

FromPaul Rubin <no.email@nospam.invalid>
Date2015-09-10 17:22 -0700
Message-ID<87oah9st2o.fsf@jester.gateway.pace.com>
In reply to#41923
Richard Todd <richard.wesley.todd@gmail.com> writes:
> I spent a few minutes with Paul's answer, because it's so much
> nicer-looking than mine.  ...  This is a really interesting program to
> me, because I could never have written it.  It keeps searching after
> it finds the solution -- an option I would never have considered, but
> which really simplifies the logic.  Also, num usually returns nothing,
> but on one one call in the middle of the sequence it leaves 'n' on the
> stack. Really nice!

Wow, thanks for the kind words.  The purpose of keeping on searching was
to find all the solutions in the event there was more than one (I didn't
know before writing that).  I didn't notice that num had a variable
stack effect!  That's actually a code smell, imho.  Originally I printed
out n there instead of returning it on the stack, but saw there was only
one value printed so I returned it for cleanliness reasons.

I changed the program to use your multiply-by-10 trick for 32-bit
systems and also to stop searching after the first solution, by
throwing/catching an exception (below).

>  My program is over-engineered and convoluted by comparison.

I've been wanting to study yours because it does a better job than mine
at splitting the code into small factors, which makes it easier to avoid
using locals, improving its Forth purity :).  Anyway, here's my current
version:
================================================================
\ http://programmingpraxis.com/2015/07/21/a-number-puzzle
\ Now works in 64 and 32 bit gforth, thanks to Richard Todd
\ for the multiply-by-10 trick

: .bit ( i -- n ) 1 swap lshift ;	   \ bits are numbered from 0
: clear-bit ( n i -- n ) .bit invert and ;	  \ clear bit i in n
: test-bit ( n i -- flag ) .bit and 0<> ;	  \ true if bit i is 1
: append-digit ( n i -- n ) swap 10 * + ;

: num { r n s -- n }
    s 0= if n throw then
    10 1 do 
	n i append-digit
	s i test-bit
	over r mod 0= and if
	    r 1+ swap  s i clear-bit recurse
	else drop
	then
    loop ;

: solve/10 ( -- n ) 1 0 $3fe ['] num catch
    2nip nip ;				\ cleanup stack from exception
: go ( -- ) solve/10 10 m* d. cr ;

go					\ should print 3816547290 
bye
================================================================

[toc] | [prev] | [next] | [standalone]


#41944

FromRichard Todd <richard.wesley.todd@gmail.com>
Date2015-09-10 21:34 -0700
Message-ID<ec7d26f3-8d15-4e8d-a983-7e702b00e4e1@googlegroups.com>
In reply to#41935
On Thursday, September 10, 2015 at 7:22:43 PM UTC-5, Paul Rubin wrote:
> I didn't notice that num had a variable
> stack effect!  That's actually a code smell, imho. 

Yeah, I agree, but using an exception for
returning a normal value is another kind of smell,
is it not?   


> I changed the program to use your multiply-by-10 trick for 32-bit
> systems and also to stop searching after the first solution, by
> throwing/catching an exception (below).

Thanks for pointing out m*, much better than my workaround!


> I've been wanting to study yours because it does a better job than mine
> at splitting the code into small factors, which makes it easier to avoid
> using locals, improving its Forth purity :).  

I made a pass through it to clean it up. 
It's basically the same backtracking search,
only I went the iterative route instead of the 
recursive route.  That means I have to do more 
manual fiddling with the program state. And
avoiding locals adds some stack-adjustment
noise.  I really think your version is much
more tasteful, and that's interesting because
I was trying for the "Forth purity".  

\ low-level bit tracking
0 VALUE bits     \ which digits we've chosen
0 VALUE #digits  \ how many digits we've chosen
: >bit ( n -- bit ) 1 swap lshift ;
: bset ( n -- ) >bit         bits OR   TO bits ;
: bclr ( n -- ) >bit invert  bits AND  TO bits ;
: next-avail ( n -- n' )
    BEGIN 1+ dup  >bit bits AND 0=  UNTIL ;

\ backtrack backs up a digit... add-digit pushes forward
: backtrack  ( n -- n' )
    10 /    dup 10 MOD bclr    #digits 1- TO #digits ;
: add-digit  ( n -- n' )
    dup 10 MOD bset   10 *  0 next-avail +
    #digits 1+ TO #digits ;

\ the next two words search for the next unique number
: split ( n -- n0 digit ) dup 10 MOD  tuck - swap ;
: next-num  ( n -- n' )
    split next-avail 10 MOD tuck + swap 0=
    IF backtrack recurse THEN ;

\ The main loop body adds a digit when
\ the guess is divisible, and goes to the next
\ unique-digit number when it is not divisible.
: divisible? ( n -- t/f ) #digits MOD 0= ;
: unless-done: ( magic ) #digits 8 =  IF true rdrop THEN ;
: try-nums ( n -- n' t/f )
   dup divisible?
   IF unless-done: add-digit ELSE next-num THEN false ;

: solve ( -- )
   0 add-digit BEGIN try-nums UNTIL 10 m* d. ;

[toc] | [prev] | [next] | [standalone]


#41952

Fromhumptydumpty <ouatubi@gmail.com>
Date2015-09-11 02:16 -0700
Message-ID<7344e907-150a-4908-8fb3-7e5721796600@googlegroups.com>
In reply to#41944
On Friday, September 11, 2015 at 7:34:25 AM UTC+3, Richard Todd wrote:
> On Thursday, September 10, 2015 at 7:22:43 PM UTC-5, Paul Rubin wrote:
> > I didn't notice that num had a variable
> > stack effect!  That's actually a code smell, imho. 
> 
> Yeah, I agree, but using an exception for
> returning a normal value is another kind of smell,
> is it not?   
> 
> 
> > I changed the program to use your multiply-by-10 trick for 32-bit
> > systems and also to stop searching after the first solution, by
> > throwing/catching an exception (below).
> 
> Thanks for pointing out m*, much better than my workaround!
> 
> 
> > I've been wanting to study yours because it does a better job than mine
> > at splitting the code into small factors, which makes it easier to avoid
> > using locals, improving its Forth purity :).  
> 
> I made a pass through it to clean it up. 
> It's basically the same backtracking search,
> only I went the iterative route instead of the 
> recursive route.  That means I have to do more 
> manual fiddling with the program state. And
> avoiding locals adds some stack-adjustment
> noise.  I really think your version is much
> more tasteful, and that's interesting because
> I was trying for the "Forth purity".  
> 
> \ low-level bit tracking
> 0 VALUE bits     \ which digits we've chosen
> 0 VALUE #digits  \ how many digits we've chosen
> : >bit ( n -- bit ) 1 swap lshift ;
> : bset ( n -- ) >bit         bits OR   TO bits ;
> : bclr ( n -- ) >bit invert  bits AND  TO bits ;
> : next-avail ( n -- n' )
>     BEGIN 1+ dup  >bit bits AND 0=  UNTIL ;
> 
> \ backtrack backs up a digit... add-digit pushes forward
> : backtrack  ( n -- n' )
>     10 /    dup 10 MOD bclr    #digits 1- TO #digits ;
> : add-digit  ( n -- n' )
>     dup 10 MOD bset   10 *  0 next-avail +
>     #digits 1+ TO #digits ;
> 
> \ the next two words search for the next unique number
> : split ( n -- n0 digit ) dup 10 MOD  tuck - swap ;
> : next-num  ( n -- n' )
>     split next-avail 10 MOD tuck + swap 0=
>     IF backtrack recurse THEN ;
> 
> \ The main loop body adds a digit when
> \ the guess is divisible, and goes to the next
> \ unique-digit number when it is not divisible.
> : divisible? ( n -- t/f ) #digits MOD 0= ;
> : unless-done: ( magic ) #digits 8 =  IF true rdrop THEN ;
> : try-nums ( n -- n' t/f )
>    dup divisible?
>    IF unless-done: add-digit ELSE next-num THEN false ;
> 
> : solve ( -- )
>    0 add-digit BEGIN try-nums UNTIL 10 m* d. ;

Hi!

A variation of recursive version, using kind of dynamic variable.
Mostly developed in text-editor(blob like result, shame on me :)

: >{    ]] dup @ 2>R [[ ; IMMEDIATE
: }     ]] R> R>   ! [[ ; IMMEDIATE
        VARIABLE Bmp VARIABLE N
        DEFER run ( u -- )
: (conundrum)   ( u digits )
        dup 0=  IF over run EXIT THEN
        10 1
        DO      I
                1 I lshift
                dup Bmp @ AND 0=
                IF      ( u digits I 2^I )
                        Bmp >{
                                Bmp +!
                                rot  10 * +
                                swap 1-
                                2dup N @ swap - mod 0=
                                IF RECURSE THEN
                                1+ swap
                                10 / swap
                        }
                ELSE 2drop THEN
        LOOP
;
:noname
        S>D <# [char] 0 hold #S #> type
; IS run
: conundrum     ( -- )
        9 N ! 1 Bmp !
        0 N @ (conundrum) 2drop
;

Use: gforth cndrum.fs -e "conundrum cr bye"

Have a nice day,
humptudumpty

[toc] | [prev] | [next] | [standalone]


#41957

Fromhumptydumpty <ouatubi@gmail.com>
Date2015-09-11 07:33 -0700
Message-ID<c47ec179-6bfb-4713-bbad-173c42db7721@googlegroups.com>
In reply to#41952
On Friday, September 11, 2015 at 12:16:09 PM UTC+3, humptydumpty wrote:
> On Friday, September 11, 2015 at 7:34:25 AM UTC+3, Richard Todd wrote:
> > On Thursday, September 10, 2015 at 7:22:43 PM UTC-5, Paul Rubin wrote:
> > > I didn't notice that num had a variable
> > > stack effect!  That's actually a code smell, imho. 
> > 
> > Yeah, I agree, but using an exception for
> > returning a normal value is another kind of smell,
> > is it not?   
> > 
> > 
> > > I changed the program to use your multiply-by-10 trick for 32-bit
> > > systems and also to stop searching after the first solution, by
> > > throwing/catching an exception (below).
> > 
> > Thanks for pointing out m*, much better than my workaround!
> > 
> > 
> > > I've been wanting to study yours because it does a better job than mine
> > > at splitting the code into small factors, which makes it easier to avoid
> > > using locals, improving its Forth purity :).  
> > 
> > I made a pass through it to clean it up. 
> > It's basically the same backtracking search,
> > only I went the iterative route instead of the 
> > recursive route.  That means I have to do more 
> > manual fiddling with the program state. And
> > avoiding locals adds some stack-adjustment
> > noise.  I really think your version is much
> > more tasteful, and that's interesting because
> > I was trying for the "Forth purity".  
> > 
> > \ low-level bit tracking
> > 0 VALUE bits     \ which digits we've chosen
> > 0 VALUE #digits  \ how many digits we've chosen
> > : >bit ( n -- bit ) 1 swap lshift ;
> > : bset ( n -- ) >bit         bits OR   TO bits ;
> > : bclr ( n -- ) >bit invert  bits AND  TO bits ;
> > : next-avail ( n -- n' )
> >     BEGIN 1+ dup  >bit bits AND 0=  UNTIL ;
> > 
> > \ backtrack backs up a digit... add-digit pushes forward
> > : backtrack  ( n -- n' )
> >     10 /    dup 10 MOD bclr    #digits 1- TO #digits ;
> > : add-digit  ( n -- n' )
> >     dup 10 MOD bset   10 *  0 next-avail +
> >     #digits 1+ TO #digits ;
> > 
> > \ the next two words search for the next unique number
> > : split ( n -- n0 digit ) dup 10 MOD  tuck - swap ;
> > : next-num  ( n -- n' )
> >     split next-avail 10 MOD tuck + swap 0=
> >     IF backtrack recurse THEN ;
> > 
> > \ The main loop body adds a digit when
> > \ the guess is divisible, and goes to the next
> > \ unique-digit number when it is not divisible.
> > : divisible? ( n -- t/f ) #digits MOD 0= ;
> > : unless-done: ( magic ) #digits 8 =  IF true rdrop THEN ;
> > : try-nums ( n -- n' t/f )
> >    dup divisible?
> >    IF unless-done: add-digit ELSE next-num THEN false ;
> > 
> > : solve ( -- )
> >    0 add-digit BEGIN try-nums UNTIL 10 m* d. ;
> 
> Hi!
> 
> A variation of recursive version, using kind of dynamic variable.
> Mostly developed in text-editor(blob like result, shame on me :)
> 
> : >{    ]] dup @ 2>R [[ ; IMMEDIATE
> : }     ]] R> R>   ! [[ ; IMMEDIATE
>         VARIABLE Bmp VARIABLE N
>         DEFER run ( u -- )
> : (conundrum)   ( u digits )
>         dup 0=  IF over run EXIT THEN
>         10 1
>         DO      I
>                 1 I lshift
>                 dup Bmp @ AND 0=
>                 IF      ( u digits I 2^I )
>                         Bmp >{
>                                 Bmp +!
>                                 rot  10 * +
>                                 swap 1-
>                                 2dup N @ swap - mod 0=
>                                 IF RECURSE THEN
>                                 1+ swap
>                                 10 / swap
>                         }
>                 ELSE 2drop THEN
>         LOOP
> ;
> :noname
>         S>D <# [char] 0 hold #S #> type
> ; IS run
> : conundrum     ( -- )
>         9 N ! 1 Bmp !
>         0 N @ (conundrum) 2drop
> ;
> 
> Use: gforth cndrum.fs -e "conundrum cr bye"
> 
> Have a nice day,
> humptudumpty


Is noteworthy that dynamically using variables, unlike using locals,
permits factoring.

Just for factoring sake, under dynamically use of variable 'Bmp':


: >{	]] dup @ 2>R [[ ; IMMEDIATE
: }	]] R> R>   ! [[ ; IMMEDIATE
	VARIABLE Bmp VARIABLE N
	DEFER run ( u -- )
: prologue	( u digits I 2^I -- u' digits' )
		Bmp +!
		rot  10 * +
		swap 1-
;
: epilogue	( u' digits' -- u digits )
		1+ swap
		10 / swap
;
: (conundrum)   ( u digits )
	dup 0=  IF over run EXIT THEN
	10 1
	DO	I
		1 I lshift
		dup Bmp @ AND 0=
		IF	( u digits I 2^I )
			Bmp >{
				prologue
				2dup N @ swap - mod 0=
				IF RECURSE THEN
				epilogue
			}
		ELSE 2drop THEN
	LOOP
;
:noname
	S>D <# [char] 0 hold #S #> type
; IS run
: conundrum     ( -- )
	9 N ! 1 Bmp !
	0 N @ (conundrum) 2drop
;


Have a nice day,
humptydumpty

[toc] | [prev] | [next] | [standalone]


#41981

FromPaul Rubin <no.email@nospam.invalid>
Date2015-09-13 00:12 -0700
Message-ID<87bnd6sshd.fsf@jester.gateway.pace.com>
In reply to#41957
humptydumpty <ouatubi@gmail.com> writes:
> Is noteworthy that dynamically using variables, unlike using locals,
> permits factoring.

Yeah, I think the code I posted with the locals could have been arranged
to use the stack (maybe easier with 2 args instead of 3) but I didn't
feel up to the effort.  Static variables of course don't work with
recursive functions where the locals need different values at different
call levels.  I wrote some other recursive code a while back where I
didn't want to even think about how to get rid of the locals.  Here you
do it by carefully modifying the global, using it, then unmodifying it
in order to backtrack.  I think for the most part, the no-locals style
is harder for this sort of thing.  But it's nice to see you and Richard
posting code without them.

> Just for factoring sake, under dynamically use of variable 'Bmp':
> : >{	]] dup @ 2>R [[ ; IMMEDIATE
> : }	]] R> R>   ! [[ ; IMMEDIATE

What are ]] and [[ ?  They're not in the gforth manual word index.

> 	VARIABLE Bmp VARIABLE N
> 	DEFER run ( u -- )

What's the purpose of deferring run?  I thought maybe it was for
mutually recursive functions but I didn't see anything that needed it.

> 				prologue
> 				2dup N @ swap - mod 0=
> 				IF RECURSE THEN
> 				epilogue

I guess this uses less memory than leaving all that stuff on the stack
in the locals version.  

[toc] | [prev] | [next] | [standalone]


#41982

Fromhumptydumpty <ouatubi@gmail.com>
Date2015-09-13 02:09 -0700
Message-ID<2f80747b-80bc-4cf5-b73a-b7fc3cb236bc@googlegroups.com>
In reply to#41981
On Sunday, September 13, 2015 at 10:12:16 AM UTC+3, Paul Rubin wrote:
> humptydumpty writes:
> > Is noteworthy that dynamically using variables, unlike using locals,
> > permits factoring.
> 
> Yeah, I think the code I posted with the locals could have been arranged
> to use the stack (maybe easier with 2 args instead of 3) but I didn't
> feel up to the effort.  Static variables of course don't work with
> recursive functions where the locals need different values at different
> call levels.  I wrote some other recursive code a while back where I
> didn't want to even think about how to get rid of the locals.  Here you
> do it by carefully modifying the global, using it, then unmodifying it
> in order to backtrack.  I think for the most part, the no-locals style
> is harder for this sort of thing.  But it's nice to see you and Richard
> posting code without them.
> 
> > Just for factoring sake, under dynamically use of variable 'Bmp':
> > : >{	]] dup @ 2>R [[ ; IMMEDIATE
> > : }	]] R> R>   ! [[ ; IMMEDIATE
> 
> What are ]] and [[ ?  They're not in the gforth manual word index.
> 
> > 	VARIABLE Bmp VARIABLE N
> > 	DEFER run ( u -- )
> 
> What's the purpose of deferring run?  I thought maybe it was for
> mutually recursive functions but I didn't see anything that needed it.
> 
> > 				prologue
> > 				2dup N @ swap - mod 0=
> > 				IF RECURSE THEN
> > 				epilogue
> 
> I guess this uses less memory than leaving all that stuff on the stack
> in the locals version.

Hi!
What is between ']]' and '[[' words consider them to be 'postpone'-d:

: >{  ( addr -- )  postpone dup postpone @ postpone 2>R ; IMMEDIATE
:  {  ( -- )       postpone R> postpone R> postpone ! ; IMMEDIATE

That make rants against using variables somehow less serious.  Every code
 that use a variable could be guarded for re-entrancy like:

: >{TRY}  ( xt addr -- )  >{ CATCH } THROW ;

I deferred 'run' for little things to try with '(conundrum)' word! :)

> > 				prologue
> > 				2dup N @ swap - mod 0=
> > 				IF RECURSE THEN
> > 				epilogue
> 
> I guess this uses less memory than leaving all that stuff on the stack
> in the locals version.

If not in one stack, then in other stack must live! :)

Just for fun, in gforth inside DO..LOOP, limit and counter is
in return-stack, that makes room for some games like:

  VARIABLE X VARIABLE Y
: game ( x0 y0 x1 y1 -- )  Y ! X !  Y >{  X >{  Y ! X !  X ? Y ? I . J .  } } ;

1 7 34 79 game .s 1 7 34 79 <0>

Have a nice day,
humptydumpty

[toc] | [prev] | [next] | [standalone]


#41962

FromPaul Rubin <no.email@nospam.invalid>
Date2015-09-11 15:53 -0700
Message-ID<87k2rwsh2w.fsf@jester.gateway.pace.com>
In reply to#41944
Richard Todd <richard.wesley.todd@gmail.com> writes:
> using an exception for returning a normal value is another kind of
> smell, is it not?

I actually don't know, and will defer to the Forth gurus about that (I'm
far from one).  It's idiomatic in Lisp to use catch/throw that way, so I
went with it.  It's frowned on in Java but I think that's because Java
exceptions are slow and heavy.  I haven't studied how catch/throw is
implemented in Forth but I'm imagining it to be a setjmp/longjmp style
mechanism where the catch handlers are linked through the R stack, with
the innermost one remembered in a static cell, and the handler mostly
just restores the old DP and RP.  So if it works that way, it should be
lightweight and fast.

> I made a pass through it to clean it up.  It's basically the same
> backtracking search,

OK, I'll take a look later.

[toc] | [prev] | [next] | [standalone]


Page 1 of 2  [1] 2  Next page →

Back to top | Article view | comp.lang.forth


csiph-web