Digest tag population

In comp.lang.lisp, Ken Tilton relayed a fun exercise involving a two-tiered list of pet populations, selections, and an unusual sort order. He proposed it as a test of language mastery because of his requirement to write "in one go" a single-function solution.

This style of development would be highly unusual with Lisp. Having the whole language available at an interactive read-eval-print loop promotes an incremental, bottom-up approach. As Paul Graham explains, bottom-up design in Lisp is more than building up a library: experienced programmers modify the language itself to make expressing the problem more straightforward.

I wrote a solution in Haskell:

	import Data.Function (on)
	import Data.List (findIndex,sortBy)
	import Data.Maybe (fromJust)
	type Tag = String
	type Type = String
	type Pop = Int
	type PetTags = [(Tag, [(Type, Pop)])]
	type TaggedPet = (Tag, Type, Pop)
	pets :: PetTags
	pets =
	[ ("dog", [ ("blab", 12)
	, ("glab", 17)
	, ("cbret", 82)
	, ("dober", 42)
	, ("gshep", 25)
	])
	, ("cat", [ ("pers", 22)
	, ("siam", 7)
	, ("tibet", 52)
	, ("russ", 92)
	, ("meow", 35)
	])
	, ("snake", [ ("garter", 10)
	, ("cobra", 37)
	, ("python", 77)
	, ("adder", 24)
	, ("rattle", 40)
	])
	, ("cow", [ ("jersey", 200)
	, ("heiffer", 300)
	, ("moo", 400)
	])
	]
	digestTagPopulation :: PetTags -> [Tag] -> Pop -> [TaggedPet]
	digestTagPopulation tagPopulation pickTags count =
	sortBy (compare `on` tagPos . tag) $
	take count $ reverse $ sortBy pop $
	flatten $ filter ((`elem` pickTags) . fst) tagPopulation
	where
	tag (t,_,_) = t
	pop :: TaggedPet -> TaggedPet -> Ordering
	pop = compare `on` (\(_,_,p) -> p)
	tagPos :: Tag -> Int
	tagPos = fromJust . (flip findIndex) pickTags . (==)
	flatten :: PetTags -> [TaggedPet]
	flatten = concatMap $
	\(t, subs) -> map (\(typ,p) -> (t,typ,p)) subs

view raw pet-tags.hs hosted with ❤ by GitHub

Aspects need improvement. The name of the type-synonym PetTags is plural, which is often better expressed as a list type, e.g., [PetTag]. The sort comparison functions (used on lines 39 and 40) are inconsistent in expression. The definition feels clunky and verbose.

In comp.lang.haskell, Florian Kreidler made my code much more elegant:

	import Data.List (sortBy, elemIndex)
	import Data.Ord(comparing)
	type Tag = String
	type Pet = (String, Int)
	type PetTag = (Tag, [Pet])
	type TaggedPet = (Tag, Pet)
	digestTagPopulation :: [PetTag] -> [Tag] -> Int -> [TaggedPet]
	digestTagPopulation tp tags c
	= sortBy (comparing $ flip elemIndex tags . fst) $
	take c $ sortBy (flip $ comparing $ snd . snd)
	[ (t, p) | (t, ps) <- tp, t `elem` tags, p <- ps ]

view raw kreidler-pet-tags.hs hosted with ❤ by GitHub

A more natural Haskell development style would be writing a function, checking it for correctness, and repeating in tiny increments. In the code below, I first wrote flatten, then I wrote select to extract the desired animals, followed by largest to extract the top n by population, and finally I wove them together to create digestTagPopulation.

	import Data.List (elemIndex,sortBy)
	import Data.Ord (comparing)
	type Tag = String
	type Type = String
	type PetPop = (Type, Int)
	type PetTag = (Tag, [PetPop])
	type TaggedPet = (Tag, Type, Int)
	digestTagPopulation :: [PetTag] -> [Tag] -> Int -> [TaggedPet]
	digestTagPopulation all tags n =
	sortBy (comparing tagPos) $
	largest n (flatten $ select tags all)
	where
	tagPos (t,_,_) = t `elemIndex` tags
	select :: [Tag] -> [PetTag] -> [PetTag]
	select tags = filter $ (`elem` tags) . fst
	flatten :: [PetTag] -> [TaggedPet]
	flatten pts = [(tag,typ,pop) | (tag,ps) <- pts, (typ,pop) <- ps ]
	largest :: Int -> [TaggedPet] -> [TaggedPet]
	largest n = take n . sortBy (flip $ comparing pop)
	where pop (_,_,p) = p

view raw pet-tags2.hs hosted with ❤ by GitHub

(Github has a feature request for embedding particular revisions of gists. That would have come in handy in this post.)