Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Emacs: Replace all words in buffer with random words of the same length
;; This function replaces all words in a buffer with words of the same length,
;; chosen at random from /usr/share/dict/words. Words are replaced consistently,
;; so e.g. "A" is always replaced with "Z". The mapping changes when Emacs is
;; restarted or when the cache buffer is killed. If all unique words of a certain
;; length are exhausted, random strings are used.
(defun ap/replace-words-randomly (&optional buffer)
"Replace all words in BUFFER or current buffer with randomly selected words from the dictionary.
Every time a new word is found, it is mapped to a replacement
word, so every instance of word A will be replaced with word Z."
(interactive)
(require 'ht)
(with-current-buffer (or buffer (current-buffer))
(let ((replacements (ht-create))
(used-words (ht-create))
(regexp (rx (or bow symbol-start) (1+ word) (or eow symbol-end)))
(case-fold-search t)
(orig-mode major-mode)
;; (window (get-buffer-window (current-buffer)))
(buffer-size (buffer-size))
current-word replacement-word)
(fundamental-mode)
(goto-char (point-min))
(while (re-search-forward regexp nil 'noerror)
(setq current-word (s-downcase (match-string 0)))
(save-match-data ; `ap/get-random-word-of-same-length' changes match data
(unless (setq replacement-word (ht-get replacements current-word))
;; Find unique replacement word and add to hash-tables.
;; We use a second ht to store words that we've already
;; used, because looking them up as keys is much faster
;; than getting all the values in the replacements table.
(while (ht-get used-words
(setq replacement-word (ap/get-random-word-of-same-length current-word used-words)))
nil)
(unless replacement-word
;; No word found; make random string (which may not be
;; unique, but we can't really guarantee uniqueness in the
;; case of very short words unless we go into non-word
;; characters, Unicode, etc)
(setq replacement-word (ap/get-random-string (length current-word))))
;; TODO: Filter profanity?
;; Add to hash-tables
(ht-set replacements current-word replacement-word)
(ht-set used-words replacement-word t)))
;; Replace match
(replace-match replacement-word nil 'literal)
;; Allow Emacs to be interrupted gracefully. Also potentially
;; displays progress if you have the buffer visible, but I can't get
;; recentering to work.
(sit-for 0)
;; Display progress (this takes a while on large buffers)
(message "%s/%s" (point) buffer-size)
;; No idea why this doesn't work. I have to save and restore
;; point manually or it doesn't move past the matches and runs
;; in an infinite loop, but then recenter does nothing at all
;; (when window
;; (setq save-point (point))
;; (with-selected-window window
;; (recenter t))
;; (goto-char save-point))
)
(funcall orig-mode))))
(cl-defmacro ap/with-random-word-cache (&rest body)
""
(declare (indent defun)
(debug (&rest form)))
(let ((result (cl-gensym)))
`(progn
(unless (and (boundp 'ap/random-word-buffer)
(buffer-live-p ap/random-word-buffer))
(with-current-buffer (setq ap/random-word-buffer (get-buffer-create " *RANDOM WORDS*"))
(call-process-shell-command "cat /usr/share/dict/words | shuf" nil t))
(setq ap/random-word-buffer-point 1))
(with-current-buffer ap/random-word-buffer
(let (,result)
(goto-char ap/random-word-buffer-point)
(setq ,result (progn ,@body))
;; This point-saving and restoring should NOT be necessary, I have no idea why this is.
(setq ap/random-word-buffer-point (point))
,result)))))
(defun ap/get-random-word-of-same-length (word &optional exclude-ht)
(let* ((length (length word))
(regexp (rx-to-string `(seq bol (repeat ,length word) eow))))
(ap/with-random-word-cache
;; Search from last point, wrap once
(when (= (point) (point-max))
(goto-char (point-min)))
(cl-loop with starting-point = (point)
with match
with wrapped
until (or match
(and wrapped
(>= (point) starting-point)))
do (progn
(when (= (point) (point-max))
(goto-char (point-min))
(setq wrapped t))
(when (re-search-forward regexp nil 'goto-end)
(setq match (match-string 0))
(unless (and (not (string= match word))
(or (not exclude-ht)
(not (ht-get exclude-ht match))))
;; Invalid match, clear var
(setq match nil))))
finally return match))))
(defun ap/get-random-string (length)
"Return random string of LENGTH."
(unless (and (bound-and-true-p ap/random-chars)
(bound-and-true-p ap/random-chars-length))
(setq ap/random-chars (split-string "abcdefghijklmnopqrstuvwxyz" "" t))
(setq ap/random-chars-length (length ap/random-chars)))
(let* (s)
(while (< (length s) length)
(setq s (concat s (nth (random ap/random-chars-length) ap/random-chars))))
s))
@ouboub
Copy link

ouboub commented Oct 9, 2021

Hi Adam

I find it very useful for the following purpose,
as you can see

kjambunathan/org-mode-ox-odt#102

We are currently discussing how to export complex tables from org to
odt. I provided some examples, but the original files contained private
information, so to randomise this information, using your approach by
replacing it with words of the same length is very useful.

However it cannot be run on the buffer, since it would then destroy the
markup.

So I added a function which restricts yours to a region (please don't
laugh, this is ancient code and most likely there are much better ways
of doing it

(defun randomise-region ()
  "Like `ap/replace-words-randomly', but only replace inside region if it is active.
If the region is not active, apply the main function from point to the end of the
buffer.  The region is never considered active outside
`transient-mark-mode'. "
  (interactive)
  (if (or (and (boundp 'zmacs-region-active-p) zmacs-region-active-p)
	  (and (boundp 'transient-mark-mode) transient-mark-mode mark-active))
      (save-restriction
        (save-excursion
          (narrow-to-region (point) (mark))
          (goto-char (point-min))
          (ap/replace-words-randomly)))
    (ap/replace-words-randomly)))''''


Which brings me to the next point: couldn't you provide this package as
a MELPA package so that user users can use it more easily?

Thanks and regards

Uwe Brauer 

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment