{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP                 #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Bio.MAE
  ( Block (..), FromMaeValue (..)
  , Mae (..), MaeValue (..)
  , Table (..)
  , fromFile
  , fromText
  , modelsFromMaeText
  , modelsFromMaeFile
  , maeP
  ) where

import           Bio.MAE.Parser
import           Bio.MAE.Type           (Block (..), FromMaeValue (..), Mae (..), MaeValue (..),
                                         Table (..))
import           Bio.Structure          (Atom (..), Bond (..), Chain (..), GlobalID (..),
                                         LocalID (..), Model (..), Residue (..),
                                         SecondaryStructure (..), StructureModels (..))
import qualified Bio.Utils.Map          as M ((!?!))
import           Control.Monad          (join)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.Attoparsec.Text   (parseOnly)
import           Data.Bifunctor         (bimap, first)
import           Data.Function          (on)
import qualified Data.List              as L (find, sortOn)
import qualified Data.List.NonEmpty     as NE
import           Data.Map.Strict        (Map)
import qualified Data.Map.Strict        as M (fromList, lookup)
import           Data.Maybe             (catMaybes, fromJust)
import           Data.Text              (Text)
import qualified Data.Text              as T (head, init, last, null, pack, strip, tail)
import qualified Data.Text.IO           as TIO (readFile)
import           Data.Vector            (Vector)
import qualified Data.Vector            as V (fromList)
import           Linear.V3              (V3 (..))





-- | Reads 'Mae' from givem file.
--
fromFile :: (MonadFail m, MonadIO m) => FilePath -> m Mae
fromFile :: forall (m :: * -> *). (MonadFail m, MonadIO m) => FilePath -> m Mae
fromFile FilePath
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
TIO.readFile FilePath
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either FilePath a
parseOnly Parser Mae
maeP

-- | Reads 'Mae' from 'Text'.
--
fromText :: Text -> Either Text Mae
fromText :: Text -> Either Text Mae
fromText = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either FilePath a
parseOnly Parser Mae
maeP

modelsFromMaeFile :: (MonadIO m) => FilePath -> m (Either Text (Vector Model))
modelsFromMaeFile :: forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Either Text (Vector Model))
modelsFromMaeFile = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text (Vector Model)
modelsFromMaeText forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
TIO.readFile

modelsFromMaeText :: Text -> Either Text (Vector Model)
modelsFromMaeText :: Text -> Either Text (Vector Model)
modelsFromMaeText Text
maeText = forall a. StructureModels a => a -> Vector Model
modelsOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Mae
fromText Text
maeText

instance StructureModels Mae where
  modelsOf :: Mae -> Vector Model
modelsOf Mae{[Block]
Text
blocks :: Mae -> [Block]
version :: Mae -> Text
blocks :: [Block]
version :: Text
..} = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> Model
blockToModel [Block]
blocks
    where
      unsafeGetFromContentsMap :: FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> a
      unsafeGetFromContentsMap :: forall a. FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> a
unsafeGetFromContentsMap Map Text [MaeValue]
m Text
name Int
i = forall a. FromMaeValue a => MaeValue -> a
unsafeFromMaeValue forall a b. (a -> b) -> a -> b
$ (Map Text [MaeValue]
m forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Text
name) forall a. [a] -> Int -> a
!! Int
i

      getFromContentsMap :: FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> Maybe a
      getFromContentsMap :: forall a.
FromMaeValue a =>
Map Text [MaeValue] -> Text -> Int -> Maybe a
getFromContentsMap Map Text [MaeValue]
m Text
name Int
i = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a. FromMaeValue a => MaeValue -> Maybe a
fromMaeValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> Int -> a
!! Int
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Text [MaeValue]
m

      blockToModel :: Block -> Model
      blockToModel :: Block -> Model
blockToModel Block{[Table]
Text
Map Text MaeValue
tables :: Block -> [Table]
fields :: Block -> Map Text MaeValue
blockName :: Block -> Text
tables :: [Table]
fields :: Map Text MaeValue
blockName :: Text
..} = Vector Chain -> Vector (Bond GlobalID) -> Model
Model (Map Text [MaeValue] -> Vector Chain
atomsTableToChains Map Text [MaeValue]
atomsTable) Vector (Bond GlobalID)
bonds
        where
          atomsTable :: Map Text [MaeValue]
