libs/topology/laplacian.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays hashtables hopf kernel math matrices namespaces
   4 sequences topology ;
   5 IN: laplacian
   6
   7 : ((i)) ( x y -- i_y[x] )
   8     1 swap associate boundaries set d ;
   9
  10 : (i) ( x y -- i_y[x] )
  11     [ <reversed> [ ((i)) ] each ] with-scope ;
  12
  13 : i ( x y -- i_y[x] )
  14     #! Adjoint of left multiplication by y
  15     [ >h ] 2apply [ dupd concat (i) ] linear-op nip ;
  16
  17 SYMBOL: top-class
  18
  19 : set-generators ( seq -- )
  20     natural-sort
  21     dup generators set
  22     1 [ h* ] reduce top-class set ;
  23
  24 : star ( x -- *x )
  25     #! Hodge star involution
  26     top-class get swap i ;
  27
  28 : <,>* ( a b -- n )
  29     #! Hodge inner product
  30     star h* star co1 ;
  31
  32 : (d*) ( x -- d*[x] )
  33     [ length 1+ generators get length * 1+ -1^ ] keep
  34     star d star h* ;
  35
  36 : d* ( x -- d*[x] )
  37     #! Adjoint of the differential
  38     >h [ concat (d*) ] linear-op ;
  39
  40 : [,] ( x y -- z )
  41     #! Lie bracket
  42     h* d* ;
  43
  44 : L ( z -- Lz )
  45     #! Laplacian.
  46     [ d d* ] keep d* d l+ ;
  47
  48 : L-matrix ( basis -- matrix )
  49     dup [ concat L ] op-matrix ;
  50
  51 : cohomology ( -- seq )
  52     generators get basis [ L-matrix null/rank drop ] map ;