Replaced random-next with C version, which yields a much better random number generator.

Added shuffle-vector! for inplace random shuffling in a vector
This commit is contained in:
Sanel Zukan 2008-10-30 15:24:19 +00:00
parent a21f17fc1f
commit e19d0e46d5
5 changed files with 40 additions and 18 deletions

View File

@ -541,17 +541,6 @@
(set-output-port prev-outport) (set-output-port prev-outport)
res))))) res)))))
; Random number generator (maximum cycle)
(define *seed* 1)
(define (random-next)
(let* ((a 16807) (m 2147483647) (q (quotient m a)) (r (modulo m a)))
(set! *seed*
(- (* a (- *seed*
(* (quotient *seed* q) q)))
(* (quotient *seed* q) r)))
(if (< *seed* 0) (set! *seed* (+ *seed* m)))
*seed*))
;; SRFI-0 ;; SRFI-0
;; COND-EXPAND ;; COND-EXPAND
;; Implemented as a macro ;; Implemented as a macro

View File

@ -5,7 +5,7 @@
(define first car) (define first car)
(define rest cdr) (define rest cdr)
;; inc/dec familly ;; inc/dec family
(define (inc n) (define (inc n)
(+ 1 n)) (+ 1 n))
@ -101,10 +101,24 @@
;; ;;
;; iota function; returns a list of numbers ;; iota function; returns a list of numbers
;; ;;
(define (iota n) (define (iota n)
(range 0 n)) (range 0 n))
;;
;; Inplace vector shuffle via Fisher-Yates algorithm
;;
(define (shuffle-vector! v)
(let ((i (vector-length v))
(k 0)
(tmp 0))
(while (> i 1)
(set! k (modulo (random-next) i))
(dec! i)
(set! tmp (vector-ref v i))
(vector-set! v i (vector-ref v k))
(vector-set! v k tmp)
)))
;; ;;
;; function for easier timing ;; function for easier timing
;; ;;

View File

@ -17,12 +17,12 @@ Library $(SUBDIR)/pcre/libpcre : $(PCRE_SRC) ;
SCHEME_SRC = scheme.c dynload.c ; SCHEME_SRC = scheme.c dynload.c ;
ObjectCcFlags $(SCHEME_SRC) : -DUSE_STRLWR=1 -DUSE_DL=1 -DUSE_MATH=1 -DUSE_ASCII_NAMES=0 -DINLINE=inline ; ObjectCcFlags $(SCHEME_SRC) : -DUSE_STRLWR=1 -DUSE_DL=1 -DUSE_MATH=1 -DUSE_ASCII_NAMES=0 -DINLINE=inline ;
SCARAB_SRC = capone.cpp $(SCHEME_SRC) dbus.cpp re.cpp sys.cpp ; CAPONE_SRC = capone.cpp $(SCHEME_SRC) dbus.cpp re.cpp sys.cpp ;
#ObjectC++Flags $(SCARAB_SRC) : -pg ; #ObjectC++Flags $(CAPONE_SRC) : -pg ;
#ObjectCcFlags $(SCARAB_SRC) : -g3 -pg ; #ObjectCcFlags $(CAPONE_SRC) : -g3 -pg ;
EdeProgram capone : $(SCARAB_SRC) ; EdeProgram capone : $(CAPONE_SRC) ;
LinkAgainst capone : -Lpcre -lpcre -ledelib_dbus -ldbus-1 -ledelib -lfltk -ldl -lm -lXext -lXft -lX11 ; LinkAgainst capone : -Lpcre -lpcre -ledelib_dbus -ldbus-1 -ledelib -lfltk -ldl -lm -lXext -lXft -lX11 ;
#LINKFLAGS on capone = [ on capone return $(LINKFLAGS) ] -pg ; #LINKFLAGS on capone = [ on capone return $(LINKFLAGS) ] -pg ;

View File

@ -21,7 +21,7 @@
(map-more (cdr lst) (map-more (cdr lst)
(map3 cdr more))))))) (map3 cdr more)))))))
(define lst (iota 9000)) (define lst (iota 3000))
(print "Working my map... ") (print "Working my map... ")
;; my map ;; my map

View File

@ -2,6 +2,7 @@
#include <string.h> #include <string.h>
#include <stdlib.h> #include <stdlib.h>
#include <time.h> #include <time.h>
#include <edelib/Missing.h> #include <edelib/Missing.h>
extern "C" { extern "C" {
@ -69,6 +70,18 @@ static pointer s_clock(scheme* sc, pointer args) {
return mk_real(sc, (double)clock()); return mk_real(sc, (double)clock());
} }
/* originaly 'random-next' sucked badly so this is, hopefully, a better replacement */
static int seed_inited = 0;
static pointer s_random_next(scheme* sc, pointer args) {
if(!seed_inited) {
srand(time(0));
seed_inited = 1;
}
return mk_integer(sc, rand());
}
void register_sys_functions(scheme* sc) { void register_sys_functions(scheme* sc) {
sc->vptr->scheme_define( sc->vptr->scheme_define(
sc, sc,
@ -87,4 +100,10 @@ void register_sys_functions(scheme* sc) {
sc->global_env, sc->global_env,
sc->vptr->mk_symbol(sc, "clock"), sc->vptr->mk_symbol(sc, "clock"),
sc->vptr->mk_foreign_func(sc, s_clock)); sc->vptr->mk_foreign_func(sc, s_clock));
sc->vptr->scheme_define(
sc,
sc->global_env,
sc->vptr->mk_symbol(sc, "random-next"),
sc->vptr->mk_foreign_func(sc, s_random_next));
} }