Re: fun-names.el --- avoid function duplication

[Emanuel Berg <incal@dataswamp.org>]

Richard Stallman wrote:

> It is an interestng feature, but the name led me to think it
> was just for amusement ;-{.
>
> I suggest considering variables as well as functions, and
> renaming the command to "related-names" or something
> like that.

Variables are planned for ... here is the most recent version:

;;; fun-names.el --- duplicate hunter -*- lexical-binding: t -*-
;;
;; Author: Emanuel Berg <incal@dataswamp.org>
;; Created: 2024-07-27
;; Git: git clone https://dataswamp.org/~incal/fun-names.git
;; Keywords: matching
;; License: GPL3+
;; URL: https://dataswamp.org/~incal/elpa/fun-names.el
;; Version: 6.0.3
;;
;;; Commentary:
;;
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;;   fun-names.el -- duplicate hunter            incal 2024
;;
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;; Use `fun-names' with a function symbol, a function name or
;; just an arbitrary sequence of words. It will then show you
;; a table of other functions that are currently defined that
;; have the same words in their names. The table have data to
;; quantify to what degree the names are similar.
;;
;; Here is how the table will look for all varieties of "gnus
;; group mark buffer", #'gnus-group-mark-buffer, and so on:
;;
;;    1. gnus-group-mark-group         0.88  3  +9
;;    2. gnus-group-mark-regexp        0.75  3  +9
;;    3. gnus-group-mark-region        0.75  3  +9
;;    4. gnus-group-mark-update        0.75  3  +9
;;    5. gnus-group-setup-buffer       0.75  3  +8
;;    6. gnus-uu-mark-buffer           0.75  3  +7
;;    7. gnus-group-remove-mark        0.75  2  +7
;;    8. gnus-group-set-mark           0.75  2  +7
;;    9. gnus-group-mark-line-p        0.67  3  +9
;;   10. gnus-group-mark-article-read  0.67  3  +9
;;
;; One use case can be for you to find such functions and put
;; them to use instead of writing new ones that are the same,
;; often.
;;
;; Also available is `fun-names-short' - it is faster, output
;; is shown in the echo area, there is no report compiled nor
;; is there a change of buffer (less disruptive). In practice
;; `fun-names-short' is often enough.
;;
;; ----------------------------------------------------------
;;
;; Basic interactive use:
;;
;;   M-x fun-names       RET split string buffer RET
;;   M-x fun-names-short RET kill-current-buffer RET
;;
;; Special interactive use:
;;
;;   M-x     fun-names RET RET ; input `symbol-at-point'
;;   C-u M-x fun-names RET RET ; change default settings
;;
;; ----------------------------------------------------------
;;
;; Let's compare `fun-names-short' to `apropos-function' used
;; with the same indata. First `apropos-function' then:
;;
;;   M-x apropos-function RET use-package-ensure-elpa RET
;;   "No apropos matches for use-package-ensure-elpa"
;;
;; And now we do `fun-names-short':
;;
;;   M-x fun-names-short RET use-package-ensure-elpa RET
;;   "use-package-normalize/:ensure  0.75  2  +7"
;;
;; ----------------------------------------------------------
;;
;; We can also compare the above result table with the result
;; from `apropos-function'. The search string for `fun-names'
;; was then "gnus group mark buffer", and for that the number
;; one hit was `gnus-group-mark-group', a 88% match.
;;
;; We do the same with `apropos-function'
;;
;;   M-x apropos-function RET gnus group mark buffer RET
;;
;; and we get 704 results. Sorted in ABC order from the first
;; Buffer-menu--unmark to the final w3m-bookmark-save-buffer.
;;
;; ----------------------------------------------------------
;;
;;; Code:

(require 'cl-lib)
(require 'pcase)
(require 'subr-x)
(require 'thingatpt)

(let ((fun-last   #'fun-names-short)
      (limit-def  0.5)
      (report-def 10))

  (defun funa--interface ()
    (when current-prefix-arg
      (setq limit-def  (read-number "limit: " limit-def))
      (setq report-def (read-number "lines: " report-def)))
    (let* ((def (or (symbol-at-point) fun-last))
           (ps  (format "fun words%s: " (if def (format " [%s]" def) "")))
           (fun (read-string ps nil nil def)))
      (when fun
        (setq fun-last fun))
      (list fun limit-def report-def)))

  (defun fun-names (fun &optional limit report)
    "Examine if the words in FUN appear in any function names.

If the proximity is higher than LIMIT (which defaults to 0.5),
then function function is included in the computation.

If REPORT is

  0   - no report, only return data
  8   - make a report, 8 lines long
  nil - make a report, default size
  t   - make a report, the full one

To set default options do:

   \\[universal-argument] \\[execute-extended-command] fun-names RET

Also try: `fun-names-short'

Proximity is based on the same words appearing in the same order."
    (interactive (funa--interface))
    (when (symbolp fun)
      (setq fun (symbol-name fun)))
    (unless limit
      (setq limit limit-def))
    (unless report
      (setq report report-def))
    (let ((similar)
          (estr)
          (ratio)
          (bonus))
      (mapatoms
        (lambda (e)
          (when (functionp e)
            (setq estr  (symbol-name e))
            (setq ratio (funa--words-same fun estr))
            (when (and (<= limit ratio)
                       (<  ratio 1))
              (setq bonus (funa--words-same-pos fun estr))
              (push `(,e ,ratio ,@bonus) similar)))))
      (let* ((sorted (cl-sort similar #'funa--words>)))
        (if (and (numberp report) (zerop report))
            sorted
          (funa--report sorted fun report)))))

  (declare-function funa--interface nil)
  (declare-function fun-names nil))

(defun fun-names-short (fun &optional _limit _report)
  "Echo what function has a name the closest to FUN.

See `fun-names'."
  (interactive (funa--interface))
  (let ((rec (car (fun-names fun nil 0))))
    (if rec
        (pcase-let ((`(,n ,r ,b ,p) rec))
          (message (funa--data-string 0 n r b p)))
      (message "unique"))))

