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 2 of 3 — ← Prev page 1 [2] 3  Next page →


#53548

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-26 07:40 -0800
Message-ID<81704e95-91eb-446c-ae1f-b826bc880941@googlegroups.com>
In reply to#53543
Den måndag 26 december 2016 kl. 13:36:23 UTC+1 skrev novembe...@gmail.com:
> 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

For the buffer 6,8,12 it doesn't work for 576=6*8*12, but I don't know if there is a main error or a small error.

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


#53550

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-26 15:53 +0000
Message-ID<2016Dec26.165320@mips.complang.tuwien.ac.at>
In reply to#53548
lehs <skydda.barnen@gmail.com> writes:
>For the buffer 6,8,12 it doesn't work for 576=3D6*8*12, but I don't know if=
> there is a main error or a small error.

216=6*6*6=8*3*3*3 is also a problematic case.  No simple way to deal
with such cases comes to my mind.  The simplest more complex ways is
probably a search with backtracking or somesuch.

Something involving prime factor counts or the gcd of pairs of
multipliers might lead to a more efficient way, but does not appear to
be simple at all.

- 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]


#53552

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-26 08:57 -0800
Message-ID<f49e3adf-d9e1-4f7d-a9d8-c987ed350967@googlegroups.com>
In reply to#53550
Den måndag 26 december 2016 kl. 17:02:43 UTC+1 skrev Anton Ertl:
> lehs <skydda.barnen@gmail.com> writes:
> >For the buffer 6,8,12 it doesn't work for 576=3D6*8*12, but I don't know if=
> > there is a main error or a small error.
> 
> 216=6*6*6=8*3*3*3 is also a problematic case.  No simple way to deal
> with such cases comes to my mind.  The simplest more complex ways is
> probably a search with backtracking or somesuch.
> 
> Something involving prime factor counts or the gcd of pairs of
> multipliers might lead to a more efficient way, but does not appear to
> be simple at all.
> 
> - 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/

I have also thought about counting and analyze prime factors, but the problem should be possible to solve straight forward with recursion, I believe.

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


#53560

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-27 13:12 +0000
Message-ID<2016Dec27.141206@mips.complang.tuwien.ac.at>
In reply to#53550
anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>lehs <skydda.barnen@gmail.com> writes:
>>For the buffer 6,8,12 it doesn't work for 576=3D6*8*12, but I don't know if=
>> there is a main error or a small error.
>
>216=6*6*6=8*3*3*3 is also a problematic case.  No simple way to deal
>with such cases comes to my mind.  The simplest more complex ways is
>probably a search with backtracking or somesuch.

I started with my first attempt, added a backtracking search, and
arrived at this:

: product? recursive { n addr u -- f }
    \ is n a product of the numbers in addr u?
    n 1 = if
	true exit then
    addr u cells + addr ?do
	n i @ /mod { n1 } 0= if
	    n1 addr u product? if
		true unloop exit then
	then
    cell +loop
    false ;

Albert van der Horst's program
<o3rg8d$7q0$1@cherry.spenarnc.xs4all.nl> uses the same approach; a
difference from his program is that I used locals.  A particularly
nice use of locals is the "{ n1 }" part: Without that I had to use a
SWAP in that place (not so bad), and also have an ELSE branch in the
outer IF to DROP this number (pretty bad).

This version has three IFs, and a triple-nested control structure.  I
wanted to see if I could use THROW and CATCH to simplify the control
flow in this recursive search: On successfully reaching the target
(1), the following program THROWs rather than returning a flag that
has to be handled again and again:

: product1 recursive { n addr u -- }
    \ throws TRUE if n is a product of the numbers in addr u
    \ otherwise exits without throwing
    n 1 = throw
    addr u cells + addr ?do
	n i @ /mod { n1 } 0= if
	    n1 addr u product1 then
    cell +loop ;

: product1? ( n addr u -- f )
    \ is n a product of the numbers in addr u?
    ['] product1 catch dup if nip nip nip then ;

The other case is when the search space is exhausted; in that case
PRODUCT1 just exits, and CATCH returns 0, exactly what we want in that
case.  However, in the throwing case, CATCH restores the stack depth,
so we have to eliminate the additional stack items in this case.

Is the THROWing version better?  What's your opinion?

- 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]


#53561

Fromalbert@cherry.spenarnc.xs4all.nl (Albert van der Horst)
Date2016-12-27 16:58 +0100
Message-ID<o3u33l$7nk$1@cherry.spenarnc.xs4all.nl>
In reply to#53560
In article <2016Dec27.141206@mips.complang.tuwien.ac.at>,
Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>>lehs <skydda.barnen@gmail.com> writes:
>>>For the buffer 6,8,12 it doesn't work for 576=3D6*8*12, but I don't know if=
>>> there is a main error or a small error.
>>
>>216=6*6*6=8*3*3*3 is also a problematic case.  No simple way to deal
>>with such cases comes to my mind.  The simplest more complex ways is
>>probably a search with backtracking or somesuch.
>
>I started with my first attempt, added a backtracking search, and
>arrived at this:
>
>: product? recursive { n addr u -- f }
>    \ is n a product of the numbers in addr u?
>    n 1 = if
>       true exit then
>    addr u cells + addr ?do
>       n i @ /mod { n1 } 0= if
>           n1 addr u product? if
>               true unloop exit then
>       then
>    cell +loop
>    false ;
>
>Albert van der Horst's program
><o3rg8d$7q0$1@cherry.spenarnc.xs4all.nl> uses the same approach; a
>difference from his program is that I used locals.  A particularly
>nice use of locals is the "{ n1 }" part: Without that I had to use a
>SWAP in that place (not so bad), and also have an ELSE branch in the
>outer IF to DROP this number (pretty bad).
>
>This version has three IFs, and a triple-nested control structure.  I
>wanted to see if I could use THROW and CATCH to simplify the control
>flow in this recursive search: On successfully reaching the target
>(1), the following program THROWs rather than returning a flag that
>has to be handled again and again:
>
>: product1 recursive { n addr u -- }
>    \ throws TRUE if n is a product of the numbers in addr u
>    \ otherwise exits without throwing
>    n 1 = throw
>    addr u cells + addr ?do
>       n i @ /mod { n1 } 0= if
>           n1 addr u product1 then
>    cell +loop ;
>
>: product1? ( n addr u -- f )
>    \ is n a product of the numbers in addr u?
>    ['] product1 catch dup if nip nip nip then ;
>
>The other case is when the search space is exhausted; in that case
>PRODUCT1 just exits, and CATCH returns 0, exactly what we want in that
>case.  However, in the throwing case, CATCH restores the stack depth,
>so we have to eliminate the additional stack items in this case.

As long as we are throwing there is no need for a return value indeed.
If it doesn't throw, that is your result.
P.s. I've absolutely no problems with an ELSE branch that DROP's if
it means that in that ELSE branch we don't use or need an item.
That is part of the algorithm.

Here we assume that 1001 is a unique throw code that is reserved for
this algorithm. I'm not comfortable using -1 as a throw code.
"
    -1 ERROR
     ? ciforth ERROR # -1 : Operation not permitted
"
Now we can have an error 666 still, which can happen at any time.
"
    666 ERROR
     ? ciforth ERROR # 666 : Suddenly the dungeon collapses.
"

VARIABLE high
\ For  n  and  low , throws 1001 if n is a product from [low, high)
: (is_a_product)   OVER 1 = 1001 AND THROW
   BEGIN   2DUP @ /MOD   SWAP IF DROP ELSE OVER RECURSE THEN
   CELL+ DUP high @ = UNTIL   2DROP ;

: is_a_product   SWAP high ! '(is_a_product) CATCH 
    DUP DUP 1001 <> AND THROW    \ handle other throws
    IF NIP NIP THEN .S ;    


HERE 2 , 3 , 4 , HERE
CONSTANT high   CONSTANT low

: q high low is_a_product ;

"Expect false " TYPE 7 q . 10 q . 21 q . CR
"Expect true " TYPE 2 q . 6 q . 9 q . 12 q . CR

>
>Is the THROWing version better?  What's your opinion?
>
>- 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/
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

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


#53562

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-27 16:01 +0000
Message-ID<2016Dec27.170123@mips.complang.tuwien.ac.at>
In reply to#53561
albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) writes:
>In article <2016Dec27.141206@mips.complang.tuwien.ac.at>,
>Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>>anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>>>lehs <skydda.barnen@gmail.com> writes:
>>>>For the buffer 6,8,12 it doesn't work for 576=3D6*8*12, but I don't know if=
>>>> there is a main error or a small error.
>>>
>>>216=6*6*6=8*3*3*3 is also a problematic case.  No simple way to deal
>>>with such cases comes to my mind.  The simplest more complex ways is
>>>probably a search with backtracking or somesuch.
>>
>>I started with my first attempt, added a backtracking search, and
>>arrived at this:
>>
>>: product? recursive { n addr u -- f }
>>    \ is n a product of the numbers in addr u?
>>    n 1 = if
>>       true exit then
>>    addr u cells + addr ?do
>>       n i @ /mod { n1 } 0= if
>>           n1 addr u product? if
>>               true unloop exit then
>>       then
>>    cell +loop
>>    false ;

The disadvantage of this approach is that the same number may be
tested multiple times, leading to explonential* behaviour.  A pretty
bad case is

create z 4 , 6 , 9 ,
x z 3 product?

with x=5*6^n.  The largest x in the 32-bit range is 5*6^11=1813985280,
and that's still pretty fast; for 5*6^16=14105549537280, the time
becomes quite noticable (2.5G cycles on my i5-6600K); for 5*6^17 it's
already 7.3G cycles, for 5*6^18 21G cycles, so it seems to rise with
roughly O(3^n).  The largest such number in the 64-bit range is
5*6^23=3948651115268014080, and PRODUCT? to take about 5T cycles,
about 20 minutes at 4GHz.

