From e19d0e46d50f08f1d9d0ca1fcdad793d677b1413 Mon Sep 17 00:00:00 2001
From: Sanel Zukan <karijes@users.sf.net>
Date: Thu, 30 Oct 2008 15:24:19 +0000
Subject: [PATCH] Replaced random-next with C version, which yields a much
 better random number generator. Added shuffle-vector! for inplace random
 shuffling in a vector

---
 tools/capone/lib/capone.init | 11 -----------
 tools/capone/lib/common.ss   | 18 ++++++++++++++++--
 tools/capone/src/Jamfile     |  8 ++++----
 tools/capone/src/bbb.ss      |  2 +-
 tools/capone/src/sys.cpp     | 19 +++++++++++++++++++
 5 files changed, 40 insertions(+), 18 deletions(-)

diff --git a/tools/capone/lib/capone.init b/tools/capone/lib/capone.init
index 7059578..9cb9737 100644
--- a/tools/capone/lib/capone.init
+++ b/tools/capone/lib/capone.init
@@ -541,17 +541,6 @@
                          (set-output-port prev-outport)
                          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 
 ;; COND-EXPAND
 ;; Implemented as a macro
diff --git a/tools/capone/lib/common.ss b/tools/capone/lib/common.ss
index a4ff656..76a91d9 100644
--- a/tools/capone/lib/common.ss
+++ b/tools/capone/lib/common.ss
@@ -5,7 +5,7 @@
 (define first car)
 (define rest  cdr)
 
-;; inc/dec familly
+;; inc/dec family
 (define (inc n)
  (+ 1 n))
 
@@ -101,10 +101,24 @@
 ;;
 ;; iota function; returns a list of numbers
 ;;
-
 (define (iota 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
 ;;
diff --git a/tools/capone/src/Jamfile b/tools/capone/src/Jamfile
index 1b39d25..c0f7d5d 100644
--- a/tools/capone/src/Jamfile
+++ b/tools/capone/src/Jamfile
@@ -17,12 +17,12 @@ Library $(SUBDIR)/pcre/libpcre : $(PCRE_SRC) ;
 SCHEME_SRC = scheme.c dynload.c ;
 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 ;
-#ObjectCcFlags $(SCARAB_SRC) : -g3 -pg ;
+#ObjectC++Flags $(CAPONE_SRC) : -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 ;
 
 #LINKFLAGS on capone = [ on capone return $(LINKFLAGS) ] -pg ;
diff --git a/tools/capone/src/bbb.ss b/tools/capone/src/bbb.ss
index 34ab68f..6c6030b 100644
--- a/tools/capone/src/bbb.ss
+++ b/tools/capone/src/bbb.ss
@@ -21,7 +21,7 @@
 	      (map-more (cdr lst)
 		            (map3 cdr more)))))))
 
-(define lst (iota 9000))
+(define lst (iota 3000))
 
 (print "Working my map... ")
 ;; my map
diff --git a/tools/capone/src/sys.cpp b/tools/capone/src/sys.cpp
index b379ac4..4bdc19f 100644
--- a/tools/capone/src/sys.cpp
+++ b/tools/capone/src/sys.cpp
@@ -2,6 +2,7 @@
 #include <string.h>
 #include <stdlib.h>
 #include <time.h>
+
 #include <edelib/Missing.h>
 
 extern "C" {
@@ -69,6 +70,18 @@ static pointer s_clock(scheme* sc, pointer args) {
 	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) {
 	sc->vptr->scheme_define(
 		sc,
@@ -87,4 +100,10 @@ void register_sys_functions(scheme* sc) {
 		sc->global_env,
 		sc->vptr->mk_symbol(sc, "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));
 }