(defun funa--data-string (i n r b p &optional pad)
  (unless pad
    (setq pad 0))
  (unless (stringp n)
    (setq n (symbol-name n)) )
  (let ((bp   (if (< 0 b) (format "  %d  %+d" b p) ""))
        (npad (string-pad n pad)))
    (if (zerop i)
        (format "%s  %.2f%s" n r bp)
      (format "%2d. %s %.2f%s\n" i npad r bp))))

(defun funa--report (data strs &optional lines)
  (when data
    (when (numberp lines)
      (setq data (take lines data)))
    (let ((buf (get-buffer-create "*fun-names*"))
          (pad (1+ (apply #'max (mapcar (lambda (e) (length (symbol-name (car e)))) data)))))
      (with-current-buffer buf
        (erase-buffer)
        (insert (format "search: %s\n\n" strs))
        (cl-loop
          for i from 1
          for (n r b p) in data
          do (insert (funa--data-string i n r b p pad)))
        (goto-char (point-min)))
      (pop-to-buffer buf))))

;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-
;;
;;                       NEW WORD ORDER
;;
;;    String proximity by words, a non-strict total order.
;; __________________________________________________________
;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-

(defun funa--words-from-string (s)
  (split-string (downcase s) "[^[:alnum:]]+" t))

(defun funa--words (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  `(,(funa--words-same s1 s2) ,@(funa--words-same-pos s1 s2)))

(defun funa--words-same (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  (if (and s1 s2)
      (let* ((num (+ (length s1) (length s2)))
             (com (- num (length (cl-set-exclusive-or s1 s2 :test #'string=)))))
        (/ com num 1.0))
    0.0))

(defun funa--words-same-pos (s1 s2)
  (unless (listp s1)
    (setq s1 (funa--words-from-string s1)))
  (unless (listp s2)
    (setq s2 (funa--words-from-string s2)))
  (cl-loop
    with short  = (min (length s1) (length s2))
    with hits = 0
    with pnts = 0
    for i downfrom short
    for a in s1
    for b in s2
    do (when (string= a b)
         (cl-incf hits)
         (cl-incf pnts i))
    finally return (list hits pnts)))

(defun funa--words< (p1 p2)
  (pcase-let ((`(,r1 ,b1 ,e1) (last p1 3))
              (`(,r2 ,b2 ,e2) (last p2 3)))
    (or
      (< r1 r2)
      (and (= r1 r2) (< b1 b2))
      (and (= r1 r2) (= b1 b2) (< e1 e2)))))

(defun funa--words<= (p1 p2)
  (funa--words< p2 p1))

(defun funa--words= (p1 p2)
  (or (funa--words< p1 p2)
      (funa--words< p2 p1)))

(defun funa--words>= (p1 p2)
  (funa--words< p2 p1))

(defun funa--words> (p1 p2)
  (funa--words< p2 p1))

(provide 'fun-names)
;;; fun-names.el ends here

-- 
underground experts united
https://dataswamp.org/~incal