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

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

Challenge for Christmas

Started bylehs <skydda.barnen@gmail.com>
First post2016-12-24 06:10 -0800
Last post2016-12-31 10:53 -0800
Articles 20 on this page of 51 — 8 participants

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

Contents

  Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-24 06:10 -0800
    Re: Challenge for Christmas november.nihal@gmail.com - 2016-12-24 14:17 -0800
      Re: Challenge for Christmas mhx@iae.nl - 2016-12-24 15:37 -0800
      Re: Challenge for Christmas mhx@iae.nl - 2016-12-24 15:43 -0800
      Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-25 01:25 -0800
        Re: Challenge for Christmas november.nihal@gmail.com - 2016-12-25 06:59 -0800
          Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-25 07:26 -0800
            Re: Challenge for Christmas november.nihal@gmail.com - 2016-12-25 07:57 -0800
              Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-25 08:07 -0800
                Re: Challenge for Christmas november.nihal@gmail.com - 2016-12-25 08:25 -0800
    Challenge for Christmas Ilya Tarasov <ilya74.tarasov@gmail.com> - 2016-12-25 07:39 -0800
    Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-25 16:52 +0000
      Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-25 09:33 -0800
        Re: Challenge for Christmas Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2016-12-25 18:15 +0000
          Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-25 13:21 -0800
            Re: Challenge for Christmas november.nihal@gmail.com - 2016-12-25 16:51 -0800
              Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 00:48 -0800
                Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 01:36 -0800
                Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 01:39 -0800
                  Re: Challenge for Christmas november.nihal@gmail.com - 2016-12-26 04:36 -0800
                    Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 07:40 -0800
                      Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-26 15:53 +0000
                        Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 08:57 -0800
                        Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-27 13:12 +0000
                          Re: Challenge for Christmas albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2016-12-27 16:58 +0100
                            Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-27 16:01 +0000
                              Re: Challenge for Christmas albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2016-12-27 19:10 +0100
                                Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-27 18:08 +0000
                                  Re: Challenge for Christmas albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2016-12-27 20:13 +0100
                                    Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-28 08:19 +0000
                                      Re: Challenge for Christmas albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2016-12-28 12:49 +0100
                                        Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-28 14:26 +0000
                                  Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-29 13:13 +0000
                          Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-27 12:29 -0800
                            Re: Challenge for Christmas albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2016-12-27 22:25 +0100
                              Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-27 14:19 -0800
                            Re: Challenge for Christmas november.nihal@gmail.com - 2016-12-27 14:14 -0800
                            Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-28 11:06 +0000
                              Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-28 04:22 -0800
                Re: Challenge for Christmas john <anon@example.com> - 2016-12-26 13:05 +0000
                  Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 07:45 -0800
            Re: Challenge for Christmas Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2016-12-26 07:44 +0000
          Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-26 13:21 +0000
            Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-26 13:57 +0000
              Re: Challenge for Christmas anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-12-26 14:58 +0000
    Re: Challenge for Christmas albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2016-12-26 17:24 +0100
      Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 09:15 -0800
      Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-26 11:45 -0800
      Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-30 10:47 -0800
        Re: Challenge for Christmas albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2016-12-31 15:31 +0100
          Re: Challenge for Christmas lehs <skydda.barnen@gmail.com> - 2016-12-31 10:53 -0800

Page 1 of 3  [1] 2 3  Next page →

#53519 — Challenge for Christmas

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-24 06:10 -0800
SubjectChallenge for Christmas
Message-ID<26197516-a481-4262-a604-5cae2c7dc49a@googlegroups.com>
Given a buffer of increasing unsigned integers beginning at addr1 and ending at addr2-cell. I want a routine 

is_a_product  ( u addr2 addr1 -- flag )

answering the question wether u is a product of some numbers in the field or not. 

Example: if the field contains the integers 2,3,4 then 2,6,9,12 should give true flag while 7,10,21 should give false flag. Unless I'm wrong there is a lot of different strategies, but I can't see an obvious one.

[toc] | [next] | [standalone]

#53522

Fromnovember.nihal@gmail.com
Date2016-12-24 14:17 -0800
Message-ID<fca3cf50-d982-4424-ab3f-846590e79ba0@googlegroups.com>
In reply to#53519
Is this what you are trying to solve or have I misunderstood ?


: pr1 ( v -- ) ." [" lcount 0 ?do dup i cells + @ . loop drop ." ]" ;

: isaprod ( n v -- f )
	false -rot
	lcount dup
		0 do dup >r
			0 do
				2dup dup
				i cells + @
				swap
				j cells + @ * = if
					2>r drop true 2r>
				then
			loop r>
		loop
	drop 2drop ;

here 3 , 2 , 3 , 4 , value v1

cr v1 pr1
cr 2  v1 isaprod .
cr 6  v1 isaprod .
cr 9  v1 isaprod .
cr 12 v1 isaprod .
cr 7  v1 isaprod .
cr 10 v1 isaprod .
cr 21 v1 isaprod .

NN

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

#53523

Frommhx@iae.nl
Date2016-12-24 15:37 -0800
Message-ID<ff4e3382-da3b-4bec-8695-2cdc42b49289@googlegroups.com>
In reply to#53522
On Saturday, December 24, 2016 at 11:17:44 PM UTC+1, novembe...@gmail.com wrote:
> Is this what you are trying to solve or have I misunderstood ?
[..]
> : isaprod ( n v -- f )
[..]
> 		0 do dup >r
> 			0 do
[..]
> 				j cells + @ * = if
[..]
> 			loop r>
> 		loop
> 	drop 2drop ;

One cannot access J because of the ">R" before the inner loop.

This might do what you intend:

ANEW -isp
: pr1 ( v -- ) ." [" @+ 0 ?DO @+ . LOOP DROP ." ]" ; 

: isaprod ( n v -- f ) 
        @+ CELLS BOUNDS DLOCAL range  LOCAL v
        range ?DO
               range ?DO
                          I @ J @ *  v = 
                             IF  
                                TRUE UNLOOP UNLOOP EXIT  
                          ENDIF
              CELL +LOOP 
        CELL +LOOP  FALSE ; 

HERE 3 , 2 , 3 , 4 , =: v1 

CR v1 pr1 
CR 2  v1 isaprod . 
CR 6  v1 isaprod . 
CR 9  v1 isaprod . 
CR 12 v1 isaprod . 
CR 7  v1 isaprod . 
CR 10 v1 isaprod . 
CR 21 v1 isaprod . 

-marcel

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

#53524

Frommhx@iae.nl
Date2016-12-24 15:43 -0800
Message-ID<d9d54a3a-6010-40da-857f-6eab3d9f2b25@googlegroups.com>
In reply to#53522
ANEW -isp

: pr1 ( v -- ) ." [" @+ 0 ?DO @+ . LOOP DROP ." ]" ; 

: isaprod ( n v -- f ) 
        @+ CELLS BOUNDS DLOCAL range  LOCAL v
        range ?DO
               range ?DO
                          v I @ J @ * = 
                             IF  
                                TRUE UNLOOP UNLOOP EXIT  
                          ENDIF
              CELL +LOOP 
        CELL +LOOP  FALSE ; 

HERE 3 , 2 , 3 , 4 , =: v1 

CR v1 pr1 
CR 2  v1 isaprod . 
CR 6  v1 isaprod . 
CR 9  v1 isaprod . 
CR 12 v1 isaprod . 
CR 7  v1 isaprod . 
CR 10 v1 isaprod . 
CR 21 v1 isaprod . 

Now try CR v1 1024 . :-)

-marcel

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

#53526

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-25 01:25 -0800
Message-ID<85f5610a-f6eb-46e8-bc02-858068fed0a0@googlegroups.com>
In reply to#53522
Den lördag 24 december 2016 kl. 23:17:44 UTC+1 skrev novembe...@gmail.com:
> Is this what you are trying to solve or have I misunderstood ?
> 
> 
> : pr1 ( v -- ) ." [" lcount 0 ?do dup i cells + @ . loop drop ." ]" ;
> 
> : isaprod ( n v -- f )
> 	false -rot
> 	lcount dup
> 		0 do dup >r
> 			0 do
> 				2dup dup
> 				i cells + @
> 				swap
> 				j cells + @ * = if
> 					2>r drop true 2r>
> 				then
> 			loop r>
> 		loop
> 	drop 2drop ;
> 
> here 3 , 2 , 3 , 4 , value v1
> 
> cr v1 pr1
> cr 2  v1 isaprod .
> cr 6  v1 isaprod .
> cr 9  v1 isaprod .
> cr 12 v1 isaprod .
> cr 7  v1 isaprod .
> cr 10 v1 isaprod .
> cr 21 v1 isaprod .
> 
> NN

I was too vague. For a buffer of any length the answer should be true if the number u is the product of any number of unsigned integers from the buffer. For example: u=2*2*2*3*3*4*4*4 should result in 'true' if the buffer consist of the numbers 2,3,4.

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

#53527

Fromnovember.nihal@gmail.com
Date2016-12-25 06:59 -0800
Message-ID<f153977b-87a8-4b9c-b4b4-f7f1a0fe2703@googlegroups.com>
In reply to#53526
Hi Lehs, 

( -----START----- )
( ----------------------------------------------- )

: @+ ( a1 -- a2 n ) dup cell+ swap @ ;
: pr ( v -- ) ." [" @+ 0 ?do @+ . loop drop ." ]" ;

( ----------------------------------------------- )

: stk ( n -- a )
	dup 2 + cells allocate throw
	dup cell+ >r ! 0 r> dup cell+ >r ! r> ;

: ?stke ( a -- f ) cell- @ 0= ;
: ?stkf ( a -- f ) cell- dup @ swap cell- @ = ;

: pop  ( s -- n )
	dup ?stke abort" ERROR: Empty"
	dup cell- dup >r -1 swap +! r> @ cells + @ ;

: push ( n s -- )
	dup ?stkf abort" ERROR: Full"
	dup cell- dup >r @ cells + ! 1 r> +! ;

: [] ( s -- ) 0 swap cell- ! ;

( ----------------------------------------------- )

32 stk value a
32 stk value b

: >a ( n -- ) a push ;
: a> ( -- n ) a pop ;
: a@ ( -- ) a> dup >a ;
: a. ( s -- ) ." [" begin a ?stke not while a> . repeat ." ]" ;

: >b ( n -- ) b push ;
: b> ( -- n ) b pop ;
: b@ ( -- ) b> dup >b ;
: b. ( s -- ) ." [" begin b ?stke not while b> . repeat ." ]" ;

( ----------------------------------------------- )