atomsTable    = Text -> Map Text [MaeValue]
findTable Text
"m_atom"
          numberOfAtoms :: Int
numberOfAtoms = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Map Text [MaeValue]
atomsTable forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Text
"r_m_x_coord"

          bondsTable :: Map Text [MaeValue]
bondsTable         = Text -> Map Text [MaeValue]
findTable Text
"m_bond"
          (Map Int [(Int, Int)]
bondGraph, Vector (Bond GlobalID)
bonds) = Map Text [MaeValue]
-> (Map Int [(Int, Int)], Vector (Bond GlobalID))
bondsTableToGlobalBonds Map Text [MaeValue]
bondsTable

          findTable :: Text -> Map Text [MaeValue]
          findTable :: Text -> Map Text [MaeValue]
findTable Text
name = Table -> Map Text [MaeValue]
contents forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((forall a. Eq a => a -> a -> Bool
== Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Text
tableName) [Table]
tables

          stripQuotes :: Text -> Text
          stripQuotes :: Text -> Text
stripQuotes Text
t | Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Text -> Char
T.head Text
t forall a. Eq a => a -> a -> Bool
== Text -> Char
T.last Text
t, Text -> Char
T.last Text
t forall a. Eq a => a -> a -> Bool
== Char
'\"' = Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ Text -> Text
T.init forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
t
                        | Bool
otherwise                                                = Text -> Text
T.strip Text
t

          toGroupsOn :: (Eq b, Ord b) => (a -> b) -> [a] -> [NE.NonEmpty a]
          toGroupsOn :: forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [NonEmpty a]
toGroupsOn a -> b
f = forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn a -> b
f

          bondsTableToGlobalBonds :: Map Text [MaeValue] -> (Map Int [(Int, Int)], Vector (Bond GlobalID))
          bondsTableToGlobalBonds :: Map Text [MaeValue]
-> (Map Int [(Int, Int)], Vector (Bond GlobalID))
bondsTableToGlobalBonds Map Text [MaeValue]
m = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(Int, (Int, Int))] -> Map Int [(Int, Int)]
toMap forall a. [a] -> Vector a
V.fromList ([(Int, (Int, Int))], [Bond GlobalID])
bonds'
            where
              numberOfBonds :: Int
numberOfBonds = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Map Text [MaeValue]
m forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Text
"i_m_from"
              bonds' :: ([(Int, (Int, Int))], [Bond GlobalID])
bonds'        = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ((Int, (Int, Int)), Bond GlobalID)
indexToBond [Int
0 .. Int
numberOfBonds forall a. Num a => a -> a -> a
- Int
1]

              toMap :: [(Int, (Int, Int))] -> Map Int [(Int, Int)]
              toMap :: [(Int, (Int, Int))] -> Map Int [(Int, Int)]
toMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\l :: NonEmpty (Int, (Int, Int))
l@((Int
k, (Int, Int)
_) NE.:| [(Int, (Int, Int))]
_) -> (Int
k, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Int, (Int, Int))
l)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [NonEmpty a]
toGroupsOn forall a b. (a, b) -> a
fst

              indexToBond :: Int -> ((Int, (Int, Int)), Bond GlobalID)
              indexToBond :: Int -> ((Int, (Int, Int)), Bond GlobalID)
indexToBond Int
i = ((Int
x, (Int
y, Int
o)), forall m. m -> m -> Int -> Bond m
Bond (Int -> GlobalID
GlobalID Int
x) (Int -> GlobalID
GlobalID Int
y) Int
o)
                where
                  x :: Int
x = forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_from" forall a. Num a => a -> a -> a
- Int
1
                  y :: Int
y = forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_to" forall a. Num a => a -> a -> a
- Int
1
                  o :: Int
o = forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_order"

                  getFromContentsI :: FromMaeValue a => Text -> a
                  getFromContentsI :: forall a. FromMaeValue a => Text -> a
getFromContentsI = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> a
unsafeGetFromContentsMap Map Text [MaeValue]
m) Int
i

          atomsTableToChains :: Map Text [MaeValue] -> Vector Chain
          atomsTableToChains :: Map Text [MaeValue] -> Vector Chain
