module TBit.Hamiltonian.Builder.Decompactification ( decompactify
                                                   ) where

import TBit.Types
import TBit.Hamiltonian.Builder.PrimitiveLattice
import Data.Graph.Inductive
import Control.Monad.State (modify)

{-|
    Perform so-called "truncated decompactification" on a 'CellGraph'.

    Since the neighbor-data is stored in a unit-cell-level graph, it's in a
    sense "compact", i.e. it's a local periodic structure instead of an
    extended (to infinity) structure. Truncated decompactification sends the
    periodic structure (on T^2, roughly speaking) back to something of
    infinite extent (i.e. the integers), but then truncates the result to keep
    only a finite subset (i.e. the ribbon-width).

    It may not be clear /a priori/ how to choose the edge you want to
    'decompactify' on to get the desired edge configuration; for honeycomb, 
    you can show on paper that decompactifying on a single graph edge (there
    are three, corresponding to the three nearest neighbors of a site) gives
    you zig-zag edge, while decompactifying on two graph edges gives you
    an armchair configuration. The square lattice is even more straightforward.
-}
decompactify :: Int 
             -> LEdge Displacement 
             -> CellGraph 
             -> Parameterizable CellGraph
decompactify n (v1,v2,d) gr = 
    do recordDecomEdges new
       setPrimLattice ret 
       return ret
    where g   = replicateG n gr
          --les'= (replicateE n (noNodes gr)) (v1,v2,d)
          les'= concatMap (replicateE n (noNodes gr)) 
              $ filter (\(u,v,e) -> e == d) $ labEdges gr
          les = les' +++ map (\(x,y,r) -> (y,x,negate r)) les'
          new = filter (\(u,v,d) -> gelem u g && gelem v g) 
              $ map boost les
          ret = insEdges new $ delLEdges les g
          boost (u,v,e) = if   e == d
                          then (u, v + noNodes gr, e)
                          else (u + noNodes gr, v, e)
{-
decompactify' :: Int 
             -> [LEdge Displacement]
             -> CellGraph 
             -> Parameterizable CellGraph
decompactify' n es gr = 
    do recordDecomEdges new
       setPrimLattice ret 
       return ret
    where g   = replicateG n gr
          --les'= (replicateE n (noNodes gr)) (v1,v2,d)
          les'= concatMap (replicateE n (noNodes gr)) 
              $ filter (\(u,v,e) -> e == d) $ labEdges gr
          les = les' +++ map (\(x,y,r) -> (y,x,negate r)) les'
          new = filter (\(u,v,d) -> gelem u g && gelem v g) 
              $ map boost les
          ret = insEdges new $ delLEdges les g
          boost (u,v,e) = if   e == d
                          then (u, v + noNodes gr, e)
                          else (u + noNodes gr, v, e)
-}
recordDecomEdges :: [LEdge Displacement] -> Parameterizable ()
recordDecomEdges es = modify (\ps -> ps { decomData = es ++ decomData ps })

(+++) :: [a] -> [a] -> [a]
(+++) [] [] = []
(+++) as [] = as
(+++) [] as = as
(+++) as bs = head as : (bs +++ tail as)