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

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

Heap's algorithm

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

Contents

  Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-08 23:21 -0700
    Re: Heap's algorithm Raimond Dragomir <raimond.dragomir@gmail.com> - 2017-06-09 00:27 -0700
      Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 01:40 -0700
        Re: Heap's algorithm Raimond Dragomir <raimond.dragomir@gmail.com> - 2017-06-09 02:15 -0700
          Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 03:04 -0700
            Re: Heap's algorithm Raimond Dragomir <raimond.dragomir@gmail.com> - 2017-06-09 03:50 -0700
              Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 07:37 -0700
                Re: Heap's algorithm Coos Haak <htrofhc@gmail.com> - 2017-06-09 19:50 +0200
                  Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 11:32 -0700
              Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 07:54 -0700
              Re: Heap's algorithm Andrew Haley <andrew29@littlepinkcloud.invalid> - 2017-06-09 10:11 -0500
                Re: Heap's algorithm Alex <alex@rivadpm.com> - 2017-06-09 18:43 +0100
            Re: Heap's algorithm rickman <gnuarm@gmail.com> - 2017-06-09 11:18 -0400
              Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 08:42 -0700
                Re: Heap's algorithm rickman <gnuarm@gmail.com> - 2017-06-09 13:43 -0400
        Re: Heap's algorithm Lars Brinkhoff <lars.spam@nocrew.org> - 2017-06-09 13:08 +0200
      Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-09 09:35 -0700
        Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 23:31 -0700
          Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-10 14:28 -0700
            Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-10 14:44 -0700
              Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-10 18:56 -0700
                Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-10 19:19 -0700
                  Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-10 21:04 -0700
                    Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-10 21:08 -0700
                      Re: Heap's algorithm Ron Aaron <rambamist@gmail.com> - 2017-06-11 07:19 +0300
                        Re: Heap's algorithm Alex <alex@rivadpm.com> - 2017-06-11 09:43 +0100
                          Re: Heap's algorithm minforth@arcor.de - 2017-06-11 02:35 -0700
                            Re: Heap's algorithm Alex <alex@rivadpm.com> - 2017-06-11 10:45 +0100
                              Re: Heap's algorithm rickman <gnuarm@gmail.com> - 2017-06-11 12:32 -0400
                                Re: Heap's algorithm Alex <alex@rivadpm.com> - 2017-06-11 17:52 +0100
                                  Re: Heap's algorithm rickman <gnuarm@gmail.com> - 2017-06-12 23:26 -0400
                                Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-12 19:55 -0700
                            Re: Heap's algorithm krishna.myneni@ccreweb.org - 2017-06-11 14:40 -0700
                            Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-12 09:02 -0700
                  Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-10 21:30 -0700
                    Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-10 21:51 -0700
                  Re: Heap's algorithm "Robert L." <No_spamming@noWhere_7073.org> - 2017-06-12 02:24 +0000
                    Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-11 19:28 -0700
                      Re: Heap's algorithm Melzzzzz <Melzzzzz@zzzzz.com> - 2017-06-12 03:41 +0000
                  Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-14 22:15 -0700
                    Re: Heap's algorithm Ron Aaron <rambamist@gmail.com> - 2017-06-15 08:29 +0300
                      Re: Heap's algorithm Alex <alex@rivadpm.com> - 2017-06-15 12:24 +0100
                        Re: Heap's algorithm Ron Aaron <rambamist@gmail.com> - 2017-06-15 15:59 +0300
                      Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-16 01:25 -0700
                    Re: Heap's algorithm awegel@arcor.de (Alexander Wegel) - 2017-06-15 14:08 +0200
                      Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-16 10:46 -0700
                        Re: Heap's algorithm awegel@arcor.de (Alexander Wegel) - 2017-06-17 02:47 +0200
    Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-09 00:31 -0700
    Re: Heap's algorithm Coos Haak <htrofhc@gmail.com> - 2017-06-09 12:32 +0200
    Re: Heap's algorithm hum9 <obi65537@gmail.com> - 2017-06-09 10:03 -0700
      Re: Heap's algorithm hum9 <obi65537@gmail.com> - 2017-06-09 22:28 -0700
    Re: Heap's algorithm hum9 <obi65537@gmail.com> - 2017-06-10 03:07 -0700
      Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-10 05:41 -0700
        Re: Heap's algorithm hum9 <obi65537@gmail.com> - 2017-06-10 18:05 +0300
    Re: Heap's algorithm "Robert L." <No_spamming@noWhere_7073.org> - 2017-06-12 03:32 +0000
      Re: Heap's algorithm "Robert L." <No_spamming@noWhere_7073.org> - 2017-06-12 03:35 +0000
        Re: Heap's algorithm "Robert L." <No_spamming@noWhere_7073.org> - 2017-06-12 04:01 +0000
        Re: Heap's algorithm "Robert L." <No_spamming@noWhere_7073.org> - 2017-06-12 11:01 +0000
      Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-11 21:14 -0700
        Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-11 22:00 -0700
          Re: Heap's algorithm Melzzzzz <Melzzzzz@zzzzz.com> - 2017-06-12 07:54 +0000
            Re: Heap's algorithm Julian Fondren <julian.fondren@gmail.com> - 2017-06-12 01:13 -0700
              Re: Heap's algorithm Melzzzzz <Melzzzzz@zzzzz.com> - 2017-06-12 08:20 +0000
    Re: Heap's algorithm Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2017-06-14 20:17 +0100
      Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-16 01:16 -0700
        Re: Heap's algorithm Alex <alex@rivadpm.com> - 2017-06-16 15:14 +0100
          Re: Heap's algorithm Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2017-06-16 20:15 +0100
        Re: Heap's algorithm Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2017-06-16 20:14 +0100
          Re: Heap's algorithm hughaguilar96@gmail.com - 2017-06-16 19:35 -0700

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

#60770

On 06/15/17 08:15, hughaguilar96@gmail.com wrote:
> On Saturday, June 10, 2017 at 7:19:44 PM UTC-7, Julian Fondren wrote:
>> But if your defense is, "this is 'generic', I know it's slower", you
>> could at least stop pretending that people are insane or filled with
>> evil for wanting code that's like 7x faster.
> 
> My array sort is getting attacked pretty hard! Why the array sort, rather than some other aspect of the novice-package? The array sort is very basic code, so it seems an unlikely target for attack.
> 
> I think the reason why it is targeted in particular is because EXCHANGE shows up the weakness of SwiftForth.

I doubt anyone gives two shits about the purported performance problems
of an ancient version of SwiftForth's "EXCHANGE" word.

The reason your code gets "attacked" is that you persist in ignoring
empirically sound advice.  Specifically, that moving pointers is *much*
faster than moving around data (if the data size is bigger than the
pointer size, obviously).  Even assuming, arguendo, that EXCHANGE is
slow as molasses.

