Throttle/debounce a Common Lisp function

#lisp #commonlisp

A typical use case of debouncing function calls is an interactive text input: let the user type a search query, but wait for 500ms before sending a request to your application, so than you don't send a potentially expensive request at each key press.

I was wondering how to do that, so a quick (apropos "debounce") in my Lisp image brought me to the method implemented in the nodgui GUI framework (Tk bindings).

It boils down to this:

(defun calculate-internal-time-scaling-millis (&optional (scaling 1000))
  (if (<= (/ internal-time-units-per-second scaling)
          1000)
      scaling
      (calculate-internal-time-scaling-millis (* 10 scaling))))

(defparameter *internal-time-scaling-millis* (calculate-internal-time-scaling-millis))

(defparameter *debounce-minimum-delay* 120
  "milliseconds")

(defun calculate-milliseconds-elapsed ()
  (truncate (/ (get-internal-real-time)
               *internal-time-scaling-millis*)))

(defmacro lambda-debounce (args &body body)
  (alexandria:with-gensyms (last-fired saved-last-fired fired-time results)
    `(let ((,last-fired (calculate-milliseconds-elapsed)))
       (lambda ,args
         (let ((,fired-time (calculate-milliseconds-elapsed))
               (,saved-last-fired ,last-fired)
               (,results nil))
           (log:info ,fired-time ,saved-last-fired (- ,fired-time ,saved-last-fired))
           (when (> (- ,fired-time ,saved-last-fired)
                    *debounce-minimum-delay*)
             (log:info "running body…")
             (setf ,results (progn ,@body)))
           (setf ,last-fired
                 (calculate-milliseconds-elapsed))
           ,results)))))

and it is used like this in the framework (which isn't very important for us, we just acknowledge it is used on UI events)

(defun autocomplete-key-press-clsr (candidates-widget
                                    autocomplete-entry-widget
                                    autocomplete-function)
  (let ((ignore-next-key nil))
    (lambda-debounce (event)
      (cond
        (ignore-next-key
         (setf ignore-next-key nil))
        ((scan "(?i)(control|alt)" (event-char event))
         (setf ignore-next-key t))
        ;; etc
;; …
    (bind autocomplete-entry-widget
          #$<KeyPress>$
          (autocomplete-key-press-clsr candidates-widget
                                       autocomplete-entry-widget
                                       autocomplete-function)

Here's a quick example for us:

(defun generate-event-calls ()
  (loop repeat 3
        collect
        (lambda-debounce ()
          "hello?")))

(loop for fn in (generate-event-calls)
      for ms in '(0.001 0.1 0.021)
      collect
        (progn
         (sleep ms)
         (funcall fn)))

which gives (NIL NIL "hello?").

How does it work?

The important bit is

    `(let ((,last-fired (calculate-milliseconds-elapsed)))
       (lambda ,args

the let binds a variable before returning a function, effectively creating a closure common to all lambdas. Later on, the last-fired variable is compared to the current time, the time the function is called. When the time difference is significant, we run the macro body and our program logic.

All lambdas are tested if they should be run. Our first one is tested after 1ms: it is discarded. The second one, after 100 + 1 ms: still discarded. The third one after 1 + 100 + 21ms since the macro expansion time and last-fired was first set: our macro body is run.

my 2c.

Top comments (1)

vindarel • Feb 21

Here's another version: gitlab.com/fstamour/cache-cache/-/...

(defun make-debouncer (delay-in-seconds callback)
  ;; TODO there's probably a bunch of race conditions...
  (let ((last-time)
        (thread)
        (saved-args))
    (labels ((now ()
               (/ (get-internal-real-time)
                  #.(float internal-time-units-per-second)))
             (update-last-time (now)
               (setf last-time now))
             (overduep (now)
               (and last-time
                    (<= delay-in-seconds (- now last-time))))
             (actually-call (now args)
               (update-last-time now)
               (setf thread nil)
               (apply callback args))
             (wait-loop ()
               (loop
                 :for now = (now)
                 :until (overduep now)
                 :do (let ((delay (max 0.025 (- (+ last-time delay-in-seconds) now))))
                       #++ (progn (format *debug-io* "~&About to sleep ~s seconds" delay)
                                  (force-output *debug-io*))
                       (sleep delay)))
               (actually-call (now) saved-args))
             (maybe-funcall (&rest args)
               (update-last-time (now))
               (setf saved-args args)
               (unless thread
                 (setf thread (bt:make-thread #'wait-loop
                                              :name "Debouncer thread")))
               last-time))
      #'maybe-funcall)))

no macro \o/

A single thread waits a minimum amount of time, in the meantime the arguments given from the user are updated.

reminder: labels is like let but to create local functions.

DEV Community

Throttle/debounce a Common Lisp function

Top comments (1)

Read next

Uncover Language Models' Struggle to Accurately Cite Scientific Claims

relational operators C++

1342. Number of Steps to Reduce a Number to Zero

Tailoring Language Giants: Survey of Personalized Large Language Models