One can speed up these cases to have an algorithmic complexity of O(n)
by using memoization; that makes the code more complex, however.

*) The first "l" was a typo, but I actually like the connotations of
this misspelling; google reports 500 hits for it, and there is even a
web site <www.explonential.com>.

>P.s. I've absolutely no problems with an ELSE branch that DROP's if
>it means that in that ELSE branch we don't use or need an item.
>That is part of the algorithm.

Sure, if you need it, you need it.  But if you can avoid it, that's
nicer.

>Here we assume that 1001 is a unique throw code that is reserved for
>this algorithm. I'm not comfortable using -1 as a throw code.

-1 is what ABORT throws.  However, at least in Gforth (and, I expect,
every other competent system) the system does not throw -1 by itself,
and we as programmers do not use ABORT here, so we can use TRUE as
throw-code here and avoid the conversion from TRUE to 1001 and back.

What is more of an issue is if we want to deal with other throw codes
(e.g., user interrupts because it runs for such a long time); we can
deal with that as follows:

: product1? ( n addr u -- f )
    \ is n a product of the numbers in addr u?
    ['] product1 catch dup true <> and throw dup if nip nip nip then ;

- 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]


#53563

Fromalbert@cherry.spenarnc.xs4all.nl (Albert van der Horst)
Date2016-12-27 19:10 +0100
Message-ID<o3uaqo$86i$1@cherry.spenarnc.xs4all.nl>
In reply to#53562
In article <2016Dec27.170123@mips.complang.tuwien.ac.at>,
Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>
>One can speed up these cases to have an algorithmic complexity of O(n)
>by using memoization; that makes the code more complex, however.

I don't think so. I'm pretty sure the worst case behaviour of this
problem is pretty bad. Say NP-complete. Applying memoization should
not be a lot of work, so one could try.

Look at this example.
Imagine a set of 2*p_i and a number that has 3 factors
2. All combination of 3 has to be tried. And that is just one prime.
With 2^16 it becomes pretty bad.

A useful and straightforward optimisation is throwing all numbers
out of the set that are not a divisor of n beforehand.

Anyhow, I'look forward to some reasoning that supports this.

<SNIP>

>- anton
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

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


#53564

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-27 18:08 +0000
Message-ID<2016Dec27.190859@mips.complang.tuwien.ac.at>
In reply to#53563
albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) writes:
>In article <2016Dec27.170123@mips.complang.tuwien.ac.at>,
>Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>>
>>One can speed up these cases to have an algorithmic complexity of O(n)
>>by using memoization; that makes the code more complex, however.
>
>I don't think so. I'm pretty sure the worst case behaviour of this
>problem is pretty bad. Say NP-complete.

Definitely polynomial, but O(n) is too optimistic indeed.  It's linear
in the number of nodes in the search graph (i.e., in the number of
unique nodes in the search tree).  For the 4^i*6^j*9^k example, and
5*6^n as input number, I expect at worst O(n^3) unique nodes (that's
the maximum number of different combinations of i,j,k that gives a
number below 6^n), but probably more like O(n^2) (because many
different combinations of i,j,k give the same number).

>Look at this example.
>Imagine a set of 2*p_i and a number that has 3 factors
>2. All combination of 3 has to be tried. And that is just one prime.
>With 2^16 it becomes pretty bad.

You lost me here.  What is p_i? Do you mean the number 8?  Why would
all combinations of 3 have to be tried?  3 is not a factor of 8, so it
is eliminated right away.

>A useful and straightforward optimisation is throwing all numbers
>out of the set that are not a divisor of n beforehand.

That just saves a constant factor.  Numbers that are not a divisor of
n always fail the divisibility test, and don't have any descendents in
the search tree.

- 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]


#53565

Fromalbert@cherry.spenarnc.xs4all.nl (Albert van der Horst)
Date2016-12-27 20:13 +0100
Message-ID<o3ueg3$8hg$1@cherry.spenarnc.xs4all.nl>
In reply to#53564
In article <2016Dec27.190859@mips.complang.tuwien.ac.at>,
Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) writes:
>>In article <2016Dec27.170123@mips.complang.tuwien.ac.at>,
>>Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>>>
>>>One can speed up these cases to have an algorithmic complexity of O(n)
>>>by using memoization; that makes the code more complex, however.
>>
>>I don't think so. I'm pretty sure the worst case behaviour of this
>>problem is pretty bad. Say NP-complete.
>
>Definitely polynomial, but O(n) is too optimistic indeed.  It's linear
>in the number of nodes in the search graph (i.e., in the number of
>unique nodes in the search tree).  For the 4^i*6^j*9^k example, and
>5*6^n as input number, I expect at worst O(n^3) unique nodes (that's
>the maximum number of different combinations of i,j,k that gives a
>number below 6^n), but probably more like O(n^2) (because many
>different combinations of i,j,k give the same number).

So you say that the number of nodes cannot grow exponentionally in
the dimension of the set. Not convinced.

