Permalink
Browse files

Minor update

  • Loading branch information...
1 parent 80b3637 commit e624bb4700c436911bd08af9aff9ced57c8b40bd nineties committed Mar 21, 2013
Showing with 69 additions and 4 deletions.
  1. +19 −1 lib/std/random.ab
  2. +43 −1 rowl1/rowl1-array.rlc
  3. +7 −2 rowl1/rowl1-random.rlc
View
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: random.ab 2013-03-20 12:18:02 nineties $
+# $Id: random.ab 2013-03-21 19:34:16 nineties $
module Std {
module impl {
@@ -32,4 +32,22 @@ module Std {
# Shuffle `seq' randomly by Fisher-Yates's algorithm.
shuffle(seq): impl::fisher_yates(copy(seq), seq.size)
shuffle(seq@List): to_list(impl::fisher_yates(to_array(seq), seq.size))
+
+ # Distributions
+ uniform_distribution(n): make UniformDistribution{ n }
+ discrete_distribution(seq): {
+ seq = seq.to_array
+ make DiscreteDistribution{ seq.to_array, seq.sum }
+ }
+
+ rand(UniformDistrib{n}): rand(n)
+ rand(DiscreteDistrib{ws, total}): {
+ w: 0
+ r: rand(total)
+ for (i in 0..ws.size-1) {
+ w += ws[i]
+ if (r < w)
+ return i
+ }
+ }
}
View
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2012 nineties
;
-; $Id: rowl1-array.rlc 2013-03-20 12:16:48 nineties $
+; $Id: rowl1-array.rlc 2013-03-21 19:54:16 nineties $
;
(import "rlvm-compile")
@@ -167,6 +167,43 @@
(return (variant @ArrayE 1 buf size size))
))
+(fun ary_reverse (ary) (
+ (var size (field_get ary 2))
+ (var buf (field_get ary 1))
+ (var rev (allocate_array size))
+ (for i 0 size (do
+ (array_set object rev (- (- size i) 1) (array_get object buf i))
+ ))
+ (return (variant @ArrayE 1 rev size size))
+ ))
+
+(fun ary_append (ary1 ary2) (
+ (var size1 (field_get ary1 2))
+ (var buf1 (field_get ary1 1))
+ (var size2 (field_get ary2 2))
+ (var buf2 (field_get ary2 1))
+ (var new_size (+ size1 size2))
+ (var new (allocate_array new_size))
+ (for i 0 size1 (do
+ (array_set object new i (array_get object buf1 i))
+ ))
+ (for i 0 size2 (do
+ (array_set object new (+ i size1) (array_get object buf2 i))
+ ))
+ (return (variant @ArrayE 1 new new_size new_size))
+ ))
+
+(fun ary_map (f ary) (
+ (var size (field_get ary 2))
+ (var buf (field_get ary 1))
+ (var new (allocate_array size))
+ (var code (get_bytecode f))
+ (for i 0 size (do
+ (array_set object new i (byterun code (array_get object buf i)))
+ ))
+ (return (variant @ArrayE 1 new size size))
+ ))
+
(export fun setup_array (std) (
(var ModArray (create_module std (to_sym "Array")))
(var ModList (create_module std (to_sym "List")))
@@ -183,6 +220,11 @@
(add_function3 std (to_sym "store") arrayT intT DontCare ary_store 0)
(add_function2 std (to_sym "push") arrayT DontCare ary_push 0)
+ (add_function1 std (to_sym "reverse") arrayT ary_reverse 0)
+ (add_function2 std (to_sym "append") arrayT arrayT ary_append 0)
+ (add_function2 std (to_sym "map") funT arrayT ary_map 0)
+ (
+
))
))
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-random.rlc 2013-03-16 23:09:10 nineties $
+; $Id: rowl1-random.rlc 2013-03-21 19:31:20 nineties $
;
(import "rlvm-compile")
@@ -90,7 +90,11 @@
(return x)
))
-(fun randr_int (lopen ropen min max) (do
+(fun randf2 (x) (
+ (return (randr_float @FALSE @TRUE (itof 0) x))
+ ))
+
+(fun randr_int (lopen ropen min max) (
(if lopen (= min (add min (box 1))))
(if ropen (= max (sub max (box 1))))
(var width (add (sub max min) (box 1)))
@@ -164,6 +168,7 @@
(add_function0 std (to_sym "rand") randf 0)
(add_function1 std (to_sym "rand") intT randi 0)
(add_function1 std (to_sym "rand") bintT randbi 0)
+ (add_function1 std (to_sym "rand") floatT randf2 0)
(add_function1 std (to_sym "rand") (domainP Range) randr 0)
))

0 comments on commit e624bb4

Please sign in to comment.