0 | ||| This module containes the logic for properly placing double bonds, especiall
  1 | ||| the pi-part of those bonds. We use a simple heuristic to place the pi-bond:
  2 | |||
  3 | ||| In case of a double bond with three substituents, the pi bond will be placed
  4 | ||| on the same side of the sigma bond as the lone substituent.
  5 | |||
  6 | ||| In case of a double bond with four substituents, the dominant cycle
  7 | ||| (if any; see below) will be determined, and the pi-bond will be placed
  8 | ||| within that cycle.
  9 | |||
 10 | ||| In all other cases, a symmetric double with both lines being displaced
 11 | ||| from the center by the same amount of space, will be displayed.
 12 | |||
 13 | ||| In order to define the dominant cycle to which a double bond belongs,
 14 | ||| rings will be sorted by number of multiple bonds and then by ring size.
 15 | ||| Six membered rings will always be preferred over other ring sizes.
 16 | module CyBy.Draw.Internal.DoubleBond
 17 |
 18 | import Derive.Prelude
 19 | import Data.Graph.Indexed.Query.BFS
 20 | import CyBy.Draw.Internal.Atom
 21 | import CyBy.Draw.Internal.CoreDims
 22 | import CyBy.Draw.Internal.Graph
 23 | import CyBy.Draw.Internal.Label
 24 | import Geom
 25 | import Text.Molfile
 26 |
 27 | %default total
 28 | %language ElabReflection
 29 |
 30 | --------------------------------------------------------------------------------
 31 | -- Rings
 32 | --------------------------------------------------------------------------------
 33 |
 34 | -- A data type for sorting rings by number of double- and triple bonds and by
 35 | -- size, so that six-membered rings will always be preferred.
 36 | data RingSize : Type where
 37 |   NoRing : RingSize
 38 |   Ring   : (multibonds, size : Nat) -> RingSize
 39 |   Hexane : (multibonds : Nat) -> RingSize
 40 |
 41 | %runElab derive "RingSize" [Eq,Ord]
 42 |
 43 | --------------------------------------------------------------------------------
 44 | -- Geometry
 45 | --------------------------------------------------------------------------------
 46 |
 47 | export
 48 | parallelLine :
 49 |      (r   : Double)
 50 |   -> (pos : Bool)
 51 |   -> (x,y : Point Id)
 52 |   -> (Point Id, Point Id)
 53 | parallelLine r b x y =
 54 |   (perpendicularPoint x y r b, perpendicularPoint y x r $ not b)
 55 |
 56 |
 57 | ||| Distance between the lines of a double or triple bond.
 58 | export %inline
 59 | ParallelDistance : (cd : CoreDims) => Double
 60 | ParallelDistance = 0.8 * cd.radiusAtom
 61 |
 62 | ||| Half the distance between the lines of a double or triple bond.
 63 | export %inline
 64 | HalfParallelDistance : (cd : CoreDims) => Double
 65 | HalfParallelDistance = 0.5 * ParallelDistance
 66 |
 67 | -- `ox` and `oy` are the original positions of the atoms,
 68 | -- while `px` and `py` are the visible bond endings.
 69 | parameters {auto cd     : CoreDims}
 70 |            {k           : Nat}
 71 |            (g           : CDIGraph k)
 72 |            (x,y         : Fin k)
 73 |            (ox,oy,px,py : Point Id)
 74 |
 75 |   countMBs : Nat -> List (Fin k) -> Nat
 76 |   countMBs n (a::t@(b::_)) =
 77 |     case (type . molBond) <$> elab g a b of
 78 |       Just Dbl    => countMBs (S n) t
 79 |       Just Triple => countMBs (S n) t
 80 |       _           => countMBs n t
 81 |   countMBs n _             = n
 82 |
 83 |   ringSize : (nx,ny : Fin k) -> RingSize
 84 |   ringSize nx ny =
 85 |     case limitedBfs g [x,y] nx ny of
 86 |       Nothing => NoRing
 87 |       Just sn =>
 88 |         let path := x :: (sn <>> [y])
 89 |             mbs  := countMBs 0 path
 90 |          in case length path of
 91 |               6 => Hexane mbs
 92 |               n => Ring mbs n
 93 |
 94 |   displace : Vector Id
 95 |   displace = scaleTo (tan (pi / 6) * ParallelDistance) (oy - ox)
 96 |
 97 |   dx : Point Id
 98 |   dx = if ox == px then translate displace ox else px
 99 |
100 |   dy : Point Id
101 |   dy = if oy == py then translate (negate displace) oy else py
102 |
103 |   deflt : Vect 4 (Point Id)
104 |   deflt =
105 |     let (v,w) := parallelLine HalfParallelDistance True px py
106 |         (x,y) := parallelLine HalfParallelDistance False px py
107 |      in [v,w,x,y]
108 |
109 |   notXorY : Fin k -> Bool
110 |   notXorY n = n /= x && n /= y
111 |
112 |   leftOfY : Angle -> Fin k -> Bool
113 |   leftOfY phi n =
114 |     let Just chi := angle (pointAt g n - px) | Nothing => False
115 |      in chi - phi <= Angle.pi
116 |
117 |   dominantNode : Fin k -> Vect 4 (Point Id)
118 |   dominantNode n =
119 |     let Just phi := angle (py - px) | Nothing => deflt
120 |         (v,w)    := parallelLine ParallelDistance (leftOfY phi n) dx dy
121 |      in [px,py,v,w]
122 |
123 |   export
124 |   dblBond : Vect 4 (Point Id)
125 |   dblBond =
126 |     case (filter (y /=) (neighbours g x), filter (x /=) (neighbours g y)) of
127 |       ([nx1,nx2],[ny1,ny2]) =>
128 |         let r1 := max (ringSize nx1 ny1) (ringSize nx2 ny1)
129 |             r2 := max (ringSize nx1 ny2) (ringSize nx2 ny2)
130 |          in if r1 >= r2 then dominantNode ny1 else dominantNode ny2
131 |       ([_,_],[ny])  => dominantNode ny
132 |       ([nx], [_,_]) => dominantNode nx
133 |       ([nx], [_])   => dominantNode nx
134 |       _             => deflt
135 |