Paste number 17840: | n-connectedness algorithm |
Pasted by: | slava |
When: | 13 years, 8 months ago |
Share: | Tweet this! | http://paste.lisp.org/+DRK |
Channel: | #concatenative |
Paste contents: |
IN: homology USING: hashtables io kernel math namespaces prettyprint sequences test ; : symmetric-diff ( hash hash -- hash ) clone swap [ drop dup pick hash [ over remove-hash ] [ dup pick set-hash ] if ] hash-each ; : S{ [ [ dup ] map>hash ] [ ] ; parsing : remove-1 ( n seq -- seq ) >r { } swap dup 1+ r> replace-slice ; : (boundary) ( seq -- chain ) dup length 1 <= [ H{ } ] [ dup length [ over remove-1 dup ] map>hash ] if nip ; : boundary ( chain -- chain ) hash-keys H{ } [ (boundary) symmetric-diff ] reduce ; : bit? ( n x -- ? ) >r 1 swap shift r> bitand 0 > ; : (power-set) ( n simplices -- seq ) [ dup length [ pick bit? [ dup set ] [ drop ] if ] 2each drop ] make-hash ; : power-set ( simplices -- chains ) 1 over length shift [ swap (power-set) ] map-with ; : boundaries ( chain-complex -- chain-complex ) [ 1 swap tail-slice [ [ boundary dup ] map>hash , ] each S{ S{ } } , ] { } make ; : cycles ( chain-complex -- chain-complex ) [ [ boundary hash-empty? ] subset ] map ; : class-of ( kernel chain chains -- chains ) [ >r 2dup r> symmetric-diff swap hash-member? ] subset 2nip ; : quotient ( kernel chains -- quotient ) dup [ >r 2dup r> swap class-of dup ] map>hash 2nip ; : homology ( simplices -- homology ) [ power-set ] map dup boundaries swap cycles [ quotient ] 2map ; : quotient. ( quotient -- ) hash-keys dup length [ " + Equivalence class #" write number>string print [ " " write hash-keys . ] each terpri ] 2each ; : chains. ( chain-complex -- ) dup length [ number>string write "-dimensional holes: " write hash-size log2 number>string print ] 2each ; : homology. " --> " write dup . homology chains. ; terpri "0-dimensional holes correspond to connected components." print "A path connected space has exactly one component (0-dimensional hole)." print "A 1-connected space is path connected and has no holes of dimension 1." print "A contractible space is path connected, and has no holes of dimension 1 and higher." print terpri terpri "==== One-point space - contractable:" print { { { 1 } } } homology. terpri terpri "==== Two-point space (0-sphere) - not path connected, so not contractible:" print { { { 1 } { 2 } } } homology. terpri terpri "==== Unit interval (1-disc) - contractible:" print { { { 1 } { 2 } } { { 1 2 } } } homology. terpri terpri "==== 1-sphere - not 1-connected, so not contractible:" print { { { 1 } { 2 } { 3 } } { { 1 2 } { 2 3 } { 1 3 } } } homology. terpri terpri "==== 1-disc - contractible:" print { { { 1 } { 2 } { 3 } } { { 1 2 } { 1 2 } { 1 3 } } { { 1 2 3 } } } homology. terpri terpri "==== 2-sphere - 1-connected but not contractible:" print { { { 1 } { 2 } { 3 } { 4 } } { { 1 2 } { 1 3 } { 1 4 } { 2 3 } { 2 4 } { 3 4 } } { { 1 2 3 } { 1 2 4 } { 2 3 4 } { 1 3 4 } } } homology. terpri terpri "==== 2-disc - contractible:" print { { { 1 } { 2 } { 3 } { 4 } } { { 1 2 } { 1 3 } { 1 4 } { 2 3 } { 2 4 } { 3 4 } } { { 1 2 3 } { 1 2 4 } { 2 3 4 } { 1 3 4 } } { { 1 2 3 4 } } } homology.
This paste has no annotations.