Lisp Notes on Dan Stefan Oprean

Introduction

Mon, 01 Jan 0001 00:00:00 +0000

Hello World

(format t "Hello, world!~%")

Run with a Common Lisp implementation such as SBCL:

sbcl --script main.lisp

This prints a line in Common Lisp using format, which is a flexible function for building and writing text.

Variables

(defparameter *name* "Dan")
(defparameter *count* 1)
(defparameter *active* t)

These global parameters hold simple values you can reuse across expressions.

Functions

(defun greet (name)
  (format nil "Hello, ~A!" name))

(greet "world")

This defines a function and then calls it. Lisp keeps the function shape compact, even for small reusable helpers.

Add

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Add

(defun add (param1 param2)
  (+ param1 param2))

This just adds the two input numbers with the language’s normal arithmetic and returns the sum.

Add Border

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Add Border

(defun add-border (picture)
  (let* ((width (length (first picture)))
         (border (make-string width :initial-element #\*))
         (wrapped (mapcar (lambda (row) (format nil "*~A*" row))
                           (cons border picture))))
    (append wrapped (list (make-string (+ width 2) :initial-element #\*)))))

This builds a new grid with a * border around every side. It adds a full top and bottom row, then wraps each existing row from left and right.

Adjacent Elements Product

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Adjacent Elements Product

(defun adjacent-elements-product (input-array)
  (let ((vec (coerce input-array 'vector))
        (max-product most-negative-fixnum))
    (dotimes (i (1- (length vec)))
      (setf max-product (max max-product (* (aref vec i) (aref vec (1+ i))))))
    max-product))

This walks through neighboring values, multiplies each pair, and keeps the biggest product it finds.

Almost Magic Square

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Almost Magic Square

(defun almost-magic-square (a)
  (let ((m (make-array '(3 3)))
        (row-sum (make-array 3 :initial-element 0))
        (col-sum (make-array 3 :initial-element 0))
        (max-sum 0))
    (loop for idx from 0 below 9
          for val in a
          do (setf (aref m (floor idx 3) (mod idx 3)) val))
    (dotimes (i 3)
      (dotimes (j 3)
        (incf (aref row-sum i) (aref m i j))
        (incf (aref col-sum i) (aref m j i))))
    (dotimes (k 3)
      (setf max-sum (max max-sum (aref row-sum k) (aref col-sum k))))
    (let ((i 0) (j 0))
      (loop while (and (< i 3) (< j 3))
            do (let ((diff (min (- max-sum (aref row-sum i))
                                 (- max-sum (aref col-sum j)))))
                 (incf (aref m i j) diff)
                 (incf (aref row-sum i) diff)
                 (incf (aref col-sum j) diff)
                 (when (= (aref row-sum i) max-sum) (incf i))
                 (when (and (< j 3) (= (aref col-sum j) max-sum)) (incf j)))))
    (loop for idx from 0 below 9
          collect (aref m (floor idx 3) (mod idx 3)))))

This adjusts the matrix toward a matching target sum so the rows and columns line up more like a magic square.

Are Equally Strong

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Are Equally Strong

(defun are-equally-strong (your-left your-right friends-left friends-right)
  (and (= (max your-right your-left) (max friends-left friends-right))
       (= (min your-left your-right) (min friends-right friends-left))))

This compares each person’s strongest and weakest arm. If both pairs match, the result is true.

Array Change

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Array Change

(defun array-change (a)
  (let ((vec (coerce a 'vector))
        (min 0))
    (dotimes (k (1- (length vec)))
      (when (>= (aref vec k) (aref vec (1+ k)))
        (let ((dif (+ (- (aref vec k) (aref vec (1+ k))) 1)))
          (incf (aref vec (1+ k)) dif)
          (incf min dif))))
    min))

This moves left to right and bumps values only when needed so the array becomes strictly increasing.

Array Maximal Adjacement Difference

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Array Maximal Adjacement Difference

(defun array-maximal-adjacent-difference (a)
  (let* ((vec (coerce a 'vector))
         (c (length vec))
         (dif 0))
    (loop for i from 1 below (1- c)
          do (setf dif (max dif
                             (abs (- (aref vec i) (aref vec (1- i))))
                             (abs (- (aref vec i) (aref vec (1+ i)))))))
    dif))

This checks the gap between each pair of neighbors and returns the largest difference.

Binary Gap

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Binary Gap

(defun binary-gap (n)
  (let* ((bits (write-to-string n :base 2))
         (trimmed (string-trim "0" bits))
         (groups (split-on-char trimmed #\1))
         (gap 0))
    (dolist (zero groups)
      (setf gap (max gap (length zero))))
    gap))

(defun split-on-char (s ch)
  (loop with start = 0
        for pos = (position ch s :start start)
        collect (subseq s start pos)
        while pos
        do (setf start (1+ pos))))

This turns the number into binary, ignores zeroes outside the edges, and finds the longest run of zeroes between 1s.

Bracket

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Bracket

(defun bracket (s)
  (let ((stack '()))
    (loop for v across s
          do (cond
               ((char= v #\))
                (if (or (null stack) (char/= (pop stack) #\())
                    (return-from bracket 0)))
               ((char= v #\])
                (if (or (null stack) (char/= (pop stack) #\[))
                    (return-from bracket 0)))
               ((char= v #\})
                (if (or (null stack) (char/= (pop stack) #\{))
                    (return-from bracket 0)))
               (t (push v stack))))
    (if (null stack) 1 0)))

This uses a simple stack approach: open brackets go in, matching closing brackets pop them out.

Century From Year

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Century From Year

(defun century-from-year (year)
  (ceiling year 100))

This converts a year into its century. Years 1-100 are century 1, 101-200 are century 2, and so on.

Check Palindrome

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Check Palindrome

(defun check-palindrome (input-string)
  (string= (reverse input-string) input-string))

This compares the string with its reverse. If they match, it is a palindrome.

Chocolates By Numbers

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Chocolates By Numbers

(defun choc-gcd (n m)
  (if (zerop (mod n m))
      m
      (choc-gcd m (mod n m))))

(defun chocolates-by-numbers (n m)
  (/ (/ (* n m) (choc-gcd n m)) m))

This uses the greatest common divisor to figure out how many chocolates get eaten before the pattern repeats.

Common Prime Divisors

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Common Prime Divisors

(defun cpd-gcd (n m)
  (if (zerop (mod n m))
      m
      (cpd-gcd m (mod n m))))

(defun remove-common-prime-divisors (n m)
  (loop while (/= n 1)
        do (let ((d (cpd-gcd n m)))
             (when (= d 1)
               (return-from remove-common-prime-divisors n))
             (setf n (/ n d))))
  n)

(defun common-prime-divisors (a b)
  (let ((counter 0))
    (loop for x in a
          for y in b
          do (let* ((d (cpd-gcd x y))
                     (rx (remove-common-prime-divisors x d)))
               (when (= rx 1)
                 (let ((ry (remove-common-prime-divisors y d)))
                   (when (= ry 1)
                     (incf counter))))))
    counter))

This checks whether two numbers are built from the same prime factors by repeatedly dividing out their shared parts.

Count Div

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Count Div

(defun count-div (a b k)
  (let* ((first-div (if (zerop (mod a k)) a (+ a (- k (mod a k)))))
         (last-div (- b (mod b k))))
    (1+ (/ (- last-div first-div) k))))

This counts how many numbers in a range are divisible by K without looping through every value.

Count Factors

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Count Factors

(defun count-factors (n)
  (let ((count 0)
        (i 1))
    (loop while (< (* i i) n)
          do (progn
               (when (zerop (mod n i))
                 (incf count 2))
               (incf i)))
    (when (= (* i i) n)
      (incf count))
    count))

This checks divisors in pairs up to the square root, which keeps the work much smaller than testing every number.

Count Non Divisible

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Count Non Divisible

(defun count-non-divisible (a)
  (let* ((vec (coerce a 'vector))
         (size (length vec))
         (occurrences (make-array (1+ (reduce #'max vec)) :initial-element 0)))
    (loop for v across vec do (incf (aref occurrences v)))
    (loop for v across vec
          collect (let ((count 0) (i 1))
                    (loop while (<= (* i i) v)
                          do (progn
                               (when (zerop (mod v i))
                                 (incf count (aref occurrences i))
                                 (unless (= (/ v i) i)
                                   (incf count (aref occurrences (/ v i)))))
                               (incf i)))
                    (- size count)))))

This counts how often each value appears, then subtracts the divisor matches so you get the non-divisible count for each item.

Count Semi Primes

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Count Semi Primes

(defun count-semi-primes (n p q)
  (let ((primes (make-array (1+ n) :initial-element t))
        (semi-primes (make-array (1+ n) :initial-element 0)))
    (loop for i from 2 while (<= (* i i) n)
          do (when (aref primes i)
               (loop for k from (* i i) to n by i
                     do (setf (aref primes k) nil))))
    (loop for k from 2 while (<= (* k k) n)
          do (when (aref primes k)
               (loop for i from 2 while (<= (* i k) n)
                     do (when (aref primes i)
                          (setf (aref semi-primes (* k i)) 1)))))
    (loop for i from 1 to n
          do (incf (aref semi-primes i) (aref semi-primes (1- i))))
    (loop for v in p
          for qi in q
          collect (- (aref semi-primes qi) (aref semi-primes (1- v))))))

This precomputes semiprimes and prefix sums so each range query becomes a quick subtraction.

Cyclic Rotation

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Cyclic Rotation

(defun cyclic-rotation (a k)
  (if (null a)
      a
      (let ((result (copy-list a)))
        (dotimes (i k)
          (let ((last (car (last result))))
            (setf result (cons last (butlast result)))))
        result)))

This rotates the array to the right by K steps and keeps the wrap-around values in the correct order.

Distinct

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Distinct

(defun distinct (a)
  (length (remove-duplicates a :test #'equal)))

This counts unique values by tracking what has already been seen.

Dominator

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Dominator

(defun dominator (a)
  (let ((vec (coerce a 'vector))
        (size 0) (value 0) (index 0))
    (loop for k from 0 below (length vec)
          for v = (aref vec k)
          do (cond
               ((zerop size) (incf size) (setf value v) (setf index k))
               ((/= value v) (decf size))
               (t (incf size))))
    (let ((candidate (if (> size 0) value -1))
          (count 0))
      (loop for v across vec do (when (= v candidate) (incf count)))
      (when (<= count (/ (length vec) 2))
        (setf index -1))
      index)))

This finds a value that appears in more than half of the array, then returns one valid index for it.

Equi Leader

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Equi Leader

(defun equi-leader (a)
  (let ((vec (coerce a 'vector))
        (leader-size 0) (value 0))
    (loop for v across vec
          do (cond
               ((zerop leader-size) (incf leader-size) (setf value v))
               ((/= value v) (decf leader-size))
               (t (incf leader-size))))
    (let* ((candidate (if (> leader-size 0) value -1))
           (leader-count 0))
      (loop for v across vec do (when (= v candidate) (incf leader-count)))
      (let ((leader (if (> leader-count (/ (length vec) 2)) candidate -1))
            (count (length vec))
            (l-leader-count 0)
            (equi-leaders 0))
        (loop for k from 0 below count
              for v = (aref vec k)
              do (let ((left-half (floor (1+ k) 2))
                       (right-half (floor (- count k 1) 2)))
                   (when (= v leader) (incf l-leader-count))
                   (let ((r-leader-count (- leader-count l-leader-count)))
                     (when (and (> l-leader-count left-half)
                                (> r-leader-count right-half))
                       (incf equi-leaders)))))
        equi-leaders))))

This keeps leader counts on both sides of the split and counts positions where the same leader survives in each half.

Fib Frog

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Fib Frog

(defun fib-frog (a)
  (let* ((vec (coerce a 'vector))
         (size (length vec))
         (fib (make-array 2 :initial-contents '(0 1) :adjustable t :fill-pointer 2)))
    (let ((i 1))
      (loop while (<= (aref fib i) size)
            do (progn
                 (incf i)
                 (vector-push-extend (+ (aref fib (1- i)) (aref fib (- i 2))) fib))))
    (let ((paths (list (list :idx -1 :jmp 0)))
          (steps (make-array size :initial-element nil)))
      (loop while paths
            do (let ((path (pop paths)))
                 (loop for i from (1- (length fib)) downto 2
                       do (let ((idx (+ (getf path :idx) (aref fib i))))
                            (cond
                              ((= idx size) (return-from fib-frog (1+ (getf path :jmp))))
                              ((or (> idx size)
                                   (aref steps idx)
                                   (zerop (aref vec idx)))
                               nil)
                              ((= (aref vec idx) 1)
                               (setf (aref steps idx) t)
                               (setf paths (append paths (list (list :idx idx :jmp (1+ (getf path :jmp))))))))))))
      -1)))

This precomputes Fibonacci jumps, then uses a breadth-first search to find the shortest valid path across the river.

Fish

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Fish

(defun fish (a b)
  (let* ((veca (coerce a 'vector))
         (vecb (coerce b 'vector))
         (size (length veca))
         (dead 0)
         (stack '()))
    (dotimes (i size)
      (if (= (aref vecb i) 1)
          (push (aref veca i) stack)
          (when stack
            (loop while stack
                  do (progn
                       (incf dead)
                       (if (> (aref veca i) (first stack))
                           (pop stack)
                           (return)))))))
    (- size dead)))

This uses a stack for downstream fish and resolves fights only when opposite directions meet.

Flags

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Flags

(defun flags (a)
  (let* ((vec (coerce a 'vector))
         (size (length vec))
         (peaks (make-array size :initial-element nil))
         (next (make-array size :initial-element -1)))
    (loop for i from 1 below size
          do (setf (aref peaks i)
                   (and (< (aref vec (1- i)) (aref vec i))
                        (> (aref vec i) (if (< (1+ i) size) (aref vec (1+ i)) 0)))))
    (setf (aref next (1- size)) -1)
    (loop for i from (- size 2) downto 0
          do (setf (aref next i) (if (aref peaks i) i (aref next (1+ i)))))
    (let ((i 1) (result 0))
      (loop while (<= (* i (1- i)) size)
            do (let ((pos 0) (num 0))
                 (loop while (and (< pos size) (< num i))
                       do (progn
                            (setf pos (aref next pos))
                            (when (= pos -1) (return))
                            (incf num)
                            (incf pos i)))
                 (incf i)
                 (setf result (max result num))))
      result)))

This finds all peaks first, then checks how many flags can be placed while keeping the required distance.

Frog Jmp

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Frog Jmp

(defun frog-jmp (x y d)
  (ceiling (- y x) d))

This computes the jump count with math instead of simulation, which is the cleanest way to solve it.

Frog River One

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Frog River One

(defun frog-river-one (x a)
  (let ((existing (make-hash-table)))
    (loop for k from 0
          for i in a
          do (when (and (not (gethash i existing)) (<= i x))
               (setf (gethash i existing) i)
               (when (= (hash-table-count existing) x)
                 (return-from frog-river-one k))))
    -1))

This tracks the earliest time each needed position appears and stops as soon as the frog can cross.

Genomic Range Query

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Genomic Range Query

(defun genomic-range-query (s p q)
  (loop for pi in p
        for qi in q
        collect (let ((sub (subseq s pi (1+ qi))))
                  (cond
                    ((find #\A sub) 1)
                    ((find #\C sub) 2)
                    ((find #\G sub) 3)
                    (t 4)))))

This builds prefix counts for each DNA letter so every query can return the minimum impact factor quickly.

Is Ipv 4 Adress

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Is Ipv 4 Adress

(defun split-on-char (s ch)
  (loop with start = 0
        for pos = (position ch s :start start)
        collect (subseq s start pos)
        while pos
        do (setf start (1+ pos))))

(defun is-ipv4-address (input-string)
  (let ((parts (split-on-char input-string #\.)))
    (and (= (length parts) 4)
         (every (lambda (v)
                  (and (> (length v) 0)
                       (every #'digit-char-p v)
                       (<= (parse-integer v) 255)
                       (string= v (write-to-string (parse-integer v)))))
                parts))))

This splits the string by dots and validates each part as a normal IPv4 octet.

Ladder

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Ladder

(defun ladder (a b)
  (let* ((veca (coerce a 'vector))
         (vecb (coerce b 'vector))
         (size (length veca))
         (modulus (1- (ash 1 (reduce #'max vecb))))
         (limit (reduce #'max veca))
         (fib (make-array (+ limit 2) :initial-element 0)))
    (setf (aref fib 1) 1)
    (loop for i from 2 below (+ limit 2)
          do (setf (aref fib i) (logand (+ (aref fib (1- i)) (aref fib (- i 2))) modulus)))
    (loop for i from 0 below size
          collect (logand (aref fib (1+ (aref veca i))) (1- (ash 1 (aref vecb i)))))))

This precomputes climb counts once and applies the modulo per query, which avoids recalculating the same paths over and over.

Largest String

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Largest String

(defun largest-string (s)
  (let* ((str (copy-seq s))
         (len (length str))
         (cur "")
         (i (1- len)))
    (loop while (>= i 0)
          do (progn
               (setf cur (concatenate 'string (string (char str i)) cur))
               (when (= (length cur) 3)
                 (when (string= cur "abb")
                   (setf (char str i) #\b)
                   (setf (char str (+ i 1)) #\a)
                   (setf (char str (+ i 2)) #\a)
                   (cond
                     ((and (< (+ i 4) len) (char= (char str (+ i 4)) #\b))
                      (incf i (+ 4 1)))
                     ((and (< (+ i 3) len) (char= (char str (+ i 3)) #\b))
                      (incf i (+ 3 1)))
                     ((char= (char str (+ i 2)) #\b)
                      (incf i (+ 2 1)))))
                 (if (char= (char str (+ i 1)) #\b)
                     (incf i (+ 1 1))
                     (incf i))
                 (setf cur ""))
               (decf i)))
    str))

This builds the biggest valid string it can under the challenge rules by always choosing the best next character it is allowed to use.

Max Counters

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Max Counters

(defun max-counters (n a)
  (let ((counters (make-array n :initial-element 0))
        (max-counter 0)
        (last-update 0)
        (condition (1+ n)))
    (dolist (v a)
      (when (<= v n)
        (let ((index (1- v)))
          (when (< (aref counters index) last-update)
            (setf (aref counters index) last-update))
          (incf (aref counters index))
          (setf max-counter (max max-counter (aref counters index)))))
      (when (= v condition)
        (setf last-update max-counter)))
    (dotimes (k n)
      (when (< (aref counters k) last-update)
        (setf (aref counters k) last-update)))
    (coerce counters 'list)))

This delays the expensive “set all counters to max” work until it is really needed, which keeps the solution fast.

Max Double Slice Sum

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Max Double Slice Sum

(defun max-double-slice-sum (a)
  (let* ((vec (coerce a 'vector))
         (size (length vec)))
    (if (< size 3)
        0
        (let ((p1 (make-array size :initial-element 0))
              (p2 (make-array size :initial-element 0)))
          (setf (aref p1 1) 0)
          (setf (aref p2 (- size 2)) 0)
          (loop for i from 2 below (1- size)
                do (progn
                     (setf (aref p1 i) (max 0 (+ (aref p1 (1- i)) (aref vec (1- i)))))
                     (setf (aref p2 (- size i 1)) (max 0 (+ (aref p2 (- size i)) (aref vec (- size i)))))))
          (let ((sum (+ (aref p1 1) (aref p2 1))))
            (loop for i from 1 below (1- size)
                  do (setf sum (max sum (+ (aref p1 i) (aref p2 i)))))
            sum)))))

This keeps the best sum ending on the left and starting on the right, then combines them around each middle position.

Max Product Of Three

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Max Product Of Three

(defun max-product-of-three (a)
  (let* ((sorted (sort (copy-list a) #'<))
         (vec (coerce sorted 'vector))
         (c (length vec)))
    (max (* (aref vec (- c 1)) (aref vec (- c 2)) (aref vec (- c 3)))
         (* (aref vec 0) (aref vec 1) (aref vec (- c 1))))))

This checks the useful extremes, because the best product can come from either the three largest numbers or two negatives plus one large positive.

Max Profit

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Max Profit

(defun max-profit (a)
  (let ((price (first a))
        (profit 0))
    (dolist (v a)
      (setf price (min price v))
      (setf profit (max profit (- v price))))
    profit))

This tracks the lowest buy price seen so far and updates the best profit as it scans the prices once.

Max Slice Sum

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Max Slice Sum

(defun max-slice-sum (a)
  (let ((tmp most-negative-fixnum)
        (max most-negative-fixnum))
    (dolist (v a)
      (setf tmp (max (+ tmp v) v))
      (setf max (max max tmp)))
    max))

This is a Kadane-style scan: keep the best running sum and the best overall sum while moving once through the array.

Min Avg Two Slice

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Min Avg Two Slice

(defun min-avg-two-slice (a)
  (let* ((vec (coerce a 'vector))
         (count (length vec))
         (idx 0)
         (min (/ (+ (aref vec 0) (aref vec 1)) 2.0)))
    (loop for i from 0 below (1- count)
          do (let ((cur (/ (+ (aref vec i) (aref vec (1+ i))) 2.0)))
               (when (< (+ i 2) count)
                 (let ((three (/ (+ (aref vec i) (aref vec (1+ i)) (aref vec (+ i 2))) 3.0)))
                   (setf cur (min cur three))))
               (when (< cur min)
                 (setf min cur)
                 (setf idx i))))
    idx))

This leans on the key trick for this problem: the minimum average slice is always length 2 or 3.

Min Perimeter Rectangle

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Min Perimeter Rectangle

(defun min-perimeter-rectangle (n)
  (let ((i 1)
        (min most-positive-fixnum))
    (loop while (< (* i i) n)
          do (progn
               (when (zerop (mod n i))
                 (setf min (min min (* 2 (+ i (/ n i))))))
               (incf i)))
    min))

This searches factor pairs up to the square root and picks the pair with the smallest perimeter.

Missing Integer

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Missing Integer

(defun missing-integer (a)
  (let ((sorted (sort (remove-duplicates (copy-list a) :test #'=) #'<))
        (min 1))
    (loop for v in sorted
          do (when (> v 0)
               (if (/= min v)
                   (return)
                   (incf min))))
    min))

This records the positive numbers that exist, then returns the smallest positive value that is still missing.

Nesting

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Nesting

(defun nesting (s)
  (if (zerop (length s))
      1
      (let ((stack '()))
        (loop for v across s
              do (if (char= v #\))
                     (if (or (null stack) (char/= (pop stack) #\())
                         (return-from nesting 0))
                     (push v stack)))
        (if (null stack) 1 0))))

This treats the string like a balance counter: open parentheses add one, closing ones remove one.

Number Of Disc Intersections

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Number Of Disc Intersections

(defun number-of-disc-intersections (a)
  (let* ((vec (coerce a 'vector))
         (c (length vec))
         (start (make-array c :initial-element 0))
         (end (make-array c :initial-element 0))
         (sum 0)
         (active 0))
    (loop for k from 0 below c
          for v = (aref vec k)
          do (let ((key1 (if (< k v) 0 (- k v)))
                    (key2 (if (>= (+ k v) c) (1- c) (+ k v))))
               (incf (aref start key1))
               (incf (aref end key2))))
    (loop for k from 0 below c
          do (progn
               (incf sum (+ (* active (aref start k))
                            (/ (* (aref start k) (1- (aref start k))) 2)))
               (incf active (- (aref start k) (aref end k)))
               (when (> sum 10000000)
                 (return-from number-of-disc-intersections -1))))
    sum))

This sorts disc start and end points and counts active overlaps without comparing every pair directly.

Odd Occurrences In Array

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Odd Occurrences In Array

(defun odd-occurrences-in-array (a)
  (let ((counts (make-hash-table :test 'eql)))
    (dolist (v a)
      (incf (gethash v counts 0)))
    (loop for v being the hash-keys of counts using (hash-value c)
          when (oddp c)
            return v)))

This uses XOR to cancel out pairs, leaving only the value that appears an odd number of times.

Palindrome Rearranging

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Palindrome Rearranging

(defun palindrome-rearranging (input-string)
  (let ((counts (make-hash-table :test 'eql))
        (c 0))
    (loop for ch across input-string
          do (incf (gethash ch counts 0)))
    (loop for v being the hash-values of counts
          do (when (oddp v) (incf c)))
    (<= c 1)))

This counts character frequency and checks whether the string has the right number of odd counts to form a palindrome.

Passing Cars

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Passing Cars

(defun passing-cars (a)
  (let ((passing-cars 0)
        (multiply 0))
    (dolist (i a)
      (if (zerop i)
          (incf multiply)
          (when (> multiply 0)
            (incf passing-cars multiply)
            (when (> passing-cars 1000000000)
              (return-from passing-cars -1)))))
    passing-cars))

This counts eastbound cars as it scans, then adds them whenever a westbound car appears.

Peaks

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Peaks

(defun peaks (a)
  (let ((n (length a)))
    (if (<= n 2)
        0
        (let* ((vec (coerce a 'vector))
               (sum (make-array n :initial-element 0))
               (last -1)
               (dist 0))
          (loop for i from 1 below (1- n)
                do (progn
                     (setf (aref sum i) (aref sum (1- i)))
                     (when (and (> (aref vec i) (aref vec (1- i)))
                                (> (aref vec i) (aref vec (1+ i))))
                       (setf dist (max dist (- i last)))
                       (setf last i)
                       (incf (aref sum i)))))
          (setf (aref sum (1- n)) (aref sum (- n 2)))
          (if (zerop (aref sum (1- n)))
              0
              (progn
                (setf dist (max dist (- n last)))
                (loop for i from (1+ (ash dist -1)) below dist
                      do (when (zerop (mod n i))
                           (let ((lst 0)
                                 (j i))
                             (loop while (<= j n)
                                   do (if (<= (aref sum (1- j)) lst)
                                          (return)
                                          (progn
                                            (setf lst (aref sum (1- j)))
                                            (incf j i))))
                             (when (> j n)
                               (return-from peaks (floor n i))))))
                (setf last dist)
                (loop while (/= 0 (mod n last))
                      do (incf last))
                (floor n last)))))))

This finds the peak positions, then tests how many equal blocks can each contain at least one peak.

Perm Check

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Perm Check

(defun perm-check (a)
  (let* ((sorted (sort (copy-list a) #'<))
         (vec (coerce sorted 'vector))
         (n (length vec)))
    (loop for k from 0 below n
          do (when (and (< (1+ k) n) (/= (aref vec k) (1+ k)))
               (return-from perm-check 0)))
    1))

This validates that every value from 1 to N appears exactly once.

Perm Missing Element

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Perm Missing Element

(defun perm-missing-element (a)
  (let* ((sorted (sort (copy-list a) #'<))
         (vec (coerce sorted 'vector)))
    (loop for k from 0 below (length vec)
          do (when (/= (aref vec k) (1+ k))
               (return-from perm-missing-element (1+ k))))
    (1+ (length vec))))

This uses the expected sum of 1..N+1 and subtracts the actual sum to find the missing value.

Plagiarism Check

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Plagiarism Check

(defun word-char-p (ch)
  (or (alphanumericp ch) (char= ch #\_)))

(defun word-tokens (s)
  (let ((tokens '())
        (n (length s))
        (i 0))
    (loop while (< i n)
          do (if (word-char-p (char s i))
                 (let ((start i))
                   (loop while (and (< i n) (word-char-p (char s i)))
                         do (incf i))
                   (push (subseq s start i) tokens))
                 (incf i)))
    (nreverse tokens)))

(defun numeric-token-p (tok)
  (and (> (length tok) 0) (every #'digit-char-p tok)))

(defun boundary-replace (str token replacement)
  (let ((out (make-string-output-stream))
        (tlen (length token))
        (n (length str))
        (i 0))
    (loop while (< i n)
          do (let ((pos (search token str :start2 i)))
               (cond
                 ((null pos)
                  (write-string str out :start i :end n)
                  (setf i n))
                 ((and (> pos 0) (not (word-char-p (char str (1- pos)))))
                  (write-string str out :start i :end pos)
                  (write-string replacement out)
                  (setf i (+ pos tlen)))
                 (t
                  (write-string str out :start i :end (1+ pos))
                  (setf i (1+ pos))))))
    (get-output-stream-string out)))

(defun plagiarism-check (code1 code2)
  (let ((c1 (format nil "~{~A~^ ~}" code1))
        (c2 (format nil "~{~A~^ ~}" code2)))
    (if (string= c1 c2)
        nil
        (let ((d1 (word-tokens c1))
              (d2 (word-tokens c2))
              (r-cand (make-hash-table :test 'equal))
              (r-order '()))
          (loop for v in d1
                for w in d2
                do (when (and (not (string= v w)) (not (numeric-token-p v)))
                     (unless (nth-value 1 (gethash v r-cand))
                       (push v r-order))
                     (setf (gethash v r-cand) w)))
          (setf r-order (nreverse r-order))
          (dolist (orig r-order)
            (setf c1 (boundary-replace c1 orig (concatenate 'string "PLACEHOLDER" orig))))
          (dolist (orig r-order)
            (setf c1 (boundary-replace c1 (concatenate 'string "PLACEHOLDER" orig) (gethash orig r-cand))))
          (string= c1 c2)))))

This flattens both snippets, tries consistent identifier replacements, and checks whether the rewritten code matches.

Shape Area

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Shape Area

(defun shape-area (n)
  (if (> n 1)
      (+ (shape-area (1- n)) (* 4 (1- n)))
      1))

This returns the area of the growing n-interesting polygon using the direct formula instead of building the shape.

Stone Blocks

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Stone Blocks

(defun stone-blocks (h)
  (let* ((n (length h))
         (height (make-array n :initial-element 0))
         (index 0)
         (blocks 0))
    (dolist (i h)
      (loop while (and (> index 0) (> (aref height (1- index)) i))
            do (decf index))
      (unless (and (> index 0) (= (aref height (1- index)) i))
        (setf (aref height index) i)
        (incf blocks)
        (incf index)))
    blocks))

This uses a stack of active heights and only counts a new block when the wall needs a new height segment.

Tape Equilibrium

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Tape Equilibrium

(defun tape-equilibrium (a)
  (let* ((vec (coerce a 'vector))
         (n (length vec))
         (first-part 0)
         (second-part (reduce #'+ vec))
         (min most-positive-fixnum))
    (loop for i from 0 below (1- n)
          do (progn
               (incf first-part i)
               (decf second-part i)
               (let ((difference (abs (- first-part second-part))))
                 (setf min (if (< difference min) difference min)))))
    min))

This keeps left and right running sums and updates the smallest difference at each split point.

Triangle

Mon, 01 Jan 0001 00:00:00 +0000

Lisp Triangle

(defun triangle (a)
  (let* ((sorted (sort (copy-list a) #'<))
         (vec (coerce sorted 'vector))
         (c (length vec)))
    (if (< c 3)
        0
        (progn
          (loop for i from 0 below (- c 2)
                do (when (and (> (aref vec i) 0)
                              (> (aref vec i) (- (aref vec (+ i 2)) (aref vec (1+ i)))))
                     (return-from triangle 1)))
          0))))

This sorts the values and checks nearby triples, because a valid triangle only needs one local match after sorting.