Merge branch 'master' of git://factorcode.org/git/factor
commit
0b75ac768c
|
@ -1,8 +1,7 @@
|
||||||
! Copyright (C) 2008 Eric Mertens.
|
! Copyright (C) 2008 Eric Mertens.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays hints kernel locals math hashtables
|
USING: accessors arrays hints kernel locals math hashtables
|
||||||
assocs fry ;
|
assocs fry sequences ;
|
||||||
|
|
||||||
IN: disjoint-sets
|
IN: disjoint-sets
|
||||||
|
|
||||||
TUPLE: disjoint-set
|
TUPLE: disjoint-set
|
||||||
|
@ -65,6 +64,8 @@ M: disjoint-set add-atom
|
||||||
[ 1 -rot counts>> set-at ]
|
[ 1 -rot counts>> set-at ]
|
||||||
2tri ;
|
2tri ;
|
||||||
|
|
||||||
|
: add-atoms ( seq disjoint-set -- ) '[ , add-atom ] each ;
|
||||||
|
|
||||||
GENERIC: equiv-set-size ( a disjoint-set -- n )
|
GENERIC: equiv-set-size ( a disjoint-set -- n )
|
||||||
|
|
||||||
M: disjoint-set equiv-set-size [ representative ] keep count ;
|
M: disjoint-set equiv-set-size [ representative ] keep count ;
|
||||||
|
|
|
@ -10,6 +10,10 @@ tools.test kernel namespaces random math.ranges sequences fry ;
|
||||||
|
|
||||||
[ f ] [ "X" PH{ { "A" "B" } } at ] unit-test
|
[ f ] [ "X" PH{ { "A" "B" } } at ] unit-test
|
||||||
|
|
||||||
|
! We have to define these first so that they're compiled before
|
||||||
|
! the below hashtables are parsed...
|
||||||
|
<<
|
||||||
|
|
||||||
TUPLE: hash-0-a ;
|
TUPLE: hash-0-a ;
|
||||||
|
|
||||||
M: hash-0-a hashcode* 2drop 0 ;
|
M: hash-0-a hashcode* 2drop 0 ;
|
||||||
|
@ -18,6 +22,8 @@ TUPLE: hash-0-b ;
|
||||||
|
|
||||||
M: hash-0-b hashcode* 2drop 0 ;
|
M: hash-0-b hashcode* 2drop 0 ;
|
||||||
|
|
||||||
|
>>
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
PH{ }
|
PH{ }
|
||||||
"a" T{ hash-0-a } rot new-at
|
"a" T{ hash-0-a } rot new-at
|
||||||
|
|
|
@ -41,6 +41,13 @@ M: persistent-hash >alist [ root>> >alist% ] { } make ;
|
||||||
: >persistent-hash ( assoc -- phash )
|
: >persistent-hash ( assoc -- phash )
|
||||||
T{ persistent-hash } swap [ spin new-at ] assoc-each ;
|
T{ persistent-hash } swap [ spin new-at ] assoc-each ;
|
||||||
|
|
||||||
|
M: persistent-hash equal?
|
||||||
|
over persistent-hash? [ assoc= ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
M: persistent-hash hashcode* nip assoc-size ;
|
||||||
|
|
||||||
|
M: persistent-hash clone ;
|
||||||
|
|
||||||
: PH{ \ } [ >persistent-hash ] parse-literal ; parsing
|
: PH{ \ } [ >persistent-hash ] parse-literal ; parsing
|
||||||
|
|
||||||
M: persistent-hash pprint-delims drop \ PH{ \ } ;
|
M: persistent-hash pprint-delims drop \ PH{ \ } ;
|
||||||
|
|
|
@ -3,15 +3,21 @@ USING: help.markup help.syntax math sequences kernel ;
|
||||||
|
|
||||||
HELP: new-nth
|
HELP: new-nth
|
||||||
{ $values { "val" object } { "i" integer } { "seq" sequence } { "seq'" sequence } }
|
{ $values { "val" object } { "i" integer } { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." }
|
{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." } ;
|
||||||
{ $notes "This operation runs in " { $snippet "O(log_32 n)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ;
|
|
||||||
|
|
||||||
HELP: ppush
|
HELP: ppush
|
||||||
{ $values { "val" object } { "seq" sequence } { "seq'" sequence } }
|
{ $values { "val" object } { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." }
|
{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." } ;
|
||||||
{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ;
|
|
||||||
|
|
||||||
HELP: ppop
|
HELP: ppop
|
||||||
{ $values { "seq" sequence } { "seq'" sequence } }
|
{ $values { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." }
|
{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." } ;
|
||||||
{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ;
|
|
||||||
|
ARTICLE: "persistent.sequences" "Persistent sequence protocol"
|
||||||
|
"The persistent sequence protocol consists of the non-mutating sequence protocol words, such as " { $link length } " and " { $link nth } ", together with the following operations:"
|
||||||
|
{ $subsection new-nth }
|
||||||
|
{ $subsection ppush }
|
||||||
|
{ $subsection ppop }
|
||||||
|
"The default implementations of the above run in " { $snippet "O(n)" } " time; the " { $vocab-link "persistent.vectors" } " vocabulary provides an implementation of these operations in " { $snippet "O(1)" } " time." ;
|
||||||
|
|
||||||
|
ABOUT: "persistent.sequences"
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: help.markup help.syntax kernel math sequences ;
|
USING: help.markup help.syntax kernel math sequences ;
|
||||||
IN: persistent-vectors
|
IN: persistent.vectors
|
||||||
|
|
||||||
HELP: PV{
|
HELP: PV{
|
||||||
{ $syntax "elements... }" }
|
{ $syntax "elements... }" }
|
||||||
|
@ -12,17 +12,11 @@ HELP: >persistent-vector
|
||||||
HELP: persistent-vector
|
HELP: persistent-vector
|
||||||
{ $class-description "The class of persistent vectors." } ;
|
{ $class-description "The class of persistent vectors." } ;
|
||||||
|
|
||||||
ARTICLE: "persistent-vectors" "Persistent vectors"
|
ARTICLE: "persistent.vectors" "Persistent vectors"
|
||||||
"A " { $emphasis "persistent vector" } " differs from an ordinary vector (" { $link "vectors" } ") in that it is immutable, and all operations yield new persistent vectors instead of modifying inputs. Unlike immutable operations on ordinary sequences, persistent vector operations are efficient and run in sub-linear time."
|
"A " { $emphasis "persistent vector" } " differs from an ordinary vector (" { $link "vectors" } ") in that it is immutable, and all operations yield new persistent vectors instead of modifying inputs. Unlike immutable operations on ordinary sequences, persistent vector operations are efficient and run in sub-linear time."
|
||||||
$nl
|
$nl
|
||||||
"The class of persistent vectors:"
|
"The class of persistent vectors:"
|
||||||
{ $subsection persistent-vector }
|
{ $subsection persistent-vector }
|
||||||
"Persistent vectors support the immutable sequence protocol, namely as " { $link length } " and " { $link nth } ", and so can be used with most sequence words (" { $link "sequences" } ")."
|
|
||||||
$nl
|
|
||||||
"In addition to standard sequence operations, persistent vectors implement efficient operations specific to them. They run in sub-linear time on persistent vectors, and degrate to linear-time algorithms on ordinary sequences:"
|
|
||||||
{ $subsection new-nth }
|
|
||||||
{ $subsection ppush }
|
|
||||||
{ $subsection ppop }
|
|
||||||
"Converting a sequence into a persistent vector:"
|
"Converting a sequence into a persistent vector:"
|
||||||
{ $subsection >persistent-vector }
|
{ $subsection >persistent-vector }
|
||||||
"Persistent vectors have a literal syntax:"
|
"Persistent vectors have a literal syntax:"
|
||||||
|
@ -31,4 +25,4 @@ $nl
|
||||||
$nl
|
$nl
|
||||||
"This implementation of persistent vectors is based on the " { $snippet "clojure.lang.PersistentVector" } " class from Rich Hickey's Clojure language for the JVM (" { $url "http://clojure.org" } ")." ;
|
"This implementation of persistent vectors is based on the " { $snippet "clojure.lang.PersistentVector" } " class from Rich Hickey's Clojure language for the JVM (" { $url "http://clojure.org" } ")." ;
|
||||||
|
|
||||||
ABOUT: "persistent-vectors"
|
ABOUT: "persistent.vectors"
|
||||||
|
|
|
@ -199,14 +199,11 @@ M: radio-control model-changed
|
||||||
: <radio-button> ( value model label -- gadget )
|
: <radio-button> ( value model label -- gadget )
|
||||||
<radio-knob> label-on-right radio-button-theme <radio-control> ;
|
<radio-knob> label-on-right radio-button-theme <radio-control> ;
|
||||||
|
|
||||||
: radio-buttons-theme ( gadget -- )
|
|
||||||
{ 5 5 } >>gap drop ;
|
|
||||||
|
|
||||||
: <radio-buttons> ( model assoc -- gadget )
|
: <radio-buttons> ( model assoc -- gadget )
|
||||||
<filled-pile>
|
<filled-pile>
|
||||||
-rot
|
-rot
|
||||||
[ <radio-button> ] <radio-controls>
|
[ <radio-button> ] <radio-controls>
|
||||||
dup radio-buttons-theme ;
|
{ 5 5 } >>gap ;
|
||||||
|
|
||||||
: <toggle-button> ( value model label -- gadget )
|
: <toggle-button> ( value model label -- gadget )
|
||||||
<radio-control> bevel-button-theme ;
|
<radio-control> bevel-button-theme ;
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue