; element words

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))
        (reverse ys)
        (loop (- n 1) (cdr xs)
              (cons (car xs) ys)))))

(define elements (map string-downcase (map symbol->string
  '(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 La Ce Pr
  Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu Hf Ta W Re Os Ir Pt
  Au Hg Tl Pb Bi Po At Rn Fr Ra Ac Th Pa U Np Pu Am Cm Bk
  Cf Es Fm Md No Lr Rf Db Sg Bh Hs Mt))))

(define element-names (map string-downcase (map symbol->string
  '(Hydrogen Helium Lithium Beryllium Boron Carbon Nitrogen
  Oxygen Fluorine Neon Sodium Magnesium Aluminum Silicon
  Phosphorus Sulfur Chlorine Argon Potassium Calcium Scandium
  Titanium Vanadium Chromium Manganese Iron Cobalt Nickel
  Copper Zinc Gallium Germanium Arsenic Selenium Bromine
  Krypton Rubidium Strontium Yttrium Zirconium Niobium
  Molybdenum Technetium Ruthenium Rhodium Palladium Silver
  Cadmium Indium Tin Antimony Tellurium Iodine Xenon Cesium
  Barium Lanthanum Cerium Praseodymium Neodymium Promethium
  Samarium Europium Gadolinium Terbium Dysprosium Holmium
  Erbium Thulium Ytterbium Lutetium Hafnium Tantalum Tungsten
  Rhenium Osmium Iridium Platinum Gold Mercury Thallium Lead
  Bismuth Polonium Astatine Radon Francium Radium Actinium
  Thorium Protactinium Uranium Neptunium Plutonium Americium
  Curium Berkelium Californium Einsteinium Fermium Mendelevium
  Nobelium Lawrencium Rutherfordium Dubnium Seaborgium Bohrium
  Hassium Meitnerium))))

(define (eword? str) ; element-word
  (let loop ((cs (string->list str)))
    (or (null? cs)
        (and (member (string (car cs)) elements)
             (loop (cdr cs)))
        (and (pair? (cdr cs))
             (member (list->string (take 2 cs)) elements)
             (loop (cddr cs))))))

(define (element-words words)
  (let loop ((words words) (max-len 0) (max-words (list)))
    (if (null? words) (reverse max-words)
      (let* ((word (car words)) (word-len (string-length word)))
        (cond ((< word-len max-len) (loop (cdr words) max-len max-words))
              ((not (eword? word)) (loop (cdr words) max-len max-words))
              ((< max-len word-len) (loop (cdr words) word-len (list word)))
              (else (loop (cdr words) max-len (cons word max-words))))))))

(display (filter eword? element-names)) (newline)
(display (element-words element-names)) (newline)