atomsTableToChains Map Text [MaeValue]
m = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Int -> Chain
groupToChain [NonEmpty Int]
groupedByChains
            where
              groupedByChains :: [NonEmpty Int]
groupedByChains = forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [NonEmpty a]
toGroupsOn (forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Text
defaultChainName Text
"s_m_chain_name") [Int
0 .. Int
numberOfAtoms forall a. Num a => a -> a -> a
- Int
1]

              getFromContents :: FromMaeValue a => a -> Text -> Int -> a
              getFromContents :: forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents a
def Text
name Int
ind = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a.
FromMaeValue a =>
Map Text [MaeValue] -> Text -> Int -> Maybe a
getFromContentsMap Map Text [MaeValue]
m Text
name Int
ind

              unsafeGetFromContents :: FromMaeValue a => Text -> Int -> a
              unsafeGetFromContents :: forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents = forall a. FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> a
unsafeGetFromContentsMap Map Text [MaeValue]
m

              groupToChain :: NE.NonEmpty Int -> Chain
              groupToChain :: NonEmpty Int -> Chain
groupToChain group :: NonEmpty Int
group@(Int
h NE.:| [Int]
_) = Text -> Vector Residue -> Chain
Chain Text
name Vector Residue
residues
                where
                  name :: Text
name = Text -> Text
stripQuotes forall a b. (a -> b) -> a -> b
$ forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Text
defaultChainName Text
"s_m_chain_name" Int
h

                  groupedByResidues :: [NonEmpty Int]
groupedByResidues = forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [NonEmpty a]
toGroupsOn Int -> (Int, Char)
by forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty Int
group
                  residues :: Vector Residue
residues          = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Int -> Residue
groupToResidue [NonEmpty Int]
groupedByResidues

                  by :: Int -> (Int, Char)
                  by :: Int -> (Int, Char)
by Int
i = (forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Text
"i_m_residue_number" Int
i, forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Char
defaultInsertionCode Text
"s_m_insertion_code" Int
i)

              defaultChainName :: Text
              defaultChainName :: Text
defaultChainName = Text
"A"

              defaultInsertionCode :: Char
              defaultInsertionCode :: Char
defaultInsertionCode = Char
' '

              groupToResidue :: NE.NonEmpty Int -> Residue
              groupToResidue :: NonEmpty Int -> Residue
groupToResidue groupNE :: NonEmpty Int
groupNE@(Int
h NE.:| [Int]
_) = Text
-> Int
-> Char
-> Vector Atom
-> Vector (Bond LocalID)
-> SecondaryStructure
-> Text
-> Residue
Residue Text
name Int
residueNumber Char
insertionCode Vector Atom
atoms (forall a. [a] -> Vector a
V.fromList [Bond LocalID]
localBonds) SecondaryStructure
secondary Text
chemCompType
                where
                  group :: [Int]
group         = forall a. NonEmpty a -> [a]
NE.toList NonEmpty Int
groupNE
                  name :: Text
name          = Text -> Text
stripQuotes forall a b. (a -> b) -> a -> b
$ forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Text
"s_m_pdb_residue_name" Int
h
                  residueNumber :: Int
residueNumber = forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Text
"i_m_residue_number" Int
h
                  insertionCode :: Char
insertionCode = forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Char
defaultInsertionCode Text
"s_m_insertion_code" Int
h
                  atoms :: Vector Atom
atoms         = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Atom
indexToAtom [Int]
group

                  localInds :: [Int]
localInds     = [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
group forall a. Num a => a -> a -> a
- Int
1]
                  globalToLocal :: Map Int Int
globalToLocal = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
group [Int]
localInds
                  bondsParts :: [Maybe [(Int, Int)]]
bondsParts    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Int [(Int, Int)]
bondGraph) [Int]
group
                  localBonds :: [Bond LocalID]
localBonds    = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Maybe [(Int, Int)]
l Int
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> (Int, Int) -> [Bond LocalID]
toLocalBond Int
x)) Maybe [(Int, Int)]
l) [Maybe [(Int, Int)]]
bondsParts [Int]
localInds

                  toLocalBond :: Int -> (Int, Int) -> [Bond LocalID]
                  toLocalBond :: Int -> (Int, Int) -> [Bond LocalID]
