1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
module Main
( main
) where
import Data.Char (toLower)
import System.Environment (getArgs)
elements :: [String]
elements = [
"Ac", "Ag", "Al", "Am", "Ar", "As", "At", "Au", "B", "Ba", "Be", "Bh",
"Bi", "Bk", "Br", "C", "Ca", "Cd", "Ce", "Cf", "Cl", "Cm", "Cn", "Co",
"Cr", "Cs", "Cu", "Db", "Ds", "Dy", "Er", "Es", "Eu", "F", "Fe", "Fl",
"Fm", "Fr", "Ga", "Gd", "Ge", "H", "He", "Hf", "Hg", "Ho", "Hs", "I",
"In", "Ir", "K", "Kr", "La", "Li", "Lr", "Lu", "Lv", "Mc", "Md", "Mg",
"Mn", "Mo", "Mt", "N", "Na", "Nb", "Nd", "Ne", "Nh", "Ni", "No", "Np",
"O", "Og", "Os", "P", "Pa", "Pb", "Pd", "Pm", "Po", "Pr", "Pt", "Pu",
"Ra", "Rb", "Re", "Rf", "Rg", "Rh", "Rn", "Ru", "S", "Sb", "Sc", "Se",
"Sg", "Si", "Sm", "Sn", "Sr", "Ta", "Tb", "Tc", "Te", "Th", "Ti", "Tl",
"Tm", "Ts", "U", "V", "W", "Xe", "Y", "Yb", "Zn", "Zr"
]
search :: Char -> [String] -> [String]
search c = takeWhile start . dropWhile (not . start)
where
start [] = False
start (x:_) = toLower x == c'
c' = toLower c
split :: String -> [(String, String)]
split [] = []
split (x:xs) =
if null res
then [("?", xs)]
else res
where
res = go [] [] xs (search x elements)
go r _ _ [] = r
go r el rest candidates@(c:_) =
let el' = head c : el
candidates'@(c':_) = map tail candidates
r' =
if null c'
then (reverse el', rest) : r
else r
in case rest of
(y:ys) -> go r' el' ys (search y candidates')
_ -> r'
advance :: ([String], String) -> [([String], String)]
advance (els, rest) = map collect $ split rest
where
collect (el, rest') = (el : els, rest')
explode :: String -> [[String]]
explode word = reverse . map (reverse . fst) $ go [([], word)]
where
go :: [([String], String)] -> [([String], String)]
go [] = []
go (x:xs) =
if null (snd x)
then x : go xs
else go (advance x) ++ go xs
printFormula :: String -> IO ()
printFormula word = do
putStr word
putStrLn ":"
mapM_ (putStrLn . (:) ' ' . unwords) . filter (not . null) $ explode word
main :: IO ()
main = getArgs >>= mapM_ printFormula
|