>
>>Look at this example.
>>Imagine a set of 2*p_i and a number that has 3 factors
>>2. All combination of 3 has to be tried. And that is just one prime.
>>With 2^16 it becomes pretty bad.
>
>You lost me here.  What is p_i? Do you mean the number 8?  Why would
>all combinations of 3 have to be tried?  3 is not a factor of 8, so it
>is eliminated right away.

P_i are different prime numbers. All those prime numbers are assumed
to divide the number under investigation. O(n) means the size of the
set, note that the number under investigation is without limit.
Maybe you should state what exactly you mean by O(n) in this case.

>
>>A useful and straightforward optimisation is throwing all numbers
>>out of the set that are not a divisor of n beforehand.
>
>That just saves a constant factor.  Numbers that are not a divisor of
>n always fail the divisibility test, and don't have any descendents in
>the search tree.

Of course.

>
>- anton
>--
>M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

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


#53579

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-28 08:19 +0000
Message-ID<2016Dec28.091930@mips.complang.tuwien.ac.at>
In reply to#53565
albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) writes:
>In article <2016Dec27.190859@mips.complang.tuwien.ac.at>,
>Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>>>>One can speed up these cases to have an algorithmic complexity of O(n)
>>>>by using memoization; that makes the code more complex, however.

And here's the version with memoization:

variable memokey
: memo-insert ( value key wid -- )
    get-current >r
    set-current memokey ! memokey cell nextname constant
    r> set-current ;

: product-table ( -- wid )
    table true 1 2 pick memo-insert ;

: memo-lookup ( key wid -- value true | false )
    >r memokey ! memokey cell r> search-wordlist dup if
	swap execute swap then ;

defer productm1 ( n addr u -- f )

: productm? { n addr u wid -- f }
    n wid memo-lookup if 
	exit then
    n addr u wid productm1
    dup n wid memo-insert ;

:noname { n addr u wid -- f }
    \ is n a product of the numbers in addr u?
    addr u cells + addr ?do
	n i @ /mod { n1 } 0= if
	    n1 addr u wid productm? if
		true unloop exit then
	then
    cell +loop
    false ;
is productm1

create z 4 , 6 , 9 ,
product-table constant z-table
cr 3948651115268014080 z 3 z-table productm? . .s

>>>I don't think so. I'm pretty sure the worst case behaviour of this
>>>problem is pretty bad. Say NP-complete.
>>
>>Definitely polynomial, but O(n) is too optimistic indeed.  It's linear
>>in the number of nodes in the search graph (i.e., in the number of
>>unique nodes in the search tree).  For the 4^i*6^j*9^k example, and
>>5*6^n as input number, I expect at worst O(n^3) unique nodes (that's
>>the maximum number of different combinations of i,j,k that gives a
>>number below 6^n), but probably more like O(n^2) (because many
>>different combinations of i,j,k give the same number).
>
>So you say that the number of nodes cannot grow exponentionally in
>the dimension of the set. Not convinced.
>
>>
>>>Look at this example.
>>>Imagine a set of 2*p_i and a number that has 3 factors
>>>2. All combination of 3 has to be tried. And that is just one prime.
>>>With 2^16 it becomes pretty bad.
>>
>>You lost me here.  What is p_i? Do you mean the number 8?  Why would
>>all combinations of 3 have to be tried?  3 is not a factor of 8, so it
>>is eliminated right away.
>
>P_i are different prime numbers. All those prime numbers are assumed
>to divide the number under investigation. O(n) means the size of the
>set, note that the number under investigation is without limit.
>Maybe you should state what exactly you mean by O(n) in this case.

The input number is 5*6^n, so this is the n in O(n).  For the meaning
of the O(...)-Notation, see Wikipedia.

For 5*6^11, the memo table contains 73 entries at the end; for 5*6^22,
266 entries; 266/73=3.64, so it's a little less than quadratic.

As for your p_i etc. stuff, I still cannot follow you.  n is the size
of which set?

And here are the entries of the memo-table for 5*6^8; the entries are
shown in reverse order of insertion (i.e., the bottom entry (1) was
inserted first):

           8398080 0 
            933120 0 
            103680 0 
             11520 0 
              1280 0 
           1399680 0 
            155520 0 
             17280 0 
              1920 0 
           2099520 0 
            233280 0 
             25920 0 
              2880 0 
               320 0 
            349920 0 
             38880 0 
              4320 0 
               480 0 
            524880 0 
             58320 0 
              6480 0 
               720 0 
                80 0 
             87480 0 
              9720 0 
              1080 0 
               120 0 
            131220 0 
             14580 0 
              1620 0 
               180 0 
                20 0 
             21870 0 
              2430 0 
               270 0 
                30 0 
             32805 0 
              3645 0 
               405 0 
                45 0 
                 5 0 
                 1 -1  ok

- 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]


#53582

