Kattis Chemist's vows https://open.kattis.com/problems/chemistsvows

chemistsvows.hs

import Control.Monad
import Data.Array.IArray
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ C.getLine >>= putStrLn . solve

solve :: C.ByteString -> String
solve s = if f n then "YES" else "NO" where
    n = C.length s
    dp = fArray (0,n) f :: Array Int Bool
    f 0 = True
    f 1 = S.member (C.take 1 s) good
    f i = let check x = S.member (C.take x (C.drop (i-x) s)) good && dp!(i-x)
          in check 1 || check 2

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

fArray :: (IArray a e, Ix i) => (i, i) -> (i -> e) -> a i e
fArray b f = listArray b (f <$> range b)

chemistsvows_parsec.hs

import Control.Monad
import Control.Monad.State.Strict
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S
import qualified Text.Parsec as P

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ C.getLine >>= putStrLn . solve

solve :: C.ByteString -> String
solve = either (const "NO") (const "YES") . flip evalState S.empty . P.runParserT p () ""
  where
    p = pre *> (P.eof P.<|> P.try (el1 *> p) P.<|> P.try (el2 *> p))
    pre = do
        pos <- P.getPosition
        seen <- lift get
        guard (pos `S.notMember` seen)
        lift $ put $! S.insert pos seen
    el1 = do
        c <- P.anyChar
        guard (C.pack [c] `S.member` good)
    el2 = do
        c <- P.anyChar
        c' <- P.anyChar
        guard (C.pack [c,c'] `S.member` good)

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