It's not just the posters here who've responded to you who say this.

It's easy enough to find this information in any online discussion of
sorting.  Literally hundreds of such discussions.

It's easy enough to SIMPLY MEASURE THE PERFORMANCE and convince yourself
that yes, perhaps there is a point here.  But you don't believe in
measuring things, you believe that assertions of fact make the "facts"
miraculously true.

So paranoia aside (and you really do need some meds or psych advice, but
I've said that before) --- nobody is attacking *you* over the code you
posted.  They're criticising a bad implementation.  If anyone else had
posted it, they too would have been criticised.

It matters, if you want to write good code.  You need to be able to
accept criticism of your code, and decide rationally whether the
critiques are valid or not, and whether or not it makes sense for you to
modify your code.

Sometimes, "good enough" really is.  But sometimes, it's just pushing
the pain point a few days/months/years down the road.  When you write
customer-facing code (as I do) then it can make a huge difference as to
whether you get hired again.

Get help, or at least just shut up about your inane conspiracies.

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

#60775

On 6/15/2017 06:29, Ron Aaron wrote:
> 
> 
> On 06/15/17 08:15, hughaguilar96@gmail.com wrote:
>> On Saturday, June 10, 2017 at 7:19:44 PM UTC-7, Julian Fondren 
>> wrote:
>>> But if your defense is, "this is 'generic', I know it's slower", 
>>> you could at least stop pretending that people are insane or 
>>> filled with evil for wanting code that's like 7x faster.
>> 
>> My array sort is getting attacked pretty hard! Why the array sort, 
>> rather than some other aspect of the novice-package? The array
>> sort is very basic code, so it seems an unlikely target for
>> attack.
>> 
>> I think the reason why it is targeted in particular is because 
>> EXCHANGE shows up the weakness of SwiftForth.
> 
> I doubt anyone gives two shits about the purported performance 
> problems of an ancient version of SwiftForth's "EXCHANGE" word.
> 
> The reason your code gets "attacked" is that you persist in ignoring
>  empirically sound advice.  Specifically, that moving pointers is 
> *much* faster than moving around data (if the data size is bigger 
> than the pointer size, obviously).  Even assuming, arguendo, that 
> EXCHANGE is slow as molasses.

Just as one of those data points, here's a table from this website
https://www.cs.auckland.ac.nz/software/AlgAnim/qsort3.html. It documents
for three well known sorts the average number of compares and the number
of exchanges.

n           Quick          Heap              Insert
          comp    exch   comp     exch     comp    exch
100       712     148   2,842     581    2,595     899
200     1,682     328   9,736   1,366   10,307   3,503
500     5,102     919  53,113   4,042   62,746  21,083

Is exchanging two records going to have a significant impact? Would 
exchanging two pointers be cheaper? Especially when doing it in a loop 
one cell at a time? The data here suggests that it's a yes; it does.

(Apart from which, doing it with pointers allows the data to be 
scattered rather than all arranged in rectangular arrays; variable 
length records, data in other structures like trees where swapping it 
destroys the structure etc. I don't get this particular obsession with 
arrays. What is also striking is the average number of compares. 
Optimizing that will also pay benefits; even with quicksort it's around 
5 times as many compares as exchanges.)

-- 
Alex

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

#60778

On 15/06/2017 14:24, Alex wrote:

> Just as one of those data points, here's a table ...

You don't understand, Alex!  T

The method Hugh's madness takes is to reinvent everything from scratch.
Because... of the wonderful wiz he was, or something.

Empirical data, reasoned arguments, testing in the real world, seeking
advice of those who've been in the field... nah.

Gotta invent that wheel myself!  And if you don't like my icosagon
wheel, it's because you're an idiot who can't understand how much
superior it is to the ridiculous circular and inefficient one you prefer
for some reason.

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

#60808

On Wednesday, June 14, 2017 at 10:30:12 PM UTC-7, Ron Aaron wrote:
> The reason your code gets "attacked" is that you persist in ignoring
> empirically sound advice.  Specifically, that moving pointers is *much*
> faster than moving around data (if the data size is bigger than the
> pointer size, obviously).  

All of this is a straw-man argument. I'm not preventing anybody from having an array of pointers to structs --- my SORT works fine for that --- it also works fine for an array of structs.

The novice-package is general-purpose code --- it is supposed to support any reasonable usage --- an array of structs is going to be reasonable in some programs.

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

#60777

<hughaguilar96@gmail.com> wrote:

> On Saturday, June 10, 2017 at 7:19:44 PM UTC-7, Julian Fondren wrote:
> > But if your defense is, "this is 'generic', I know it's slower", you
> > could at least stop pretending that people are insane or filled with
> > evil for wanting code that's like 7x faster.
> 
> My array sort is getting attacked pretty hard! Why the array sort,
> rather than some other aspect of the novice-package? The array sort
> is very basic code, so it seems an unlikely target for attack.

It's because of that:
It's very basic code, and you managed to screw it up.

Let me show you:

> Here is the EXCHANGE code:
> -----------------------------------------------------------------------
> SwiftForth? [if]        \ SwiftForth's optimization is so bad that no
> Forth version is any good

Let's ignore the dumb rant for now..

> 
> icode exchange ( adrX adrY size -- )    \ the size of the record must be a
>                                           multiple of W
>     0 [ebp] edx mov  w [ebp] ecx mov    \ EDX<>ECX, with EBX being the size
>     begin  non-zero? while
>         0 [ecx] eax mov
>         0 [edx] eax xor  eax 0 [edx] xor  0 [edx] eax xor
>         eax 0 [ecx] mov
>         w # edx add  w # ecx add
>         w # ebx sub  repeat
>     w 2 * [ebp] ebx mov
>     w 3 * # ebp add  ret end-code
> 
> [else]
> 
> macro: exchange ( adrX adrY size -- )   \ the size of the record must
>                                           be a multiple of W
>     begin  dup while                    \ -- adrX adrY remaining
>         -rot                            \ -- remaining adrX adrY
>         dup @  rover @                  \ -- remaining adrX adrY Y X
>         rover !  rover !                \ -- remaining adrX adrY
>         w +  swap w +  rot w -          \ -- adrY adrX remaining
>                                         \ adrY and adrX change places
>         repeat
>     3drop ;
> 
> [then]

Considering that the record size is known to the sort function that is
using your exchange, there's no real need to pass it around for every
call to exchange.

More significantly, if your records are small (one or a few cells),
including a loop in exchange is overkill, messes up the stack, and makes
exchange significantly slower than it has to be on *any* system.
(Additionally, the "w + swap w +" part gets executed once too often at
any record size!)

Trying to optimize this code by inlining it is just ridiculous - just
the kind of marketing lie that you habitually accuse others of.

You accused me of "screwing up" by using an IF for a conditional when it
wasn't even about optimization, so by comparison you *royally* screwed
up, and you don't even seem to have a clue.

Alex W.

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

#60842

On Thursday, June 15, 2017 at 5:09:01 AM UTC-7, Alexander Wegel wrote:
> Considering that the record size is known to the sort function that is
> using your exchange, there's no real need to pass it around for every
> call to exchange.

Alex Wegel knows little or nothing about OOP --- the record size is not necessarily known at compile-time.
 
> More significantly, if your records are small (one or a few cells),
> including a loop in exchange is overkill, messes up the stack, and makes
> exchange significantly slower than it has to be on *any* system.
> (Additionally, the "w + swap w +" part gets executed once too often at
> any record size!)

Alex Wegel knows little or nothing about VFX compilation. 

Here is a new Forth version that is slightly faster than my previous version --- it is still not as fast as my assembly-language version --- note that I did not follow Alex Wegel's advice:

macro: exchange ( adrX adrY size -- )   \ the size of the record must be a non-zero multiple of W
    begin
        -rot                            \ -- remaining adrX adrY
        dup @  rover @                  \ -- remaining adrX adrY Y X
        rover !  rover !                \ -- remaining adrX adrY
        w +  swap w +  rot W -          \ -- adrY adrX remaining        \ adrY and adrX change places
        dup 0= until
    3drop ;
    
> Trying to optimize this code by inlining it is just ridiculous - just
> the kind of marketing lie that you habitually accuse others of.

So, every time that I use my early-binding MACRO: this is a "marketing lie" --- but you didn't like my late-binding MACRO: either --- you don't like any code that I write!

https://groups.google.com/forum/#!topic/comp.lang.forth/92KNs8p4J6Y%5B1-25%5D

Alex Wegel only likes Forth Inc. --- he is a brown-noser --- there is no code that I could ever write that he would say anything positive about.

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

#60865

<hughaguilar96@gmail.com> wrote:

> On Thursday, June 15, 2017 at 5:09:01 AM UTC-7, Alexander Wegel wrote:
> > Considering that the record size is known to the sort function that is
> > using your exchange, there's no real need to pass it around for every
> > call to exchange.
> 
> Alex Wegel knows little or nothing about OOP 
> --- the record size is not necessarily known at compile-time.

Hint: nobody wrote anything about compile-time.

> > More significantly, if your records are small (one or a few cells),
> > including a loop in exchange is overkill, messes up the stack, and makes
> > exchange significantly slower than it has to be on *any* system.
> > (Additionally, the "w + swap w +" part gets executed once too often at
> > any record size!)
> 
> Alex Wegel knows little or nothing about VFX compilation. 

Well, enough to verify that a non-looping version can be much faster for
small record sizes (2.5 times faster for single-cell records), and to
verify that making exchange a macro does NOT have any significant impact
on speed.

> Here is a new Forth version that is slightly faster than my previous version
> --- it is still not as fast as my assembly-language version --- note that I
> did not follow Alex Wegel's advice:

I tried to give you an advice? I'm troubled.
Anyway - the code looks, works and performs just like the old one -
nothing new here.

> macro: exchange ( adrX adrY size -- )   \ the size of the record must
>                                            be a non-zero multiple of W
>     begin
>         -rot                            \ -- remaining adrX adrY
>         dup @  rover @                  \ -- remaining adrX adrY Y X
>         rover !  rover !                \ -- remaining adrX adrY
>         w +  swap w +  rot W -          \ -- adrY adrX remaining
>                                         \ adrY and adrX change places
>         dup 0= until
>     3drop ;
>     
> > Trying to optimize this code by inlining it is just ridiculous - just
> > the kind of marketing lie that you habitually accuse others of.

Guess what: Using MACRO: doesn't make a difference with this new version
too (it just bloats everything).

> So, every time that I use my early-binding MACRO: this is a "marketing lie"

No, probably not every time.

> --- but you didn't like my late-binding MACRO: either

I didn't like the way you used it.

> --- you don't like any code that I write!

Is this some kind of conclusion, or a cry for love?

> https://groups.google.com/forum/#!topic/comp.lang.forth/92KNs8p4J6Y%5B1-25%5D

From that thread i love this excerpt (posted on 2016/12/27):

>> ... the novice-package (to be released in a few days).

Still waiting (years and fortnights pass by..).

> Alex Wegel only likes Forth Inc. --- he is a brown-noser

You're fantasizing.

> --- there is no code that I could ever write that he would say anything
> positive about.

I'm afraid you're gonna explode if i do.

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

#60478

On Friday, June 9, 2017 at 1:21:59 AM UTC-5, Julian Fondren wrote:
>   : permute-free ( addr u permute-state -- )
>     drop nip 1+ cells negate allot ;

An earlier version of PERMUTE-START included an extra cell.

This should be:

  : permute-free ( c-addr u permute-state -- )
    drop nip cells negate allot ;

A nice feature that some languages have is a way to run code depending
on how a library is loaded. Python can test __main__ I believe; Perl
can use caller() outside of a function. Usually the aim is for a file
to normally run as a script, as a standalone program, and to *not* do
that if loaded as a library, or into an interactive session.

It's interesting that these aren't 'first class' features in those
languages. Python doesn't have a builtin run_if_script: syntax;
instead people just know to write

  if __main__ == '__file__':

or something similar to that. Even though it's awkward and looks
hackish, it's so useful you'll see it frequently enough.

iForth has NESTING and this idiom:

  NESTING @ 1 = [IF]
    \ this is run only if you directly included the enclosing file
    \ nothing happens if another file includes this one
  [THEN]

Which allows me to add some tests to the above code that'll run if I
type 'include perms.fs', but not if some application loads it as a
library.

  nesting @ 1 = [IF]
    needs -ttester
  
    0 value orig-here
    align here to orig-here
    show-blahs
    T{ orig-here here = -> true }T
  [THEN]

This probably doesn't sound like a big deal. Obviously, you could just
have tests in another file, and load that when you want them. But if
you have the feature, you'll probably use it.

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

#60487

Op Thu, 8 Jun 2017 23:21:57 -0700 (PDT) schreef Julian Fondren:

> Hello clf,
> 
> The following thread on reddit /r/Forth may interest you. The poster
> has some difficulty with showing permutations in Forth, but powers
> through it, and then asks for feedback on his code. There's another
> implementation of the task among the replies.
> 
> https://www.reddit.com/r/Forth/comments/6fzpkd/applying_forths_principles_in_practice/
> 
> Here's mine:
> 
>   : third 2 pick ;
>   
>   : permute-start ( addr u -- addr u permute-state )
>     align here dup third cells dup allot erase ;
I don't like PICK at all. Why not
      align dup cells here swap allot erase
or
      aligh here over cells dup allot erase

groet Coos

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

#60507

On Friday, June 9, 2017 at 9:21:59 AM UTC+3, Julian Fondren wrote:
> Hello clf,
> 
> The following thread on reddit /r/Forth may interest you. The poster
> has some difficulty with showing permutations in Forth, but powers
> through it, and then asks for feedback on his code. There's another
> implementation of the task among the replies.
> 
> https://www.reddit.com/r/Forth/comments/6fzpkd/applying_forths_principles_in_practice/
> 
> Here's mine:
> 
>   : third 2 pick ;
>   
>   : permute-start ( addr u -- addr u permute-state )
>     align here dup third cells dup allot erase ;
>   
>   : permute-free ( addr u permute-state -- )
>     drop nip 1+ cells negate allot ;
>   
>   : switch ( a1 a2 -- )
>     over @ over @ swap rot ! swap ! ;
>   
>   : next-permute ( addr u permute-state -- addr u permute-state f )
>     over 0 do
>       dup i cells + @ i < if
>         i 2 mod 0= if
>           third dup i cells + switch
>         else
>           third dup i cells + swap
>           third i cells + @ cells + switch
>         then
>         1 over i cells + +!
>         true unloop exit
>       then
>     0 over i cells + ! loop false ( no more permutations ) ;
>   
>   create blah 1 , 2 , 3 , 4 , 5 ,
>   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
>   : show-blahs ( -- )
>     blah 5 permute-start
>     begin show next-permute 0= until permute-free ;
> 
> ALLOCATE and FREE variants of PERMUTE-START and PERMUTE-FREE could
> easily be supplied; NEXT-PERMUTE won't care either way. I don't really
> like all the repetitions of I CELLS + and at a glance the inner stack
> manipulation could probably be simplified by swapping ( addr u ) ahead
> of time. Another option: assume the caller has his own convenient
> access to the array -- as is actually the case above with BLAH -- and
> include ADDR U in the temporary array.
> 
> This is an implementation of the non-recursive version of Heap's
> algorithm, which is written as a self-contained function with an
> output(A) to supply the permutations. By taking an xt you could write
> a Forth word that more closely mirrors the pseudocode, but I like
> NEXT-PERMUTE as its own factor, since that lets you be a little bit
> more clever with the temporary array.
> 
> Another place to hold the 'temporary array' is in the actual array
> that you're generating permutations for, if you've bits to spare. You
> need at least enough to represent the length of the array. I can't
> think of use for that though... maybe if there's a lot of permutation
> done with DNA strings?
> 
> (Unrelatedly, I have now a 159-line definition in Forth. I may post
> about it later. After slaying the beast, of course.)

My take (GForth 0.7.3 tested):

\ Helper words
: r'@   ( S: -- a  R: a b -- a b)
        postpone 2R@  postpone drop ; immediate
: cell- ( n -- n-cell)  cell - ;
: exch  ( a a' -- )     dup @ -rot over @ swap ! ! ;

\ Vector words
: v@    ( a -- a+cell u )   dup cell+ swap @ ;
: ?+    ( a -- a+cell ) dup ? cell+ ;
: show  ( a -- )        v@ 0 DO ?+ LOOP drop cr ;

: permute  ( a N -- )
        dup 2 < IF drop cell- show EXIT THEN
        1- 2>r 0
        BEGIN   ( u R: a N-1)
                dup r@ <=
        WHILE
                2r@ recurse
                2r@ cells +
                r@ 1+ 2 mod
                IF over cells r'@ + ELSE r'@ THEN
                exch
                1+
        REPEAT
        drop 2RDROP
;

create Ar 5 ( cells count) ,  1 , 5 , 10 , 100 , 1000 ,
       Ar v@ permute .s bye


Have a nice day,
hum9

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

#60541

On Friday, June 9, 2017 at 8:03:49 PM UTC+3, hum9 wrote:
> On Friday, June 9, 2017 at 9:21:59 AM UTC+3, Julian Fondren wrote:
> > Hello clf,
> > 
> > The following thread on reddit /r/Forth may interest you. The poster
> > has some difficulty with showing permutations in Forth, but powers
> > through it, and then asks for feedback on his code. There's another
> > implementation of the task among the replies.
> > 
> > https://www.reddit.com/r/Forth/comments/6fzpkd/applying_forths_principles_in_practice/
> > 
> > Here's mine:
> > 
> >   : third 2 pick ;
> >   
> >   : permute-start ( addr u -- addr u permute-state )
> >     align here dup third cells dup allot erase ;
> >   
> >   : permute-free ( addr u permute-state -- )
> >     drop nip 1+ cells negate allot ;
> >   
> >   : switch ( a1 a2 -- )
> >     over @ over @ swap rot ! swap ! ;
> >   
> >   : next-permute ( addr u permute-state -- addr u permute-state f )
> >     over 0 do
> >       dup i cells + @ i < if
> >         i 2 mod 0= if
> >           third dup i cells + switch
> >         else
> >           third dup i cells + swap
> >           third i cells + @ cells + switch
> >         then
> >         1 over i cells + +!
> >         true unloop exit
> >       then
> >     0 over i cells + ! loop false ( no more permutations ) ;
> >   
> >   create blah 1 , 2 , 3 , 4 , 5 ,
> >   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
> >   : show-blahs ( -- )
> >     blah 5 permute-start
> >     begin show next-permute 0= until permute-free ;
> > 
> > ALLOCATE and FREE variants of PERMUTE-START and PERMUTE-FREE could
> > easily be supplied; NEXT-PERMUTE won't care either way. I don't really
> > like all the repetitions of I CELLS + and at a glance the inner stack
> > manipulation could probably be simplified by swapping ( addr u ) ahead
> > of time. Another option: assume the caller has his own convenient
> > access to the array -- as is actually the case above with BLAH -- and
> > include ADDR U in the temporary array.
> > 
> > This is an implementation of the non-recursive version of Heap's
> > algorithm, which is written as a self-contained function with an
> > output(A) to supply the permutations. By taking an xt you could write
> > a Forth word that more closely mirrors the pseudocode, but I like
> > NEXT-PERMUTE as its own factor, since that lets you be a little bit
> > more clever with the temporary array.
> > 
> > Another place to hold the 'temporary array' is in the actual array
> > that you're generating permutations for, if you've bits to spare. You
> > need at least enough to represent the length of the array. I can't
> > think of use for that though... maybe if there's a lot of permutation
> > done with DNA strings?
> > 
> > (Unrelatedly, I have now a 159-line definition in Forth. I may post
> > about it later. After slaying the beast, of course.)
> 
> My take (GForth 0.7.3 tested):
> 
> \ Helper words
> : r'@   ( S: -- a  R: a b -- a b)
>         postpone 2R@  postpone drop ; immediate
> : cell- ( n -- n-cell)  cell - ;
> : exch  ( a a' -- )     dup @ -rot over @ swap ! ! ;
> 
> \ Vector words
> : v@    ( a -- a+cell u )   dup cell+ swap @ ;
> : ?+    ( a -- a+cell ) dup ? cell+ ;
> : show  ( a -- )        v@ 0 DO ?+ LOOP drop cr ;
> 
> : permute  ( a N -- )
>         dup 2 < IF drop cell- show EXIT THEN
>         1- 2>r 0
>         BEGIN   ( u R: a N-1)
>                 dup r@ <=
>         WHILE
>                 2r@ recurse
>                 2r@ cells +
>                 r@ 1+ 2 mod
>                 IF over cells r'@ + ELSE r'@ THEN
>                 exch
>                 1+
>         REPEAT
>         drop 2RDROP
> ;
> 
> create Ar 5 ( cells count) ,  1 , 5 , 10 , 100 , 1000 ,
>        Ar v@ permute .s bye
> 
> 
> Have a nice day,
> hum9


Not needed '1+' on testing oddity for 'N-1':
>                 r@ 1+ 2 mod


hum9

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

#60551

On Friday, June 9, 2017 at 9:21:59 AM UTC+3, Julian Fondren wrote:
> Hello clf,
> 
> The following thread on reddit /r/Forth may interest you. The poster
> has some difficulty with showing permutations in Forth, but powers
> through it, and then asks for feedback on his code. There's another
> implementation of the task among the replies.
> 
> https://www.reddit.com/r/Forth/comments/6fzpkd/applying_forths_principles_in_practice/
> 
> Here's mine:
> 
>   : third 2 pick ;
>   
>   : permute-start ( addr u -- addr u permute-state )
>     align here dup third cells dup allot erase ;
>   
>   : permute-free ( addr u permute-state -- )
>     drop nip 1+ cells negate allot ;
>   
>   : switch ( a1 a2 -- )
>     over @ over @ swap rot ! swap ! ;
>   
>   : next-permute ( addr u permute-state -- addr u permute-state f )
>     over 0 do
>       dup i cells + @ i < if
>         i 2 mod 0= if
>           third dup i cells + switch
>         else
>           third dup i cells + swap
>           third i cells + @ cells + switch
>         then
>         1 over i cells + +!
>         true unloop exit
>       then
>     0 over i cells + ! loop false ( no more permutations ) ;
>   
>   create blah 1 , 2 , 3 , 4 , 5 ,
>   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
>   : show-blahs ( -- )
>     blah 5 permute-start
>     begin show next-permute 0= until permute-free ;
> 
> ALLOCATE and FREE variants of PERMUTE-START and PERMUTE-FREE could
> easily be supplied; NEXT-PERMUTE won't care either way. I don't really
> like all the repetitions of I CELLS + and at a glance the inner stack
> manipulation could probably be simplified by swapping ( addr u ) ahead
> of time. Another option: assume the caller has his own convenient
> access to the array -- as is actually the case above with BLAH -- and
> include ADDR U in the temporary array.
> 
> This is an implementation of the non-recursive version of Heap's
> algorithm, which is written as a self-contained function with an
> output(A) to supply the permutations. By taking an xt you could write
> a Forth word that more closely mirrors the pseudocode, but I like
> NEXT-PERMUTE as its own factor, since that lets you be a little bit
> more clever with the temporary array.
> 
> Another place to hold the 'temporary array' is in the actual array
> that you're generating permutations for, if you've bits to spare. You
> need at least enough to represent the length of the array. I can't
> think of use for that though... maybe if there's a lot of permutation
> done with DNA strings?
> 
> (Unrelatedly, I have now a 159-line definition in Forth. I may post
> about it later. After slaying the beast, of course.)

I modified a little your version. Looks that impediments to use return 
stack for temporary storage makes 'DO..LOOP' version more unreadable.

I don't like to much stack effects of 'permute-start' and 'permute-free':
they doesn't consume their parameters.

Presentation part I preserved mostly unchanged:


: r'@  postpone 2r@ postpone drop ; immediate

: perm-state ( u -- permute-state )
  align cells here dup rot dup allot erase ;
 
: state-free ( permute-state -- )
  HERE - allot ;

: switch  ( a a' -- )
  dup @ -rot over @ swap ! ! ;

: next-perm ( addr u permute-state -- addr u permute-state f )
  2>r 0
  BEGIN  ( A u  R:N P )
     dup r'@ <
  WHILE
     r@ over cells + @ over <
     IF ( A u  R:N P )
        2dup cells + >r
        dup 2 mod
	IF  ( A u  R:N P A[u] )
	   2dup cells r'@ + @ cells +
	ELSE
	   over
	THEN
	r> switch  ( A u  R:N P )
        1 over cells r@ + +!
	drop 2r> TRUE EXIT
     THEN
     0 over cells r@ + !
     1+
  REPEAT
  drop 2r> FALSE ;

  create blah 1 , 2 , 3 , 4 , 5 ,
  : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
  : show-blahs ( -- )
    blah 5 dup perm-state
    BEGIN show next-perm 0= UNTIL
    state-free 2drop ;

HERE show-blahs cr HERE swap - . .s cr bye


Have a nice day,
hum9

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

#60554

On Saturday, June 10, 2017 at 5:07:11 AM UTC-5, hum9 wrote:
> I modified a little your version. Looks that impediments to use return 
> stack for temporary storage makes 'DO..LOOP' version more unreadable.
> 
> I don't like to much stack effects of 'permute-start' and 'permute-free':
> they doesn't consume their parameters.

I've come to dislike that as well. But also of NEXT-PERMUTE

This NEXT-PERM is a lot busier than your last--I wonder if that's
due to the stack effect or due to the data structure.

> Presentation part I preserved mostly unchanged:
> 
> 
> : r'@  postpone 2r@ postpone drop ; immediate
> 
> : perm-state ( u -- permute-state )
>   align cells here dup rot dup allot erase ;
>  
> : state-free ( permute-state -- )
>   HERE - allot ;
> 
> : switch  ( a a' -- )
>   dup @ -rot over @ swap ! ! ;
> 
> : next-perm ( addr u permute-state -- addr u permute-state f )
>   2>r 0
>   BEGIN  ( A u  R:N P )
>      dup r'@ <
>   WHILE
>      r@ over cells + @ over <
>      IF ( A u  R:N P )
>         2dup cells + >r
>         dup 2 mod
> 	IF  ( A u  R:N P A[u] )
> 	   2dup cells r'@ + @ cells +
> 	ELSE
> 	   over
> 	THEN
> 	r> switch  ( A u  R:N P )
>         1 over cells r@ + +!
> 	drop 2r> TRUE EXIT
>      THEN
>      0 over cells r@ + !
>      1+
>   REPEAT
>   drop 2r> FALSE ;
> 
>   create blah 1 , 2 , 3 , 4 , 5 ,
>   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
>   : show-blahs ( -- )
>     blah 5 dup perm-state
>     BEGIN show next-perm 0= UNTIL
>     state-free 2drop ;
> 
> HERE show-blahs cr HERE swap - . .s cr bye
> 
> 
> Have a nice day,
> hum9

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

#60560

On 10.06.2017 15:41, Julian Fondren wrote:
> On Saturday, June 10, 2017 at 5:07:11 AM UTC-5, hum9 wrote:
>> I modified a little your version. Looks that impediments to use return
>> stack for temporary storage makes 'DO..LOOP' version more unreadable.
>>
>> I don't like to much stack effects of 'permute-start' and 'permute-free':
>> they doesn't consume their parameters.
> 
> I've come to dislike that as well. But also of NEXT-PERMUTE
> 
> This NEXT-PERM is a lot busier than your last--I wonder if that's
> due to the stack effect or due to the data structure.

Previous version, 'PERMUTE', is a recursive one. This version is derived
directly from your 'NEXT-PERMUTE', but using 'BEGIN WHILE REPEAT'. :)

I checked parameters usage, then distributed accordingly with priorities
between data stack and return stack.

Have a nice day,
hum9

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

#60634

On 6/9/2017, Julian Fondren wrote:

>  : third 2 pick ;
>   
>   : permute-start ( addr u -- addr u permute-state )
>     align here dup third cells dup allot erase ;
>   
>   : permute-free ( addr u permute-state -- )
>     drop nip 1+ cells negate allot ;
>   
>   : switch ( a1 a2 -- )
>     over @ over @ swap rot ! swap ! ;
>   
>   : next-permute ( addr u permute-state -- addr u permute-state f )
>     over 0 do
>       dup i cells + @ i < if
>         i 2 mod 0= if
>           third dup i cells + switch
>         else
>           third dup i cells + swap
>           third i cells + @ cells + switch
>         then
>         1 over i cells + +!
>         true unloop exit
>       then
>     0 over i cells + ! loop false ( no more permutations ) ;
>   
>   create blah 1 , 2 , 3 , 4 , 5 ,
>   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
>   : show-blahs ( -- )
>     blah 5 permute-start
>     begin show next-permute 0= until permute-free ;

OCaml:

let printv vec =
  Array.iter (fun n -> print_int n; print_string " ") vec;
  print_newline ();;

let swap i j v =
  let tmp = v.(i) in v.(i) <- v.(j) ; v.(j) <- tmp ;;

let rec gen_perm n func vec =
  if 1 = n then
    func vec
  else
  ( for i = 0 to (n - 2) do
      gen_perm (n-1) func vec ;
      swap (if (0 = (1 land n)) then i else 0) (n-1) vec ;
    done ;
    gen_perm (n-1) func vec );;

let perm_iter func vec = gen_perm (Array.length vec) func vec ;;

perm_iter printv [|2;3;4|];;

 ===>
2 3 4
3 2 4
4 2 3
2 4 3
3 4 2
4 3 2


let t = Sys.time () in
  perm_iter ignore [|2;3;4;5;6;7;8;9;10|];
  Sys.time() -. t ;;

 ===>
float = 0.125


3.475 /. 0.125 ;;

 ===>
float = 27.8

It's over 27 times as fast as your unposted Forth code!
On an old winXP laptop!


-- 
Jews totally run Hollywood....  But I don't care if Americans think we're
running the news media, Hollywood, Wall Street, or the government.  I just care
that we get to keep running them. --- Joel Stein
articles.latimes.com/2008/dec/19/opinion/oe-stein19
archive.org/download/DavidDukeTv/DoJewsControlTheMediaTheLaTimesSaysYes.flv

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

#60635

On 6/11/2017, Robert L. wrote:

> On 6/9/2017, Julian Fondren wrote:
> 
> >  : third 2 pick ;
> >   
> >   : permute-start ( addr u -- addr u permute-state )
> >     align here dup third cells dup allot erase ;
> >   
> >   : permute-free ( addr u permute-state -- )
> >     drop nip 1+ cells negate allot ;
> >   
> >   : switch ( a1 a2 -- )
> >     over @ over @ swap rot ! swap ! ;
> >   
> >   : next-permute ( addr u permute-state -- addr u permute-state f )
> >     over 0 do
> >       dup i cells + @ i < if
> >         i 2 mod 0= if
> >           third dup i cells + switch
> >         else
> >           third dup i cells + swap
> >           third i cells + @ cells + switch
> >         then
> >         1 over i cells + +!
> >         true unloop exit
> >       then
> >     0 over i cells + ! loop false ( no more permutations ) ;
> >   
> >   create blah 1 , 2 , 3 , 4 , 5 ,
> >   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
> >   : show-blahs ( -- )
> >     blah 5 permute-start
> >     begin show next-permute 0= until permute-free ;
> 
> OCaml:
> 
> let printv vec =
>   Array.iter (fun n -> print_int n; print_string " ") vec;
>   print_newline ();;
> 
> let swap i j v =
>   let tmp = v.(i) in v.(i) <- v.(j) ; v.(j) <- tmp ;;
> 
> let rec gen_perm n func vec =
>   if 1 = n then
>     func vec
>   else
>   ( for i = 0 to (n - 2) do
>       gen_perm (n-1) func vec ;
>       swap (if (0 = (1 land n)) then i else 0) (n-1) vec ;
>     done ;
>     gen_perm (n-1) func vec );;
> 
> let perm_iter func vec = gen_perm (Array.length vec) func vec ;;
> 
> perm_iter printv [|2;3;4|];;
> 
>  ===>
> 2 3 4
> 3 2 4
> 4 2 3
> 2 4 3
> 3 4 2
> 4 3 2
> 
> 
> let t = Sys.time () in
>   perm_iter ignore [|2;3;4;5;6;7;8;9;10|];
>   Sys.time() -. t ;;
> 
>  ===>
> float = 0.125
> 
> 
> 3.475 /. 0.125 ;;
> 
>  ===>
> float = 27.8
> 
> It's over 27 times as fast as your unposted Forth code!
> On an old winXP laptop!

Racket:

(define (swap i j v)
  (let ((tmp (vector-ref v i)))
    (vector-set! v i (vector-ref v j))
    (vector-set! v j tmp)))

(define (gen-perm n func vector)
  (cond ((= 1 n) (func vector))
        (else
          (for ((i (- n 1)))
            (gen-perm (- n 1) func vector)
            (swap (if (even? n) i 0) (- n 1) vector))
          (gen-perm (- n 1) func vector))))

(define (for-each-perm func vector)
  (gen-perm (vector-length vector) func vector))


> (for-each-perm displayln (vector 2 3 4))
#(2 3 4)
#(3 2 4)
#(4 2 3)
#(2 4 3)
#(3 4 2)
#(4 3 2)

> (time (for-each-perm (lambda(_) #f) (vector 2 3 4 5 6 7 8 9 10)))
cpu time: 109 real time: 109 gc time: 0

That's 109 milliseconds.

-- 
[A]n unholy alliance of leftists, capitalists, and Zionist supremacists has
schemed to promote immigration and miscegenation with the deliberate aim of
breeding us out of existence in our own homelands....  [T]he real aim stays the
same: the biggest genocide in human history....  --- Nick Griffin
(https://www.youtube.com/watch?v=K0hD7IffTJs)

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

#60638

On 6/11/2017, Robert L. wrote:

> On 6/11/2017, Robert L. wrote:
> 
> > On 6/9/2017, Julian Fondren wrote:
> > 
> > >  : third 2 pick ;
> > >   
> > >   : permute-start ( addr u -- addr u permute-state )
> > >     align here dup third cells dup allot erase ;
> > >   
> > >   : permute-free ( addr u permute-state -- )
> > >     drop nip 1+ cells negate allot ;
> > >   
> > >   : switch ( a1 a2 -- )
> > >     over @ over @ swap rot ! swap ! ;
> > >   
> > >   : next-permute ( addr u permute-state -- addr u permute-state f )
> > >     over 0 do
> > >       dup i cells + @ i < if
> > >         i 2 mod 0= if
> > >           third dup i cells + switch
> > >         else
> > >           third dup i cells + swap
> > >           third i cells + @ cells + switch
> > >         then
> > >         1 over i cells + +!
> > >         true unloop exit
> > >       then
> > >     0 over i cells + ! loop false ( no more permutations ) ;
> > >   
> > >   create blah 1 , 2 , 3 , 4 , 5 ,
> > >   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
> > >   : show-blahs ( -- )
> > >     blah 5 permute-start
> > >     begin show next-permute 0= until permute-free ;
> > 
> > OCaml:
> > 
> > let printv vec =
> >   Array.iter (fun n -> print_int n; print_string " ") vec;
> >   print_newline ();;
> > 
> > let swap i j v =
> >   let tmp = v.(i) in v.(i) <- v.(j) ; v.(j) <- tmp ;;
> > 
> > let rec gen_perm n func vec =
> >   if 1 = n then
> >     func vec
> >   else
> >   ( for i = 0 to (n - 2) do
> >       gen_perm (n-1) func vec ;
> >       swap (if (0 = (1 land n)) then i else 0) (n-1) vec ;
> >     done ;
> >     gen_perm (n-1) func vec );;
> > 
> > let perm_iter func vec = gen_perm (Array.length vec) func vec ;;
> > 
> > perm_iter printv [|2;3;4|];;
> > 
> >  ===>
> > 2 3 4
> > 3 2 4
> > 4 2 3
> > 2 4 3
> > 3 4 2
> > 4 3 2
> > 
> > 
> > let t = Sys.time () in
> >   perm_iter ignore [|2;3;4;5;6;7;8;9;10|];
> >   Sys.time() -. t ;;
> > 
> >  ===>
> > float = 0.125
> > 
> > 
> > 3.475 /. 0.125 ;;
> > 
> >  ===>
> > float = 27.8
> > 
> > It's over 27 times as fast as your unposted Forth code!
> > On an old winXP laptop!
> 
> Racket:
> 
> (define (swap i j v)
>   (let ((tmp (vector-ref v i)))
>     (vector-set! v i (vector-ref v j))
>     (vector-set! v j tmp)))
> 
> (define (gen-perm n func vector)
>   (cond ((= 1 n) (func vector))
>         (else
>           (for ((i (- n 1)))
>             (gen-perm (- n 1) func vector)
>             (swap (if (even? n) i 0) (- n 1) vector))
>           (gen-perm (- n 1) func vector))))
> 
> (define (for-each-perm func vector)
>   (gen-perm (vector-length vector) func vector))
> 
> 
> > (for-each-perm displayln (vector 2 3 4))
> #(2 3 4)
> #(3 2 4)
> #(4 2 3)
> #(2 4 3)
> #(3 4 2)
> #(4 3 2)
> 
> > (time (for-each-perm (lambda(_) #f) (vector 2 3 4 5 6 7 8 9 10)))
> cpu time: 109 real time: 109 gc time: 0
> 
> That's 109 milliseconds.

Using operators that handle only fixnums:


(require racket/unsafe/ops)

(define (gen-perm n func vector)
  (cond ((unsafe-fx= 1 n) (func vector))
        (else
          (for ((i (unsafe-fx- n 1)))
            (gen-perm (unsafe-fx- n 1) func vector)
            (swap (if (even? n) i 0) (unsafe-fx- n 1) vector))
          (gen-perm (unsafe-fx- n 1) func vector))))


> (time (for-each-perm (lambda(_) #f) (vector 2 3 4 5 6 7 8 9 10)))
cpu time: 78 real time: 78 gc time: 0

-- 
In Jerusalem, the United Nations (a truly United Nations) will build a Shrine
of the Prophets to serve the federated union of all continents; this will be
the seat of the Supreme Court of Mankind to settle all controversies among the
federated continents, as prophesied by Isaiah.
 --- David Ben Gurion (Look, 16 January 1962)

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

#60650

On 6/11/2017, Robert L. wrote:

> On 6/11/2017, Robert L. wrote:
> 
> > On 6/9/2017, Julian Fondren wrote:
> > 
> > >  : third 2 pick ;
> > >   
> > >   : permute-start ( addr u -- addr u permute-state )
> > >     align here dup third cells dup allot erase ;
> > >   
> > >   : permute-free ( addr u permute-state -- )
> > >     drop nip 1+ cells negate allot ;
> > >   
> > >   : switch ( a1 a2 -- )
> > >     over @ over @ swap rot ! swap ! ;
> > >   
> > >   : next-permute ( addr u permute-state -- addr u permute-state f )
> > >     over 0 do
> > >       dup i cells + @ i < if
> > >         i 2 mod 0= if
> > >           third dup i cells + switch
> > >         else
> > >           third dup i cells + swap
> > >           third i cells + @ cells + switch
> > >         then
> > >         1 over i cells + +!
> > >         true unloop exit
> > >       then
> > >     0 over i cells + ! loop false ( no more permutations ) ;
> > >   
> > >   create blah 1 , 2 , 3 , 4 , 5 ,
> > >   : show ( -- ) blah 5 cells bounds cr do i ? 1 cells +loop ;
> > >   : show-blahs ( -- )
> > >     blah 5 permute-start
> > >     begin show next-permute 0= until permute-free ;
> > 
> > OCaml:
> > 
> > let printv vec =
> >   Array.iter (fun n -> print_int n; print_string " ") vec;
> >   print_newline ();;
> > 
> > let swap i j v =
> >   let tmp = v.(i) in v.(i) <- v.(j) ; v.(j) <- tmp ;;
> > 
> > let rec gen_perm n func vec =
> >   if 1 = n then
> >     func vec
> >   else
> >   ( for i = 0 to (n - 2) do
> >       gen_perm (n-1) func vec ;
> >       swap (if (0 = (1 land n)) then i else 0) (n-1) vec ;
> >     done ;
> >     gen_perm (n-1) func vec );;
> > 
> > let perm_iter func vec = gen_perm (Array.length vec) func vec ;;
> > 
> > perm_iter printv [|2;3;4|];;
> > 
> >  ===>
> > 2 3 4
> > 3 2 4
> > 4 2 3
> > 2 4 3
> > 3 4 2
> > 4 3 2
> > 
> > 
> > let t = Sys.time () in
> >   perm_iter ignore [|2;3;4;5;6;7;8;9;10|];
> >   Sys.time() -. t ;;
> > 
> >  ===>
> > float = 0.125
> > 
> > 
> > 3.475 /. 0.125 ;;
> > 
> >  ===>
> > float = 27.8
> > 
> > It's over 27 times as fast as your unposted Forth code!
> > On an old winXP laptop!
> 
> Racket:
> 
> (define (swap i j v)
>   (let ((tmp (vector-ref v i)))
>     (vector-set! v i (vector-ref v j))
>     (vector-set! v j tmp)))
> 
> (define (gen-perm n func vector)
>   (cond ((= 1 n) (func vector))
>         (else
>           (for ((i (- n 1)))
>             (gen-perm (- n 1) func vector)
>             (swap (if (even? n) i 0) (- n 1) vector))
>           (gen-perm (- n 1) func vector))))
> 
> (define (for-each-perm func vector)
>   (gen-perm (vector-length vector) func vector))
> 
> 
> > (for-each-perm displayln (vector 2 3 4))
> #(2 3 4)
> #(3 2 4)
> #(4 2 3)
> #(2 4 3)
> #(3 4 2)
> #(4 3 2)
> 
> > (time (for-each-perm (lambda(_) #f) (vector 2 3 4 5 6 7 8 9 10)))
> cpu time: 109 real time: 109 gc time: 0
> 
> That's 109 milliseconds.

Chicken Scheme, permuting a larger vector.


;; Compile with
;; csc -O5 try.scm

(define (swap i j v)
  (let ((tmp (vector-ref v i)))
    (vector-set! v i (vector-ref v j))
    (vector-set! v j tmp)))

(define (gen-perm n func vector)
  (cond ((fx= 1 n) (func vector))
        (else
          (do ((i 0 (fx+ 1 i)))
              ((fx> i (fx- n 2)))
              (gen-perm (fx- n 1) func vector)
              (swap (if (fxodd? n) 0 i) (fx- n 1) vector))
          (gen-perm (fx- n 1) func vector))))


(define (vector-each-perm func vector)
  (gen-perm (vector-length vector) func vector))

(vector-each-perm print (vector 2 3 4))

(time (vector-each-perm (lambda(_) #f) #(1 2 3 4 5 6 7 8 9 10)))

=== output: ===

#(2 3 4)
#(3 2 4)
#(4 2 3)
#(2 4 3)
#(3 4 2)
#(4 3 2)
0.547s CPU time, 0.187s GC time (major)

-- 
It is extremely gratifying to ... achieve membership in an elite that is going
to make history....  The only drawback is that the self-appointed shepherds are
likely to find eventually that they were only sheepdogs and herded the flock
toward a destination of which they knew nothing.  --- R. P. Oliver

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

#60639

On Sunday, June 11, 2017 at 10:32:37 PM UTC-5, Robert L. wrote:
> let t = Sys.time () in
>   perm_iter ignore [|2;3;4;5;6;7;8;9;10|];
>   Sys.time() -. t ;;
> 
>  ===>
> float = 0.125
> 
> 
> 3.475 /. 0.125 ;;
> 
>  ===>
> float = 27.8
> 
> It's over 27 times as fast as your unposted Forth code!
> On an old winXP laptop!
>

And that doesn't fill you with any doubt?

When the point is only to compare cell vs. struct permutations, how
many permutations do you think my benchmark had? Obviously it had as
many as needed to make for good numbers. Lots of benchmarks would
conclude that "0 is as good as 0" otherwise.

On my machine:

  # let t = Sys.time () in
    perm_iter ignore [|2;3;4;5;6;7;8;9;10|];
    Sys.time() -. t ;;     
  - : float = 0.0672789999999999916

vs.

  : cell-bench ( n -- )
    cr ." cells: " timer-reset 0 do
      cell-array 10 permute-start begin next-permute 0= until permute-free
    loop .elapsed ;

  FORTH> 1 cell-bench
  cells: 0.073 seconds elapsed. ok

And then there's this:

  : 1bench ( -- )
    cr ." cells: " cell-array 10 permute-start timer-reset
      begin next-permute 0= until
    .elapsed permute-free ;
  : magic ( -- ) 100 0 do 1bench loop ;

  FORTH> magic
  cells: 0.078 seconds elapsed.
  cells: 0.034 seconds elapsed.
  cells: 0.033 seconds elapsed.
  cells: 0.033 seconds elapsed.
  cells: 0.033 seconds elapsed.
  cells: 0.033 seconds elapsed.

Similar O'Caml settles at 26ms.

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

#60640

On Sunday, June 11, 2017 at 11:14:34 PM UTC-5, Julian Fondren wrote:
> On Sunday, June 11, 2017 at 10:32:37 PM UTC-5, Robert L. wrote:
> > let t = Sys.time () in
> >   perm_iter ignore [|2;3;4;5;6;7;8;9;10|];
> >   Sys.time() -. t ;;

Oh I didn't notice that this was only a 9-element array.

  # let t = Sys.time () in for i = 1 to 100 do perm_iter ignore   [|2;3;4;5;6;7;8;9;10;11|]; done; Printf.printf "omg: %f\n" (Sys.time() -. t);;
  omg: 26.502621

  FORTH> 100 cell-bench 
  cells: 3.217 seconds elapsed. ok

So that's a 8x difference in speed in Forth's favor.

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

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

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

csiph-web