Fromalbert@cherry.spenarnc.xs4all.nl (Albert van der Horst)
Date2016-12-28 12:49 +0100
Message-ID<o408se$btu$1@cherry.spenarnc.xs4all.nl>
In reply to#53579
In article <2016Dec28.091930@mips.complang.tuwien.ac.at>,
Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) writes:
>>In article <2016Dec27.190859@mips.complang.tuwien.ac.at>,
>>Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
>>>>>One can speed up these cases to have an algorithmic complexity of O(n)
>>>>>by using memoization; that makes the code more complex, however.
>
>And here's the version with memoization:
>
>variable memokey
>: memo-insert ( value key wid -- )
>    get-current >r
>    set-current memokey ! memokey cell nextname constant
>    r> set-current ;
>
>: product-table ( -- wid )
>    table true 1 2 pick memo-insert ;
>
>: memo-lookup ( key wid -- value true | false )
>    >r memokey ! memokey cell r> search-wordlist dup if
>       swap execute swap then ;
>
>defer productm1 ( n addr u -- f )
>
>: productm? { n addr u wid -- f }
>    n wid memo-lookup if
>       exit then
>    n addr u wid productm1
>    dup n wid memo-insert ;
>
>:noname { n addr u wid -- f }
>    \ is n a product of the numbers in addr u?
>    addr u cells + addr ?do
>       n i @ /mod { n1 } 0= if
>           n1 addr u wid productm? if
>               true unloop exit then
>       then
>    cell +loop
>    false ;
>is productm1
>
>create z 4 , 6 , 9 ,
>product-table constant z-table
>cr 3948651115268014080 z 3 z-table productm? . .s
>
>>>>I don't think so. I'm pretty sure the worst case behaviour of this
>>>>problem is pretty bad. Say NP-complete.
>>>
>>>Definitely polynomial, but O(n) is too optimistic indeed.  It's linear
>>>in the number of nodes in the search graph (i.e., in the number of
>>>unique nodes in the search tree).  For the 4^i*6^j*9^k example, and
>>>5*6^n as input number, I expect at worst O(n^3) unique nodes (that's
>>>the maximum number of different combinations of i,j,k that gives a
>>>number below 6^n), but probably more like O(n^2) (because many
>>>different combinations of i,j,k give the same number).
>>
>>So you say that the number of nodes cannot grow exponentionally in
>>the dimension of the set. Not convinced.
>>
>>>
>>>>Look at this example.
>>>>Imagine a set of 2*p_i and a number that has 3 factors
>>>>2. All combination of 3 has to be tried. And that is just one prime.
>>>>With 2^16 it becomes pretty bad.
>>>
>>>You lost me here.  What is p_i? Do you mean the number 8?  Why would
>>>all combinations of 3 have to be tried?  3 is not a factor of 8, so it
>>>is eliminated right away.
>>
>>P_i are different prime numbers. All those prime numbers are assumed
>>to divide the number under investigation. O(n) means the size of the
>>set, note that the number under investigation is without limit.
>>Maybe you should state what exactly you mean by O(n) in this case.
>
>The input number is 5*6^n, so this is the n in O(n).  For the meaning
>of the O(...)-Notation, see Wikipedia.
>
>For 5*6^11, the memo table contains 73 entries at the end; for 5*6^22,
>266 entries; 266/73=3.64, so it's a little less than quadratic.
>
>As for your p_i etc. stuff, I still cannot follow you.  n is the size
>of which set?
>
>And here are the entries of the memo-table for 5*6^8; the entries are
>shown in reverse order of insertion (i.e., the bottom entry (1) was
>inserted first):
>
>           8398080 0
>            933120 0
>            103680 0
>             11520 0
>              1280 0
>           1399680 0
>            155520 0
>             17280 0
>              1920 0
>           2099520 0
>            233280 0
>             25920 0
>              2880 0
>               320 0
>            349920 0
>             38880 0
>              4320 0
>               480 0
>            524880 0
>             58320 0
>              6480 0
>               720 0
>                80 0
>             87480 0
>              9720 0
>              1080 0
>               120 0
>            131220 0
>             14580 0
>              1620 0
>               180 0
>                20 0
>             21870 0
>              2430 0
>               270 0
>                30 0
>             32805 0
>              3645 0
>               405 0
>                45 0
>                 5 0
>                 1 -1  ok
>
>- anton

Can you try this on:
given set { 6 10 15 33 46 55 }
n=2^5 . 3^5 * 5^2 * 23^2 * 11


>--
>M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

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


#53586

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-28 14:26 +0000
Message-ID<2016Dec28.152603@mips.complang.tuwien.ac.at>
In reply to#53582
albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) writes:
[Full-quote elided; you should do something about your quoting habits]
>Can you try this on:
>given set { 6 10 15 33 46 55 }
>n=2^5 . 3^5 * 5^2 * 23^2 * 11

You can also try it yourself, but anyway:

I guess you mean a multiplication with the first ".", i.e. 1131213600.
The memoization table has 151 entries.

- 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]