toLocalBond Int
x (Int
y, Int
o) | Int
y forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
group = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. m -> m -> Int -> Bond m
Bond (Int -> LocalID
LocalID Int
x)
                                                                      (Int -> LocalID
LocalID forall a b. (a -> b) -> a -> b
$ Map Int Int
globalToLocal forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Int
y)
                                                                      Int
o
                                       | Bool
otherwise          = []

                  secondary :: SecondaryStructure
secondary    = SecondaryStructure
Undefined
                  chemCompType :: Text
chemCompType = forall a. Monoid a => a
mempty

              indexToAtom :: Int -> Atom
              indexToAtom :: Int -> Atom
indexToAtom Int
i = GlobalID
-> Int -> Text -> Text -> V3 Float -> Int -> Float -> Float -> Atom
Atom (Int -> GlobalID
GlobalID Int
i)
                                   (Int
i forall a. Num a => a -> a -> a
+ Int
1)
                                   (Text -> Text
stripQuotes forall a b. (a -> b) -> a -> b
$ forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"s_m_pdb_atom_name")
                                   (Map Int Text
elIndToElement forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_atomic_number")
                                   V3 Float
coords
                                   (forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Int
0 Text
"i_m_formal_charge" Int
i)
                                   (forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Float
0 Text
"r_m_pdb_tfactor" Int
i)
                                   (forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Float
0 Text
"r_m_pdb_occupancy" Int
i)
                where
                  getFromContentsI :: FromMaeValue a => Text -> a
                  getFromContentsI :: forall a. FromMaeValue a => Text -> a
getFromContentsI = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Int
i

                  coords :: V3 Float
                  coords :: V3 Float
coords = forall a. a -> a -> a -> V3 a
V3 (forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"r_m_x_coord")
                              (forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"r_m_y_coord")
                              (forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"r_m_z_coord")

elIndToElement :: Map Int Text
elIndToElement :: Map Int Text
elIndToElement = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 .. Int
118] [ Text
"H", Text
"He", Text
"Li", Text
"Be", Text
"B", Text
"C", Text
"N", Text
"O", Text
"F", Text
"Ne"
                                             , Text
"Na", Text
"Mg", Text
"Al", Text
"Si", Text
"P", Text
"S", Text
"Cl", Text
"Ar", Text
"K", Text
"Ca"
                                             , Text
"Sc", Text
"Ti", Text
"V", Text
"Cr", Text
"Mn", Text
"Fe", Text
"Co", Text
"Ni", Text
"Cu", Text
"Zn"
                                             , Text
"Ga", Text
"Ge", Text
"As", Text
"Se", Text
"Br", Text
"Kr", Text
"Rb", Text
"Sr", Text
"Y", Text
"Zr"
                                             , Text
"Nb", Text
"Mo", Text
"Tc", Text
"Ru", Text
"Rh", Text
"Pd", Text
"Ag", Text
"Cd", Text
"In", Text
"Sn"
                                             , Text
"Sb", Text
"Te", Text
"I", Text
"Xe", Text
"Cs", Text
"Ba", Text
"La", Text
"Ce", Text
"Pr", Text
"Nd"
                                             , Text
"Pm", Text
"Sm", Text
"Eu", Text
"Gd", Text
"Tb", Text
"Dy", Text
"Ho", Text
"Er", Text
"Tm", Text
"Yb"
                                             , Text
"Lu", Text
"Hf", Text
"Ta", Text
"W", Text
"Re", Text
"Os", Text
"Ir", Text
"Pt", Text
"Au", Text
"Hg"
                                             , Text
"Tl", Text
"Pb", Text
"Bi", Text
"Po", Text
"At", Text
"Rn", Text
"Fr", Text
"Ra", Text
"Ac", Text
"Th"
                                             , Text
"Pa", Text
"U", Text
"Np", Text
"Pu", Text
"Am", Text
"Cm", Text
"Bk", Text
"Cf", Text
"Es", Text
"Fm"
                                             , Text
"Md", Text
"No", Text
"Lr", Text
"Rf", Text
"Db", Text
"Sg", Text
"Bh", Text
"Hs", Text
"Mt", Text
"Ds"
                                             , Text
"Rg", Text
"Cn", Text
"Nh", Text
"Fl", Text
"Mc", Text
"Lv", Text
"Ts", Text
"Og"
                                             ]