Merge branch 'master' of git://factorcode.org/git/factor

basis/images/tiff/tiff.factor

@@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io
 io.binary io.encodings.ascii io.encodings.binary
 io.encodings.string io.encodings.utf8 io.files kernel math
 math.bitwise math.order math.parser pack prettyprint sequences
-strings math.vectors ;
+strings math.vectors specialized-arrays.float ;
 IN: images.tiff
 
 TUPLE: tiff-image < image ;
@@ -343,6 +343,27 @@ ERROR: unknown-component-order ifd ;
         [ unknown-component-order ]
     } case ;
 
+: handle-alpha-data ( ifd -- ifd )
+    dup extra-samples find-tag {
+        { extra-samples-associated-alpha-data [
+            [
+                B{ } like dup
+                byte-array>float-array
+                4 <sliced-groups>
+                [
+                    dup fourth dup 0 = [
+                        2drop
+                    ] [
+                        [ 3 head-slice ] dip '[ _ / ] change-each
+                    ] if
+                ] each
+            ] change-bitmap
+        ] }
+        { extra-samples-unspecified-alpha-data [
+        ] }
+        [ bad-extra-samples ]
+    } case ;
+
 : ifd>image ( ifd -- image )
     {
         [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ]
@@ -364,6 +385,7 @@ ERROR: unknown-component-order ifd ;
                 strips>bitmap
                 fix-bitmap-endianness
                 strips-predictor
+                dup extra-samples tag? [ handle-alpha-data ] when
                 drop
             ] each
         ] with-endianness

basis/random/random-docs.factor

@@ -57,6 +57,13 @@ HELP: with-system-random
 
 { with-random with-secure-random with-system-random } related-words
 
+HELP: randomize
+{ $values
+     { "seq" sequence }
+     { "seq" sequence }
+}
+{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
+
 HELP: delete-random
 { $values
      { "seq" sequence }
@@ -83,6 +90,8 @@ $nl
 { $subsection with-secure-random }
 "Implementation:"
 { $subsection "random-protocol" }
+"Randomizing a sequence:"
+{ $subsection randomize }
 "Deleting a random element from a sequence:"
 { $subsection delete-random } ;
 

basis/random/random-tests.factor

@@ -1,5 +1,5 @@
 USING: random sequences tools.test kernel math math.functions
-sets ;
+sets grouping random.private ;
 IN: random.tests
 
 [ 4 ] [ 4 random-bytes length ] unit-test
@@ -17,3 +17,9 @@ IN: random.tests
 [ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test
 
 [ f ] [ 0 random ] unit-test
+
+[ { } ] [ { } randomize ] unit-test
+[ { 1 } ] [ { 1 } randomize ] unit-test
+
+[ f ]
+[ 100 [ { 0 1 } random ] replicate all-equal? ] unit-test

basis/random/random.factor

@@ -52,8 +52,10 @@ PRIVATE>
         [ length random-integer ] keep nth
     ] if-empty ;
 
-: randomize ( seq -- seq' )
-    dup length 1 (a,b] [ dup random pick exchange ] each ;
+: randomize ( seq -- seq )
+    dup length [ dup 1 > ]
+    [ [ random ] [ 1- ] bi [ pick exchange ] keep ]
+    [ ] while drop ;
 
 : delete-random ( seq -- elt )
     [ length random-integer ] keep [ nth ] 2keep delete-nth ;