#53591

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-29 13:13 +0000
Message-ID<2016Dec29.141344@mips.complang.tuwien.ac.at>
In reply to#53564
I played around a little more with the program to find bad cases for
the memoizing version.  I used factors that are products of two
primes, and numbers <2^31 that are products of an uneven number of
these primes (so they cannot be products of these factors, and the
search searches the whole graph):

create z 4 , 6 , 9 ,
product-table constant z-table
cr 725594112 z 3 z-table productm? . .s \ 2^12*3^11
cr z-table count-words .
cr

create t 4 , 6 , 9 , 10 , 15 , 25 ,
product-table constant t-table
cr 1458000000 t 6 t-table productm? . .s \ 2^7*3^6*5^6
cr t-table count-words .
cr

create s 4 , 6 , 9 , 10 , 15 , 25 , 14 , 21 , 35 , 49 ,
product-table constant s-table
cr 1666980000 s 10 s-table productm? . .s \ 2^5*3^5*5^4*7^3
cr s-table count-words .
cr

create r 4 , 6 , 9 , 10 , 15 , 25 , 14 , 21 , 35 , 49 , 22 , 33 , 55 , 77 , 121 ,
product-table constant r-table
cr 960498000 r 15 r-table productm? . .s \ 2^4*3^4*5^3*7^2*11^2
cr r-table count-words .
cr

The results are:
entries factors
 79     4 6 9
197     4 6 9 10 15 25
361     4 6 9 10 15 25 14 21 35 49
451     4 6 9 10 15 25 14 21 35 49 22 33 55 77 121

- 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]


