DEV Community

vindarel
vindarel

Posted on

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)))))
Enter fullscreen mode Exit fullscreen mode

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)
Enter fullscreen mode Exit fullscreen mode

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)))
Enter fullscreen mode Exit fullscreen mode

which gives (NIL NIL "hello?").

How does it work?

The important bit is

    `(let ((,last-fired (calculate-milliseconds-elapsed)))
       (lambda ,args
Enter fullscreen mode Exit fullscreen mode

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)

Collapse
 
vindarel profile image
vindarel •

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)))
Enter fullscreen mode Exit fullscreen mode

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.

Read next

sohaibilyas profile image

Unlocking Linux on Windows: A Guide to Installing Ubuntu Using WSL 2 on Windows 11

Sohaib Ilyas -

aishwarya_raj_978520e6399 profile image

Python Asynchronous Programming: Simplifying Concurrency Like a Pro

Aishwarya Raj -

suin profile image

Deploying Helm Charts to Multiple Kubernetes Clusters with Cluster API's HelmChartProxy

suin -

ashwini_ashu profile image

How is B Tech Ai Revolutionising the Field of Education?

Ashwini ashu -