fork download
copy 
  1. ; element words
  2.  
  3. (define (take n xs)
  4.   (let loop ((n n) (xs xs) (ys '()))
  5.     (if (or (zero? n) (null? xs))
  6.         (reverse ys)
  7.         (loop (- n 1) (cdr xs)
  8.               (cons (car xs) ys)))))
  9.  
  10. (define elements (map string-downcase (map symbol->string
  11.   '(H He Li Be B C N O F Ne Na Mg Al Si P S Cl Ar K Ca Sc
  12.   Ti V Cr Mn Fe Co Ni Cu Zn Ga Ge As Se Br Kr Rb Sr Y Zr
  13.   Nb Mo Tc Ru Rh Pd Ag Cd In Sn Sb Te I Xe Cs Ba La Ce Pr
  14.   Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu Hf Ta W Re Os Ir Pt
  15.   Au Hg Tl Pb Bi Po At Rn Fr Ra Ac Th Pa U Np Pu Am Cm Bk
  16.   Cf Es Fm Md No Lr Rf Db Sg Bh Hs Mt))))
  17.  
  18. (define element-names (map string-downcase (map symbol->string
  19.   '(Hydrogen Helium Lithium Beryllium Boron Carbon Nitrogen
  20.   Oxygen Fluorine Neon Sodium Magnesium Aluminum Silicon
  21.   Phosphorus Sulfur Chlorine Argon Potassium Calcium Scandium
  22.   Titanium Vanadium Chromium Manganese Iron Cobalt Nickel
  23.   Copper Zinc Gallium Germanium Arsenic Selenium Bromine
  24.   Krypton Rubidium Strontium Yttrium Zirconium Niobium
  25.   Molybdenum Technetium Ruthenium Rhodium Palladium Silver
  26.   Cadmium Indium Tin Antimony Tellurium Iodine Xenon Cesium
  27.   Barium Lanthanum Cerium Praseodymium Neodymium Promethium
  28.   Samarium Europium Gadolinium Terbium Dysprosium Holmium
  29.   Erbium Thulium Ytterbium Lutetium Hafnium Tantalum Tungsten
  30.   Rhenium Osmium Iridium Platinum Gold Mercury Thallium Lead
  31.   Bismuth Polonium Astatine Radon Francium Radium Actinium
  32.   Thorium Protactinium Uranium Neptunium Plutonium Americium
  33.   Curium Berkelium Californium Einsteinium Fermium Mendelevium
  34.   Nobelium Lawrencium Rutherfordium Dubnium Seaborgium Bohrium
  35.   Hassium Meitnerium))))
  36.  
  37. (define (eword? str) ; element-word
  38.   (let loop ((cs (string->list str)))
  39.     (or (null? cs)
  40.         (and (member (string (car cs)) elements)
  41.              (loop (cdr cs)))
  42.         (and (pair? (cdr cs))
  43.              (member (list->string (take 2 cs)) elements)
  44.              (loop (cddr cs))))))
  45.  
  46. (define (element-words words)
  47.   (let loop ((words words) (max-len 0) (max-words (list)))
  48.     (if (null? words) (reverse max-words)
  49.       (let* ((word (car words)) (word-len (string-length word)))
  50.         (cond ((< word-len max-len) (loop (cdr words) max-len max-words))
  51.               ((not (eword? word)) (loop (cdr words) max-len max-words))
  52.               ((< max-len word-len) (loop (cdr words) word-len (list word)))
  53.               (else (loop (cdr words) max-len (cons word max-words))))))))
  54.  
  55. (display (filter eword? element-names)) (newline)
  56. (display (element-words element-names)) (newline)
Success #stdin #stdout 0.04s 43200KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(carbon neon silicon phosphorus iron copper arsenic krypton tin xenon bismuth astatine)
(phosphorus)
https://ideone.com/6woBy6
language:
Scheme (guile 2.2.4)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!