#53566

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-27 12:29 -0800
Message-ID<ac84eb09-aa26-4208-b03e-0d3077db8df7@googlegroups.com>
In reply to#53560
Den tisdag 27 december 2016 kl. 14:32:00 UTC+1 skrev Anton Ertl:
> anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
> >lehs <skydda.barnen@gmail.com> writes:
> >>For the buffer 6,8,12 it doesn't work for 576=3D6*8*12, but I don't know if=
> >> there is a main error or a small error.
> >
> >216=6*6*6=8*3*3*3 is also a problematic case.  No simple way to deal
> >with such cases comes to my mind.  The simplest more complex ways is
> >probably a search with backtracking or somesuch.
> 
> I started with my first attempt, added a backtracking search, and
> arrived at this:
> 
> : product? recursive { n addr u -- f }
>     \ is n a product of the numbers in addr u?
>     n 1 = if
> 	true exit then
>     addr u cells + addr ?do
> 	n i @ /mod { n1 } 0= if
> 	    n1 addr u product? if
> 		true unloop exit then
> 	then
>     cell +loop
>     false ;
> 
> Albert van der Horst's program
> <o3rg8d$7q0$1@cherry.spenarnc.xs4all.nl> uses the same approach; a
> difference from his program is that I used locals.  A particularly
> nice use of locals is the "{ n1 }" part: Without that I had to use a
> SWAP in that place (not so bad), and also have an ELSE branch in the
> outer IF to DROP this number (pretty bad).
> 
> This version has three IFs, and a triple-nested control structure.  I
> wanted to see if I could use THROW and CATCH to simplify the control
> flow in this recursive search: On successfully reaching the target
> (1), the following program THROWs rather than returning a flag that
> has to be handled again and again:
> 
> : product1 recursive { n addr u -- }
>     \ throws TRUE if n is a product of the numbers in addr u
>     \ otherwise exits without throwing
>     n 1 = throw
>     addr u cells + addr ?do
> 	n i @ /mod { n1 } 0= if
> 	    n1 addr u product1 then
>     cell +loop ;
> 
> : product1? ( n addr u -- f )
>     \ is n a product of the numbers in addr u?
>     ['] product1 catch dup if nip nip nip then ;
> 
> The other case is when the search space is exhausted; in that case
> PRODUCT1 just exits, and CATCH returns 0, exactly what we want in that
> case.  However, in the throwing case, CATCH restores the stack depth,
> so we have to eliminate the additional stack items in this case.
> 
> Is the THROWing version better?  What's your opinion?
> 
> - 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/

Thanks a lot for this expositions, which however goes lot above my level of ambition. No I prefer without THROW since I will use this just about as the word PRIME ( n -- flag ) to investigate sets (subsets of integer monoids).

: genmon \ set --      create the buffer from a set
  adn1 here cell+ swap dup >r cmove 
  r> here ! zdrop ;

: inm \ n -- flag      testing a number regarding the buffer
  here cell+ here @ over + swap is_a_product ;

{ 2 3 4 5 6 7 } genmon  ok
{ 1 200 | inm }  ok
cr zet.
{1,2,3,4,5,6,7,8,9,10,12,14,15,16,18,20,21,24,25,27,28,30,32,35,36,40,42,45,48,49,50,54,56,60,63,64,70,72,75,80,81,84,90,96,98,100,105,108,112,120,125,126,128,135,140,144,147,150,160,162,168,175,180,189,192,196} ok

If I ever encounter the worst case, I'll deal with it then. ;)

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


#53567

Fromalbert@cherry.spenarnc.xs4all.nl (Albert van der Horst)
Date2016-12-27 22:25 +0100
Message-ID<o3um8b$8un$1@cherry.spenarnc.xs4all.nl>
In reply to#53566
In article <ac84eb09-aa26-4208-b03e-0d3077db8df7@googlegroups.com>,
lehs  <skydda.barnen@gmail.com> wrote:
>
>{ 2 3 4 5 6 7 } genmon  ok
>{ 1 200 | inm }  ok
>cr zet.
>{1,2,3,4,5,6,7,8,9,10,12,14,15,16,18,20,21,24,25,27,28,30,32,35,36,40,42,45,48,49,50,54,56,60,63,64,70,72,75,80,81,84,90,96,98,100,105,108,112,120,125,126,128,135,140,144,147,150,160,162,168,175,180,189,192,196} ok
>
>If I ever encounter the worst case, I'll deal with it then. ;)

These are in fact 7-smooth numbers.
You can thin out your set to
the prime numbers without a different result:

{ 2 3 5 7 } genmon

For 4 you can use 2 two times, for 6 you can use 2 and 3 etc.

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

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


#53569

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-27 14:19 -0800
Message-ID<e5905a5f-0275-4113-b78c-5c6b1e27ac46@googlegroups.com>
In reply to#53567
Den tisdag 27 december 2016 kl. 22:14:52 UTC+1 skrev Albert van der Horst:
> In article <ac84eb09-aa26-4208-b03e-0d3077db8df7@googlegroups.com>,
> lehs  <skydda.barnen@gmail.com> wrote:
> >
> >{ 2 3 4 5 6 7 } genmon  ok
> >{ 1 200 | inm }  ok
> >cr zet.
> >{1,2,3,4,5,6,7,8,9,10,12,14,15,16,18,20,21,24,25,27,28,30,32,35,36,40,42,45,48,49,50,54,56,60,63,64,70,72,75,80,81,84,90,96,98,100,105,108,112,120,125,126,128,135,140,144,147,150,160,162,168,175,180,189,192,196} ok
> >
> >If I ever encounter the worst case, I'll deal with it then. ;)
> 
> These are in fact 7-smooth numbers.
> You can thin out your set to
> the prime numbers without a different result:
> 
> { 2 3 5 7 } genmon
> 
> For 4 you can use 2 two times, for 6 you can use 2 and 3 etc.
> 
> Groetjes Albert
> -- 
> Albert van der Horst, UTRECHT,THE NETHERLANDS
> Economic growth -- being exponential -- ultimately falters.
> albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

Yes, but just in this and equal cases. Not for example in { 4 6 15 }.

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


#53568

Fromnovember.nihal@gmail.com
Date2016-12-27 14:14 -0800
Message-ID<e81f1ad0-a775-4432-83f5-b99fd5d12e96@googlegroups.com>
In reply to#53566
A better solution has already been posted so I dont know if this will prove of further use but at least I got it working for the tests.

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

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

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

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

: freestk ( a -- ) 2 cells - free throw ;

: ?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> +! ;

: peek ( s -- n ) dup pop dup rot push ;

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

: dpth ( s -- n ) cell- @ ;
: stksize ( s -- n ) cell- cell- @ ;

: clonestk ( a -- b )
	dup stksize dup stk ( a n b -- )
	dup >r ( save a copy )
	swap
	rot 2 cells -
	rot 2 cells -
	rot cells move
	r> ;

( print stack )  	       : pr1 ( s -- ) ." [" dup dpth 0 ?do @+ . loop drop ." ]"  ;
( print stack of stacks )  : pr2 ( s -- ) ." [" dup dpth 0 ?do @+ pr1 loop drop ." ]"  ;

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

1024 stk value a
64  stk value b

: >a ( n -- ) a push ;
: a> ( -- n ) a pop ;
: a@ ( -- n ) a peek ;
: a. ( -- )   a pr2 ;

: >b ( n -- ) b push ;
: b> ( -- n ) b pop ;
: b@ ( -- n ) b peek ;
: b. ( -- )
	b dpth dup 8 > if
		."  There are " u. ." results. eg = " b@ pr1
	else drop b pr2 then ;

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

variable result

: isaprod1A ( n v -- f ) 				\ round1 just iterate over the vector and see if any numbers divide
	false result !						\ if yes save the divisor and quotient on the stack
	@+ 0 do
		2dup
		i cells + @ /mod swap 0= if
			over i cells + @
			64 stk >r 					\ create a new stack
			r@ push
			r@ push
			r> >a
			true result !				\ true just means a possible option might exist
		else drop 						\ division unsuccessful skip
		then
	loop 2drop result @ ;

: isaprod1B ( n v -- f ) 				\ same as 1A but we dont want a new stack
	false result !						\
	@+ 0 do
		2dup
		i cells + @ /mod swap 0= if
			over i cells + @
			a@ clonestk >r 				\ clone stack because we are exploring an option
			r@ push
			r@ push
			r> a> swap >a >a 			\ push successful under
			true result !				\ true just means a possible option might exist
		else drop 						\ division unsuccessful skip
		then
	loop 2drop result @ ;

: isaprod2 ( v -- f ) 					\ round2 and if we are successful push answer to b
	a dpth if							\ while stack a is not empty we have options
		a@ pop swap
		2dup isaprod1B if
			a> drop 					\ we drop the top item because we were tucking other options under in A
			nip recurse
		else
			swap 1 = if a> >b exit else a> drop then recurse
		then
	then
	drop b ?stke not ;

: isaprod ( n v -- f )
	a [] \ empty backtrack
	b [] \ empty answers
	2dup isaprod1A if
		nip isaprod2
	else
		2drop false
	then ;

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

cr cr .( Testing ) cr cr

: test ( n v xt -- )
	>r over r> swap
	cr u. ." -->  "
	catch if
		cr ." ## Error caught"
	else
		if ." True " b.
		else  ." False " then
	then ;

here 3 , 2 , 3 , 4 , value v1

cr
cr  2 v1 ' isaprod test
cr  6 v1 ' isaprod test
cr  9 v1 ' isaprod test
cr 12 v1 ' isaprod test

cr   7 v1 ' isaprod test
cr  10 v1 ' isaprod test
cr  21 v1 ' isaprod test

cr 4608 v1 ' isaprod test
cr 1024 v1 ' isaprod test

forget v1

here 3 , 3 , 6 , 15 ,  value v1

cr 6  v1 ' isaprod test
cr 18 v1 ' isaprod test

forget v1

here 3 , 6 , 8 , 12 ,  value v1

cr 48  v1 ' isaprod test
cr 576 v1 ' isaprod test


PS
* Used win32forth
* Exits at the first solution found. 
* If you want more solutions remove the exit from function "isaprod2"

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


#53581

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-12-28 11:06 +0000
Message-ID<2016Dec28.120605@mips.complang.tuwien.ac.at>
In reply to#53566
lehs <skydda.barnen@gmail.com> writes:
>: genmon \ set --      create the buffer from a set
>  adn1 here cell+ swap dup >r cmove 
>  r> here ! zdrop ;
>
>: inm \ n -- flag      testing a number regarding the buffer
>  here cell+ here @ over + swap is_a_product ;
>
>{ 2 3 4 5 6 7 } genmon  ok
>{ 1 200 | inm }  ok
>cr zet.
>{1,2,3,4,5,6,7,8,9,10,12,14,15,16,18,20,21,24,25,27,28,30,32,35,36,40,42,45,48,49,50,54,56,60,63,64,70,72,75,80,81,84,90,96,98,100,105,108,112,120,125,126,128,135,140,144,147,150,160,162,168,175,180,189,192,196} ok

If you want to find the products in the first n natural numbers, a
sieve-like algorithm is much more efficient than testing each number
separately.

- 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]


