Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #60650
| From | "Robert L." <No_spamming@noWhere_7073.org> |
|---|---|
| Newsgroups | comp.lang.forth |
| Subject | Re: Heap's algorithm |
| Date | 2017-06-12 11:01 +0000 |
| Organization | Aioe.org NNTP Server |
| Message-ID | <ohlsam$1jns$1@gioia.aioe.org> (permalink) |
| References | <069c58c6-434c-4dc3-b365-8e3b70bc3d05@googlegroups.com> <ohl20i$anh$1@gioia.aioe.org> <ohl25c$aqg$1@gioia.aioe.org> |
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
Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread
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
csiph-web