Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #60635
| From | "Robert L." <No_spamming@noWhere_7073.org> |
|---|---|
| Newsgroups | comp.lang.forth |
| Subject | Re: Heap's algorithm |
| Date | 2017-06-12 03:35 +0000 |
| Organization | Aioe.org NNTP Server |
| Message-ID | <ohl25c$aqg$1@gioia.aioe.org> (permalink) |
| References | <069c58c6-434c-4dc3-b365-8e3b70bc3d05@googlegroups.com> <ohl20i$anh$1@gioia.aioe.org> |
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)
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