Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

random: implement random for assocs.

  • Loading branch information...
commit 9c41cef04b3f5b4a8763f0b02e97676cd361fff3 1 parent 8ff5d1c
@mrjbq7 mrjbq7 authored
Showing with 14 additions and 4 deletions.
  1. +14 −4 basis/random/random.factor
View
18 basis/random/random.factor
@@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.data arrays assocs
byte-arrays byte-vectors combinators combinators.short-circuit
-fry io.backend io.binary kernel locals math math.bitwise
-math.constants math.functions math.order math.ranges namespaces
-sequences sequences.private sets summary system vocabs hints
-typed ;
+fry hashtables hashtables.private hints io.backend io.binary
+kernel locals math math.bitwise math.constants math.functions
+math.order math.ranges namespaces sequences sequences.private
+sets summary system typed vocabs ;
IN: random
SYMBOL: system-random-generator
@@ -72,6 +72,16 @@ M: sequence random
[ length random-integer ] keep nth
] if-empty ;
+M: assoc random >alist random ;
+
+M: hashtable random
+ dup assoc-size [ drop f ] [
+ [ 0 ] [ array>> ] [ random ] tri* 1 + [
+ [ 2dup array-nth tombstone? [ 2 + ] 2dip ] loop
+ ] times [ 2 - ] dip
+ [ array-nth ] [ [ 1 + ] dip array-nth ] 2bi 2array
+ ] if-zero ;
+
: randomize-n-last ( seq n -- seq )
[ dup length dup ] dip - 1 max '[ dup _ > ]
[ [ random ] [ 1 - ] bi [ pick exchange-unsafe ] keep ]
Please sign in to comment.
Something went wrong with that request. Please try again.