: vec->stk ( s a n -- ) 0 ?do over >r @+ r> push loop 2drop ;
: stk->stk ( s1 s2 -- ) over ?stke if 2drop else over pop over push recurse then ;

( ----------------------------------------------- )

: isaprod1 ( u -- u F| u' T )
	a@ 1 = if abort" ERROR" else
		dup a@ /mod swap 0= if nip a@ >b true else
			drop a> drop false
		then
	then ;

: isaprod ( u v -- f )
	a [] b []
	lcount b -rot vec->stk
	b a stk->stk
	begin a ?stke not while
		isaprod1 if dup 1 = if a [] then then
	repeat
	1 = if true else false then ;

( ----------------------------------------------- )

cr cr .( Testing ) cr cr
here 3 , 2 , 3 , 4 ,  value v1
cr v1 pr
cr
cr  2 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  6 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  9 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr 12 v1 isaprod [if] .( True ) b. [else] .( False) [then]

cr   7 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  10 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  21 v1 isaprod [if] .( True ) b. [else] .( False) [then]

cr 4608 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr 1024 v1 isaprod [if] .( True ) b. [else] .( False) [then]

\\ isaprod returns the factors on stack 'b' which you can see using 'b.' 

( -----END------- )

I have used ( adr len ) rather than your ( adr2 adr1 ) as I assumed its easy convert between the two and I prefered the first one style.

The result for 4608 gets factored by 2 first hence no '4's 

If you adjust isaprod so that the vect is pushed into stack 'a' without the extra step of reversing values from 'b' to 'a', then the factoring starts from the highest and so you will have more 4's

If you do this on a 64 bit machine you will need to increase stack size as numbers will be bigger and number of factors too.

NN

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

#53528

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-25 07:26 -0800
Message-ID<43193cd3-12bf-479f-aca3-a310e2de3472@googlegroups.com>
In reply to#53527
Den söndag 25 december 2016 kl. 15:59:37 UTC+1 skrev novembe...@gmail.com:
> Hi Lehs, 
> 
> ( -----START----- )
> ( ----------------------------------------------- )
> 
> : @+ ( a1 -- a2 n ) dup cell+ swap @ ;
> : pr ( v -- ) ." [" @+ 0 ?do @+ . loop drop ." ]" ;
> 
> ( ----------------------------------------------- )
> 
> : stk ( n -- a )
> 	dup 2 + cells allocate throw
> 	dup cell+ >r ! 0 r> dup cell+ >r ! r> ;
> 
> : ?stke ( a -- f ) cell- @ 0= ;
> : ?stkf ( a -- f ) cell- dup @ swap cell- @ = ;
> 
> : pop  ( s -- n )
> 	dup ?stke abort" ERROR: Empty"
> 	dup cell- dup >r -1 swap +! r> @ cells + @ ;
> 
> : push ( n s -- )
> 	dup ?stkf abort" ERROR: Full"
> 	dup cell- dup >r @ cells + ! 1 r> +! ;
> 
> : [] ( s -- ) 0 swap cell- ! ;
> 
> ( ----------------------------------------------- )
> 
> 32 stk value a
> 32 stk value b
> 
> : >a ( n -- ) a push ;
> : a> ( -- n ) a pop ;
> : a@ ( -- ) a> dup >a ;
> : a. ( s -- ) ." [" begin a ?stke not while a> . repeat ." ]" ;
> 
> : >b ( n -- ) b push ;
> : b> ( -- n ) b pop ;
> : b@ ( -- ) b> dup >b ;
> : b. ( s -- ) ." [" begin b ?stke not while b> . repeat ." ]" ;
> 
> ( ----------------------------------------------- )
> 
> : vec->stk ( s a n -- ) 0 ?do over >r @+ r> push loop 2drop ;
> : stk->stk ( s1 s2 -- ) over ?stke if 2drop else over pop over push recurse then ;
> 
> ( ----------------------------------------------- )
> 
> : isaprod1 ( u -- u F| u' T )
> 	a@ 1 = if abort" ERROR" else
> 		dup a@ /mod swap 0= if nip a@ >b true else
> 			drop a> drop false
> 		then
> 	then ;
> 
> : isaprod ( u v -- f )
> 	a [] b []
> 	lcount b -rot vec->stk
> 	b a stk->stk
> 	begin a ?stke not while
> 		isaprod1 if dup 1 = if a [] then then
> 	repeat
> 	1 = if true else false then ;
> 
> ( ----------------------------------------------- )
> 
> cr cr .( Testing ) cr cr
> here 3 , 2 , 3 , 4 ,  value v1
> cr v1 pr
> cr
> cr  2 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> cr  6 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> cr  9 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> cr 12 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> 
> cr   7 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> cr  10 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> cr  21 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> 
> cr 4608 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> cr 1024 v1 isaprod [if] .( True ) b. [else] .( False) [then]
> 
> \\ isaprod returns the factors on stack 'b' which you can see using 'b.' 
> 
> ( -----END------- )
> 
> I have used ( adr len ) rather than your ( adr2 adr1 ) as I assumed its easy convert between the two and I prefered the first one style.
> 
> The result for 4608 gets factored by 2 first hence no '4's 
> 
> If you adjust isaprod so that the vect is pushed into stack 'a' without the extra step of reversing values from 'b' to 'a', then the factoring starts from the highest and so you will have more 4's
> 
> If you do this on a 64 bit machine you will need to increase stack size as numbers will be bigger and number of factors too.
> 
> NN

I don't know what is wrong but I get:

Gforth 0.7.9_20150825, Copyright (C) 1995-2015 Free Software Foundation, Inc.
Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
Type `bye' to exit
: lcount \ ad -- ad+2 n  compiled
  dup @ 2 under+ ;  ok
  ok
: not 0= ;  ok
  ok
( -----START----- )   ok
( ----------------------------------------------- )   ok
  ok
: @+ ( a1 -- a2 n ) dup cell+ swap @ ;   ok
: pr ( v -- ) ." [" @+ 0 ?do @+ . loop drop ." ]" ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
: stk ( n -- a )   compiled
        dup 2 + cells allocate throw   compiled
        dup cell+ >r ! 0 r> dup cell+ >r ! r> ;   ok
  ok
: ?stke ( a -- f ) cell- @ 0= ;   ok
: ?stkf ( a -- f ) cell- dup @ swap cell- @ = ;   ok
  ok
: pop  ( s -- n )   compiled
        dup ?stke abort" ERROR: Empty"   compiled
        dup cell- dup >r -1 swap +! r> @ cells + @ ;   ok
  ok
: push ( n s -- )   compiled
        dup ?stkf abort" ERROR: Full"   compiled
        dup cell- dup >r @ cells + ! 1 r> +! ;   ok
  ok
: [] ( s -- ) 0 swap cell- ! ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
32 stk value a   ok
32 stk value b   ok
  ok
: >a ( n -- ) a push ;   ok
: a> ( -- n ) a pop ;   ok
: a@ ( -- ) a> dup >a ;   ok
: a. ( s -- ) ." [" begin a ?stke not while a> . repeat ." ]" ;   ok
  ok
: >b ( n -- ) b push ;   ok
: b> ( -- n ) b pop ;   ok
: b@ ( -- ) b> dup >b ;   ok
: b. ( s -- ) ." [" begin b ?stke not while b> . repeat ." ]" ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
: vec->stk ( s a n -- ) 0 ?do over >r @+ r> push loop 2drop ;   ok
: stk->stk ( s1 s2 -- ) over ?stke if 2drop else over pop over push recurse then ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
: isaprod1 ( u -- u F| u' T )   compiled
        a@ 1 = if abort" ERROR" else   compiled
                dup a@ /mod swap 0= if nip a@ >b true else   compiled
                        drop a> drop false   compiled
                then   compiled
        then ;   ok
  ok
: isaprod ( u v -- f )   compiled
        a [] b []   compiled
        lcount b -rot vec->stk   compiled
        b a stk->stk   compiled
        begin a ?stke not while   compiled
                isaprod1 if dup 1 = if a [] then then   compiled
        repeat   compiled
        1 = if true else false then ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
cr cr .( Testing ) cr cr

Testing

 ok
here 3 , 2 , 3 , 4 ,  value v1   ok
cr v1 pr
[2 3 4 ] ok
cr
 ok
cr  2 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr  6 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr  9 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr 12 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
  ok
cr   7 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr  10 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr  21 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
  ok
cr 4608 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr 1024 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
  ok
\ isaprod returns the factors on stack 'b' which you can see using 'b.'   ok
  ok
( -----END------- )   ok

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

#53530

Fromnovember.nihal@gmail.com
Date2016-12-25 07:57 -0800
Message-ID<0a86357c-dc86-4a65-b1dc-6c1e1e795dd0@googlegroups.com>
In reply to#53528
[...]
 
> I don't know what is wrong but I get:
> 
> Gforth 0.7.9_20150825, Copyright (C) 1995-2015 Free Software Foundation, Inc.
> Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
> Type `bye' to exit
> : lcount \ ad -- ad+2 n  compiled
>   dup @ 2 under+ ;  ok
>   ok
> : not 0= ;  ok
>   ok
[...]

Sorry, I should have said I ran this on win32forth where a cell is 4 bytes.
lcount is just @+ , cells are 4 bytes not 2. 

I need to check on gforth as I cant say without running if this is sufficient.

NN

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

#53531

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-25 08:07 -0800
Message-ID<5f43c2d4-55f9-479d-abed-e21588a8e132@googlegroups.com>
In reply to#53530
Den söndag 25 december 2016 kl. 16:57:24 UTC+1 skrev novembe...@gmail.com:
> [...]
>  
> > I don't know what is wrong but I get:
> > 
> > Gforth 0.7.9_20150825, Copyright (C) 1995-2015 Free Software Foundation, Inc.
> > Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
> > Type `bye' to exit
> > : lcount \ ad -- ad+2 n  compiled
> >   dup @ 2 under+ ;  ok
> >   ok
> > : not 0= ;  ok
> >   ok
> [...]
> 
> Sorry, I should have said I ran this on win32forth where a cell is 4 bytes.
> lcount is just @+ , cells are 4 bytes not 2. 
> 
> I need to check on gforth as I cant say without running if this is sufficient.
> 
> NN
My bad! Now it works better:

Gforth 0.7.0, Copyright (C) 1995-2008 Free Software Foundation, Inc.
Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
Type `bye' to exit
: lcount \ ad -- ad+cell n  compiled
  dup @ cell under+ ;  ok
  ok
: not 0= ;  ok
  ok
: cell- cell - ;  ok
  ok
( -----START----- )   ok
( ----------------------------------------------- )   ok
  ok
: @+ ( a1 -- a2 n ) dup cell+ swap @ ;   ok
: pr ( v -- ) ." [" @+ 0 ?do @+ . loop drop ." ]" ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
: stk ( n -- a )   compiled
        dup 2 + cells allocate throw   compiled
        dup cell+ >r ! 0 r> dup cell+ >r ! r> ;   ok
  ok
: ?stke ( a -- f ) cell- @ 0= ;   ok
: ?stkf ( a -- f ) cell- dup @ swap cell- @ = ;   ok
  ok
: pop  ( s -- n )   compiled
        dup ?stke abort" ERROR: Empty"   compiled
        dup cell- dup >r -1 swap +! r> @ cells + @ ;   ok
  ok
: push ( n s -- )   compiled
        dup ?stkf abort" ERROR: Full"   compiled
        dup cell- dup >r @ cells + ! 1 r> +! ;   ok
  ok
: [] ( s -- ) 0 swap cell- ! ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
32 stk value a   ok
32 stk value b   ok
  ok
: >a ( n -- ) a push ;   ok
: a> ( -- n ) a pop ;   ok
: a@ ( -- ) a> dup >a ;   ok
: a. ( s -- ) ." [" begin a ?stke not while a> . repeat ." ]" ;   ok
  ok
: >b ( n -- ) b push ;   ok
: b> ( -- n ) b pop ;   ok
: b@ ( -- ) b> dup >b ;   ok
: b. ( s -- ) ." [" begin b ?stke not while b> . repeat ." ]" ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
: vec->stk ( s a n -- ) 0 ?do over >r @+ r> push loop 2drop ;   ok
: stk->stk ( s1 s2 -- ) over ?stke if 2drop else over pop over push recurse then ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
: isaprod1 ( u -- u F| u' T )   compiled
        a@ 1 = if abort" ERROR" else   compiled
                dup a@ /mod swap 0= if nip a@ >b true else   compiled
                        drop a> drop false   compiled
                then   compiled
        then ;   ok
  ok
: isaprod ( u v -- f )   compiled
        a [] b []   compiled
        lcount b -rot vec->stk   compiled
        b a stk->stk   compiled
        begin a ?stke not while   compiled
                isaprod1 if dup 1 = if a [] then then   compiled
        repeat   compiled
        1 = if true else false then ;   ok
  ok
( ----------------------------------------------- )   ok
  ok
cr cr .( Testing ) cr cr

Testing

 ok
here 3 , 2 , 3 , 4 ,  value v1   ok
cr v1 pr
[2 3 4 ] ok
cr
 ok
cr  2 v1 isaprod [if] .( True ) b. [else] .( False) [then]
True [2 ] ok
cr  6 v1 isaprod [if] .( True ) b. [else] .( False) [then]
True [3 2 ] ok
cr  9 v1 isaprod [if] .( True ) b. [else] .( False) [then]
True [3 3 ] ok
cr 12 v1 isaprod [if] .( True ) b. [else] .( False) [then]
True [3 2 2 ] ok
  ok
cr   7 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr  10 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
cr  21 v1 isaprod [if] .( True ) b. [else] .( False) [then]
False ok
  ok
cr 4608 v1 isaprod [if] .( True ) b. [else] .( False) [then]
True [3 3 2 2 2 2 2 2 2 2 2 ] ok
cr 1024 v1 isaprod [if] .( True ) b. [else] .( False) [then]
True [2 2 2 2 2 2 2 2 2 2 ] ok
  ok
\ isaprod returns the factors on stack 'b' which you can see using 'b.'   ok
  ok
( -----END------- )   ok

I will spend the evening trying to understand how it works. Thanks!

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

#53532

Fromnovember.nihal@gmail.com
Date2016-12-25 08:25 -0800
Message-ID<b3b12923-3b5c-4ded-9ec1-8bf4a05663e4@googlegroups.com>
In reply to#53531
Good to know it works on gforth too.

I keep forgetting to add that your buffer should not have a '1' as that is a factor to all numbers. I chose to abort as thats easy for the moment and it would highlight that fact.

{ 

As an aside: 

If you change isaprod to : 

: isaprod ( u v -- f )
	b []
	@+ a -rot vec->stk
	begin a ?stke not while
		isaprod1 if dup 1 = if a [] then then
	repeat
	1 = if true else false then ;

it will work out factors going from highest to lowest number in your buffer. 

} 

NN

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

#53529

FromIlya Tarasov <ilya74.tarasov@gmail.com>
Date2016-12-25 07:39 -0800
Message-ID<369d3094-4b2a-4500-8148-a6b4cf69afbc@googlegroups.com>
In reply to#53519
I thought challenge for Christmas should looks like 'draw a Christmas tree' :)

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

#53533

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-25 16:52 +0000
Message-ID<2016Dec25.175253@mips.complang.tuwien.ac.at>
In reply to#53519
lehs <skydda.barnen@gmail.com> writes:
>Given a buffer of increasing unsigned integers beginning at addr1 and ending at addr2-cell. I want a routine 
>
>is_a_product  ( u addr2 addr1 -- flag )
>
>answering the question wether u is a product of some numbers in the field or not. 
>
>Example: if the field contains the integers 2,3,4 then 2,6,9,12 should give true flag while 7,10,21 should give false flag. Unless I'm wrong there is a lot of different strategies, but I can't see an obvious one.

Looks pretty obvious to me (as in, no good alternative comes to my mind):

: product? ( n addr u -- )
    \ is n a product of the numbers in addr u?
    cells over + swap ?do ( n1 )
	begin
	    dup i @ /mod swap 0= while ( n1 n2 )
		nip repeat
	drop loop
    1 = ;

create v 2 , 3 , 4 ,
2 v 3 product? .

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2016: http://www.euroforth.org/ef16/

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

#53534

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-25 09:33 -0800
Message-ID<c87c7c04-7c90-4d38-84d2-996c42c27f1f@googlegroups.com>
In reply to#53533
Den söndag 25 december 2016 kl. 18:12:13 UTC+1 skrev Anton Ertl:
> lehs <skydda.barnen@gmail.com> writes:
> >Given a buffer of increasing unsigned integers beginning at addr1 and ending at addr2-cell. I want a routine 
> >
> >is_a_product  ( u addr2 addr1 -- flag )
> >
> >answering the question wether u is a product of some numbers in the field or not. 
> >
> >Example: if the field contains the integers 2,3,4 then 2,6,9,12 should give true flag while 7,10,21 should give false flag. Unless I'm wrong there is a lot of different strategies, but I can't see an obvious one.
> 
> Looks pretty obvious to me (as in, no good alternative comes to my mind):
> 
> : product? ( n addr u -- )
>     \ is n a product of the numbers in addr u?
>     cells over + swap ?do ( n1 )
> 	begin
> 	    dup i @ /mod swap 0= while ( n1 n2 )
> 		nip repeat
> 	drop loop
>     1 = ;
> 
> create v 2 , 3 , 4 ,
> 2 v 3 product? .
> 
> - anton
> -- 
> M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
> comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
>      New standard: http://www.forth200x.org/forth200x.html
>    EuroForth 2016: http://www.euroforth.org/ef16/

Gforth 0.7.0, Copyright (C) 1995-2008 Free Software Foundation, Inc.
Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
Type `bye' to exit
: product? ( n addr u -- )   compiled
    \ is n a product of the numbers in addr u?   compiled
    cells over + swap ?do ( n1 )   compiled
        begin   compiled
            dup i @ /mod swap 0= while ( n1 n2 )   compiled
                nip repeat   compiled
        drop loop   compiled
    1 = ;   ok
  ok
create v 2 , 3 , 4 ,   ok
2 v 3 product? .
:11: Floating-point unidentified fault
2 v 3 >>>product?<<< .
Backtrace:
  ok

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

#53535

FromGerry Jackson <gerry@jackson9000.fsnet.co.uk>
Date2016-12-25 18:15 +0000
Message-ID<o3p28k$65t$1@dont-email.me>
In reply to#53534
On 25/12/2016 17:33, lehs wrote:
> Den söndag 25 december 2016 kl. 18:12:13 UTC+1 skrev Anton Ertl:
>> lehs <skydda.barnen@gmail.com> writes:
>>> Given a buffer of increasing unsigned integers beginning at addr1 and ending at addr2-cell. I want a routine
>>>
>>> is_a_product  ( u addr2 addr1 -- flag )
>>>
>>> answering the question wether u is a product of some numbers in the field or not.
>>>
>>> Example: if the field contains the integers 2,3,4 then 2,6,9,12 should give true flag while 7,10,21 should give false flag. Unless I'm wrong there is a lot of different strategies, but I can't see an obvious one.
>>
>> Looks pretty obvious to me (as in, no good alternative comes to my mind):
>>
>> : product? ( n addr u -- )
>>     \ is n a product of the numbers in addr u?
>>     cells over + swap ?do ( n1 )
>> 	begin
>> 	    dup i @ /mod swap 0= while ( n1 n2 )
>> 		nip repeat
>> 	drop loop
>>     1 = ;
>>
>> create v 2 , 3 , 4 ,
>> 2 v 3 product? .
>>
>> - anton
>> --
>> M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
>> comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
>>      New standard: http://www.forth200x.org/forth200x.html
>>    EuroForth 2016: http://www.euroforth.org/ef16/
>
> Gforth 0.7.0, Copyright (C) 1995-2008 Free Software Foundation, Inc.
> Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
> Type `bye' to exit
> : product? ( n addr u -- )   compiled
>     \ is n a product of the numbers in addr u?   compiled
>     cells over + swap ?do ( n1 )   compiled
>         begin   compiled
>             dup i @ /mod swap 0= while ( n1 n2 )   compiled
>                 nip repeat   compiled
>         drop loop   compiled
>     1 = ;   ok
>   ok
> create v 2 , 3 , 4 ,   ok
> 2 v 3 product? .
> :11: Floating-point unidentified fault
> 2 v 3 >>>product?<<< .
> Backtrace:
>   ok
>

While Anton was posting his solution I arrived at an almost identical 
solution.

create vec 2 , 3 , 4 , here constant end-vec

: factor?   ( u u2 -- u3)
    >r                            ( -- u  ) ( R: -- u2 )
    begin
       dup r@ /mod swap 0=        ( -- u quot rem=0 )
    while                         ( -- u quot )
       nip                        ( -- quot)
    repeat
    r> 2drop                      ( -- u' )
;

: is-a-product  ( u ad1 ad2 -- f )
    swap
    ?do
       i @            ( -- u u2 )
       factor?        ( -- u' )
       dup 1 = if leave then
       1 cells
    +loop
    1 =
;

: go ( u -- ) vec end-vec is-a-product if ." yes" else ." no" then ;

Anton's solution, of course, should have

1 cells +loop

at the end of the do ... loop

-- 
Gerry

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

#53537

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-25 13:21 -0800
Message-ID<c7d95ba0-e963-4e9f-87e0-05d37194ffb7@googlegroups.com>
In reply to#53535
I'm afraid non of the solutions above are correct. Try the buffer 3,6,15 for example. Neither solution gives the correct answer for u=6 or u=18. As far as I can see.

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

#53538

Fromnovember.nihal@gmail.com
Date2016-12-25 16:51 -0800
Message-ID<5f0ae5e6-0970-4086-839e-df29b28aad47@googlegroups.com>
In reply to#53537
Hi Lehs 

I think for your counter example you were expecting to see 

True [6 ]
True [3 6 ] ok

in which case use the other version of "isaprod" as that would seek to factor out higher numbers first.

ie 

: isaprod ( u v -- f )
	b []
	@+ a -rot vec->stk
	begin a ?stke not while
		isaprod1 if dup 1 = if a [] then then
	repeat
	1 = if true else false then ;


The reason is that 6 is a factor of 3 and 2 is not on your list and thus when the division by 3 is done first the 2 is left as a remainder and 6 gets ignored as I choose not to start afresh. 

The previous examples would then show 

4608 -> 2 3 3 4 4 4 4
1024 -> 4 4 4 4 4

rather than 

True [3 3 2 2 2 2 2 2 2 2 2 ] ok
True [2 2 2 2 2 2 2 2 2 2 ] ok 


Hope that makes sense. Let me know if you can find any cases that dont work.

NN

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

#53540

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-26 00:48 -0800
Message-ID<1795abbc-3937-419e-9699-4be39eff5aef@googlegroups.com>
In reply to#53538
Den måndag 26 december 2016 kl. 01:51:03 UTC+1 skrev novembe...@gmail.com:
> Hi Lehs 
> 
> I think for your counter example you were expecting to see 
> 
> True [6 ]
> True [3 6 ] ok
> 
> in which case use the other version of "isaprod" as that would seek to factor out higher numbers first.
> 
> ie 
> 
> : isaprod ( u v -- f )
> 	b []
> 	@+ a -rot vec->stk
> 	begin a ?stke not while
> 		isaprod1 if dup 1 = if a [] then then
> 	repeat
> 	1 = if true else false then ;
> 
> 
> The reason is that 6 is a factor of 3 and 2 is not on your list and thus when the division by 3 is done first the 2 is left as a remainder and 6 gets ignored as I choose not to start afresh. 
> 
> The previous examples would then show 
> 
> 4608 -> 2 3 3 4 4 4 4
> 1024 -> 4 4 4 4 4
> 
> rather than 
> 
> True [3 3 2 2 2 2 2 2 2 2 2 ] ok
> True [2 2 2 2 2 2 2 2 2 2 ] ok 
> 
> 
> Hope that makes sense. Let me know if you can find any cases that dont work.
> 
> NN

Hi NN!

Unfortunately this trick doesn't work. The buffer 6,8,12 gives false for 48.

Maybe one could use a simple implementation of sets and a set stack? Like strings and a string stack. And a recursive divide-and-conquer strategy?

isaprod (integer,set) boolean 
if integer=1 then return true
if set is empty then return false
for all x in set
  if x divides integer then isaprod(integer/x,set)
  else isaprod(integer,set-{x})

There is a lot of details however...

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

#53541

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-26 01:36 -0800
Message-ID<7b6ed96b-fec8-4080-a8e9-04c97492e724@googlegroups.com>
In reply to#53540
Den måndag 26 december 2016 kl. 09:48:51 UTC+1 skrev lehs:
> Den måndag 26 december 2016 kl. 01:51:03 UTC+1 skrev novembe...@gmail.com:
> > Hi Lehs 
> > 
> > I think for your counter example you were expecting to see 
> > 
> > True [6 ]
> > True [3 6 ] ok
> > 
> > in which case use the other version of "isaprod" as that would seek to factor out higher numbers first.
> > 
> > ie 
> > 
> > : isaprod ( u v -- f )
> > 	b []
> > 	@+ a -rot vec->stk
> > 	begin a ?stke not while
> > 		isaprod1 if dup 1 = if a [] then then
> > 	repeat
> > 	1 = if true else false then ;
> > 
> > 
> > The reason is that 6 is a factor of 3 and 2 is not on your list and thus when the division by 3 is done first the 2 is left as a remainder and 6 gets ignored as I choose not to start afresh. 
> > 
> > The previous examples would then show 
> > 
> > 4608 -> 2 3 3 4 4 4 4
> > 1024 -> 4 4 4 4 4
> > 
> > rather than 
> > 
> > True [3 3 2 2 2 2 2 2 2 2 2 ] ok
> > True [2 2 2 2 2 2 2 2 2 2 ] ok 
> > 
> > 
> > Hope that makes sense. Let me know if you can find any cases that dont work.
> > 
> > NN
> 
> Hi NN!
> 
> Unfortunately this trick doesn't work. The buffer 6,8,12 gives false for 48.
> 
> Maybe one could use a simple implementation of sets and a set stack? Like strings and a string stack. And a recursive divide-and-conquer strategy?
> 
> isaprod (integer,set) boolean 
> if integer=1 then return true
> if set is empty then return false
> for all x in set
>   if x divides integer then isaprod(integer/x,set)
>   else isaprod(integer,set-{x})
> 
> There is a lot of details however...

A better algorithm:

\ isaprod { int set -- flag }
\ int 1 = if true exit then
\ set empty if false exit then
\ do for all x in set
\   int x /mod swap 0=
\   if set isaprod leave
\   else drop int x set exclude leave
\   then 
\ loop

Sets of integers>1 has to be implemented, maybe as buffers where 0 marks removed/excluded integers? And instead of locals for sets :) there must be a set-dup and set-drop for manually management.

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

#53542

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-26 01:39 -0800
Message-ID<17d49d3a-7ee2-462f-9206-94c8953ad989@googlegroups.com>
In reply to#53540
Den måndag 26 december 2016 kl. 09:48:51 UTC+1 skrev lehs:
> Den måndag 26 december 2016 kl. 01:51:03 UTC+1 skrev novembe...@gmail.com:
> > Hi Lehs 
> > 
> > I think for your counter example you were expecting to see 
> > 
> > True [6 ]
> > True [3 6 ] ok
> > 
> > in which case use the other version of "isaprod" as that would seek to factor out higher numbers first.
> > 
> > ie 
> > 
> > : isaprod ( u v -- f )
> > 	b []
> > 	@+ a -rot vec->stk
> > 	begin a ?stke not while
> > 		isaprod1 if dup 1 = if a [] then then
> > 	repeat
> > 	1 = if true else false then ;
> > 
> > 
> > The reason is that 6 is a factor of 3 and 2 is not on your list and thus when the division by 3 is done first the 2 is left as a remainder and 6 gets ignored as I choose not to start afresh. 
> > 
> > The previous examples would then show 
> > 
> > 4608 -> 2 3 3 4 4 4 4
> > 1024 -> 4 4 4 4 4
> > 
> > rather than 
> > 
> > True [3 3 2 2 2 2 2 2 2 2 2 ] ok
> > True [2 2 2 2 2 2 2 2 2 2 ] ok 
> > 
> > 
> > Hope that makes sense. Let me know if you can find any cases that dont work.
> > 
> > NN
> 
> Hi NN!
> 
> Unfortunately this trick doesn't work. The buffer 6,8,12 gives false for 48.
> 
> Maybe one could use a simple implementation of sets and a set stack? Like strings and a string stack. And a recursive divide-and-conquer strategy?
> 
> isaprod (integer,set) boolean 
> if integer=1 then return true
> if set is empty then return false
> for all x in set
>   if x divides integer then isaprod(integer/x,set)
>   else isaprod(integer,set-{x})
> 
> There is a lot of details however...

Better:

\ isaprod { int set -- flag }
\ int 1 = if true exit then
\ set empty if false exit then
\ do for all x in set
\   int x /mod swap 0=
\   if set recurse leave
\   else drop int x set exclude recurse leave
\   then 
\ loop

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

#53543

Fromnovember.nihal@gmail.com
Date2016-12-26 04:36 -0800
Message-ID<699c9f4f-1370-481e-a8f4-cc7ab5ba14a7@googlegroups.com>
In reply to#53542
Hi Lehs,

You are right it doesnt work.

I amended algorithmn to ::

( -------------------------------------- ) 

: isaprod1 ( u -- u F| u' T )
        a@ 1 = if abort" ERROR" else
                dup a@ /mod swap 0= if nip a@ >b true else
                        drop a> drop false
                then
        then ;

: isaprodA ( u v -- f )
        b []
        @+ a -rot vec->stk
        begin a ?stke not while
                isaprod1 if dup 1 = if a [] then then
        repeat
        1 = if true else false then ;

: isaprodB ( u v -- f )
        a [] b []
        lcount b -rot vec->stk
        b a stk->stk
        begin a ?stke not while
                isaprod1 if dup 1 = if a [] then then
        repeat
        1 = if true else false then ;

: isaprod ( u v -- f )
	2dup isaprodA if 2drop true else isaprodB then ;

( ----------------------------------------------- )

cr cr .( Testing ) cr cr

here 3 , 2 , 3 , 4 , value v1

cr
cr  2 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  6 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  9 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr 12 v1 isaprod [if] .( True ) b. [else] .( False) [then]

cr   7 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  10 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr  21 v1 isaprod [if] .( True ) b. [else] .( False) [then]

cr 4608 v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr 1024 v1 isaprod [if] .( True ) b. [else] .( False) [then]

forget v1

here 3 , 3 , 6 , 15 ,  value v1

cr 6  v1 isaprod [if] .( True ) b. [else] .( False) [then]
cr 18 v1 isaprod [if] .( True ) b. [else] .( False) [then]

forget v1

here 3 , 6 , 8 , 12 ,  value v1

cr 48 v1 isaprod [if] .( True ) b. [else] .( False) [then]


( ---------END------------ ) 

Short summary: Tries one way if it fails tries the other way.
Hopefully will avoid the need for sets because your vector is ordered. 

NN

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

Page 1 of 3  [1] 2 3  Next page →

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

csiph-web