#53583

Fromlehs <skydda.barnen@gmail.com>
Date2016-12-28 04:22 -0800
Message-ID<7f34a75c-b45a-4a0c-953c-f367204a4b51@googlegroups.com>
In reply to#53581
Den onsdag 28 december 2016 kl. 12:15:52 UTC+1 skrev Anton Ertl:
> lehs <skydda.barnen@gmail.com> writes:
> >: genmon \ set --      create the buffer from a set
> >  adn1 here cell+ swap dup >r cmove 
> >  r> here ! zdrop ;
> >
> >: inm \ n -- flag      testing a number regarding the buffer
> >  here cell+ here @ over + swap is_a_product ;
> >
> >{ 2 3 4 5 6 7 } genmon  ok
> >{ 1 200 | inm }  ok
> >cr zet.
> >{1,2,3,4,5,6,7,8,9,10,12,14,15,16,18,20,21,24,25,27,28,30,32,35,36,40,42,45,48,49,50,54,56,60,63,64,70,72,75,80,81,84,90,96,98,100,105,108,112,120,125,126,128,135,140,144,147,150,160,162,168,175,180,189,192,196} ok
> 
> If you want to find the products in the first n natural numbers, a
> sieve-like algorithm is much more efficient than testing each number
> separately.
> 
> - 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/

Yes, but the method TEST ( n -- flag ) is a standard method that works when efficiency isn't critical.

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


#53544

Fromjohn <anon@example.com>
Date2016-12-26 13:05 +0000
Message-ID<MPG.32cb25f664e2f4f89896e1@news.virginmedia.com>
In reply to#53540
In article <1795abbc-3937-419e-9699-4be39eff5aef@googlegroups.com>, 
skydda.barnen@gmail.com says...
> Maybe one could use a simple implementation of sets and a set stack?
> 

now you're getting somewhere

-- 

john

=========================
http://johntech.co.uk

"Bleeding Edge Forum"
http://johntech.co.uk/forum/ 

=========================

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


Page 2 of 3 — ← Prev page 1 [2] 3  Next page →

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


csiph-web