mirror of
https://github.com/edeproject/ede.git
synced 2023-08-10 21:13:03 +03:00
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:
parent
a21f17fc1f
commit
e19d0e46d5
@ -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
|
||||||
|
@ -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
|
||||||
;;
|
;;
|
||||||
|
@ -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 ;
|
||||||
|
@ -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
|
||||||
|
@ -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));
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user