Replacing words using multiple rules

Question

This function is supposed to replace matches with a shortened version using multiple rules rather than just a single one. For the word counter, coun gets replaced by k, resulting in the shortened word kter.

But I am struggling for the case where the replacement has to be done at the end. So that family gets replaced by faml (replacing ily match with l).

(defun shorten-word-b ()
  "Shortens a word according to specific rules."

  (interactive)

  (let* ((bounds (bounds-of-thing-at-point 'word))
     (s (car bounds))
     (case-fold-search nil)
     (p (point-marker)))

    (when s
      (goto-char s)
      (cond
       ;;-----------------------------------------------
       ((looking-at (regexp-opt
           '("cog" "col" "com" "con" "cor" "cum" "coun") "\\<\\("))
        (replace-match "k"))
       ;;-----------------------------------------------       
       ((looking-at (regexp-opt
           '("ley" "ily" "ly") "\\)\\>"))
        (replace-match "l"))
       ;;-----------------------------------------------
       (t nil))
      (goto-char p))
    (set-marker p nil)))

Here are some examples

Before: Counter
After: kter

Before: family
After: faml 

Where point can be placed anywhere, with next character being a character of word.

Answer 1

I don't know if this helps, but here is a variation of what you wrote above that works in all the cases I've tried:

(defun shorten-word-b ()
  "Shortens the word at point according to specific rules."

  (interactive)

  (let* ((bounds (bounds-of-thing-at-point 'word))
         (s (car bounds))
         (case-fold-search nil)
         (p (point-marker)))
    
    (when s
      (goto-char s)
      (cond
       ;;-----------------------------------------------
       ;; deal with prefixes
       ((looking-at (concat "\\<"
                            (regexp-opt
                             '("cog" "col" "com" "con" "cor" "cum" "coun"))))
        (replace-match "k"))
       ;;-----------------------------------------------       
       ;; deal with suffixes - be careful not to overstep the bounds
       ((search-forward-regexp (concat (regexp-opt '("ley" "ily" "ly")) "\\>") (cdr bounds) t)
        (replace-match "l"))
       ;;-----------------------------------------------
       (t nil))
      (goto-char p))
    (set-marker p nil)))

The tests I tried:

cognition
confidence
counter
columnar
cumulative
contiguous
correlative
abscond
score
scum
scoliosis
discount
discography
family
oleley
only
lye
familiar
unrelated
not-a-match

Unfortunately, neither regexp catches the case of a prefix or a suffix being the whole "word": con becomes k and ily becomes l. You have to complicate the regexps to catch those cases and not do the contraction.

Answer 2

The problem is the second argument to the second regexp-opt form. That argument gets prefixed; your call implies that you want it to be suffixed, but regexp-opt does not offer you that facility.

What you need is something like this (untested):

((looking-at
   (concat
    (regexp-opt '("ley" "ily" "ly")) "\\b"))  
  (replace-match "l"))

where "\\b" is the word-boundary matcher.