Find Problem words that can be offensive when playing "EEL of Fortune"

eel-of-fortune.lisp

;; Solution for Reddit Daily Programmer problem - 
;; https://www.reddit.com/r/dailyprogrammer/comments/3ddpms/20150715_challenge_223_intermediate_eel_of_fortune/

;; Elegant but incorrent solution - 
;; 
;; This is almost right except for the case when
;; checking for snond as a subword of mispronounced.
;; The naive understanding is that it should return t. However,
;; when looking at the sequence at which letters are called out
;; in EEL of Fortune, one never sees snond. Instead we see
;; __s__ono_n__d. So this is not the right solution.
;;
;; (defun problem-word-p (word subword)
;;   "Check if subword can be displayed when playing 'EEL of Fortune'"
;;   (loop for s across subword
;;      with i = 0
;;      if (position s word :start i)
;;      do (setf i (position s word :start i))
;;      collect (position s word :start i) into l1
;;      finally (return (not (member nil l1)))))

;; Much uglier but it works.
(defun problem-word-p (word subword)
  "Check if subword can be displayed when playing 'EEL of Fortune'"
  ;; Helper functions
  (flet ((positions (item sequence)
	   "Get a list of positions where item is present in sequence"
	   (loop for element across sequence
	      and position from 0
	      when (eql element item) collect position))
	 (setf-positions (new-item list-of-positions sequence)
	   "destructively setf new-item in sequence as per list-of-positions"
	   (loop for p in list-of-positions
	      do (nsubstitute new-item #\_ sequence :start p :count 1))
	   sequence))
    ;; Main loop
    (let ((return-string (make-string (length word) :initial-element #\_)))
      (loop for s across (remove-duplicates subword)
	 when (positions s word)
	 do (setf-positions s (positions s word) return-string)
	 finally (return (equal (remove #\_ return-string)
				subword))))))

(defun problem-word-count-file (filename subword)
  "Count the number of words that return true when checking for problem-word-p
in a file. Each line in the file represents a word to be checked"
  (with-open-file (stream filename :direction :input)
    (loop for string = (read-line stream nil :eof)
       and i from 0
       until (eq string :eof)
       when (problem-word-p string subword)
       count i)))