Lisp Interview Questions with Answers

;; Hello World in Lisp
(format t "Hello, World!")

;; Variables in Lisp
(defparameter *mutable-var* "Hello")  ; Mutable variable (global)
(defvar *immutable-var* "World")       ; Immutable variable (global)
(let ((local-var "Local"))            ; Local variable
  (format t local-var))

;; Type inference and dynamic typing
(setf *mutable-var* "Updated")
(format t *mutable-var*)

;; Data Types in Lisp
;; Numbers
(defparameter *int-num* 10)
(defparameter *float-num* 3.14)
(defparameter *ratio-num* 1/2)

;; Booleans
(defparameter *is-active* t)  ; t for true
(defparameter *is-inactive* nil) ; nil for false

;; Characters
(defparameter *char* #\A)

;; Strings
(defparameter *str* "Hello Lisp")

;; Symbols
(defparameter *sym* 'hello-symbol)

;; Lists
(defparameter *list* '(1 2 3 4 5))

;; Arrays
(defparameter *array* (make-array 5 :initial-contents '(1 2 3 4 5)))

;; Type checking
(typep 10 'integer) ; t

;; Functions in Lisp
;; Basic function
(defun add (a b)
  (+ a b))

;; Function with documentation
(defun subtract (a b)
  "Subtract b from a"
  (- a b))

;; Default parameters not directly supported in Common Lisp
;; But can be simulated
(defun greet (&optional (name "Guest"))
  (format nil "Hello, ~a!" name))

;; Function with multiple return values
(defun divide (a b)
  (values (/ a b) (mod a b)))

;; Higher-order function
(defun operate (a b operation)
  (funcall operation a b))

;; Lambda expression
(defparameter *multiply* (lambda (a b) (* a b)))

;; Usage
(format t "~a" (add 5 3))
(format t "~a" (subtract 10 4))
(format t "~a" (greet "Alice"))
(format t "~a" (operate 6 7 *multiply*))

;; Arrays in Lisp
;; Array creation
(defparameter *numbers* (make-array 5 :initial-contents '(1 2 3 4 5)))
(defparameter *strings* (make-array 3 :initial-contents '("Apple" "Banana" "Orange")))

;; Access and modify
(aref *numbers* 2) ; Access element (0-indexed)
(setf (aref *numbers* 2) 10) ; Modify element

;; Array operations
(array-dimension *numbers* 0) ; Size
(array-dimensions *numbers*) ; Dimensions

;; Iteration
(dotimes (i (length *numbers*))
  (format t "~a " (aref *numbers* i)))

;; Vector (1D array)
(defparameter *vector* #(1 2 3 4 5))

;; Map over array
(map 'vector (lambda (x) (* x 2)) *numbers*)

;; Lists vs Arrays
(defparameter *list* '(1 2 3)) ; List
(defparameter *array-2* (make-array 3 :initial-contents '(1 2 3))) ; Array

;; Collections in Lisp
;; Lists
(defparameter *immutable-list* '(1 2 3 4 5))
(defparameter *mutable-list* (list 1 2 3))
(setf (cdr (cdr *mutable-list*)) (list 4)) ; Modify list

;; Sets (using lists)
(defparameter *set* (remove-duplicates '(1 2 3 3))) ; (1 2 3)

;; Hash tables (maps)
(defparameter *immutable-map* '((key1 . value1) (key2 . value2)))
(defparameter *mutable-map* (make-hash-table))
(setf (gethash 'key1 *mutable-map*) "value1")
(setf (gethash 'key2 *mutable-map*) "value2")

;; Collection operations
(defparameter *numbers* '(1 2 3 4 5 6))
(defparameter *evens* (remove-if-not #'evenp *numbers*))
(defparameter *doubled* (mapcar (lambda (x) (* x 2)) *numbers*))
(defparameter *sum* (reduce #'+ *numbers*))
(defparameter *exists* (some (lambda (x) (> x 10)) *numbers*))
(defparameter *all-even* (every #'evenp *numbers*))

(format t "~a" *evens*)
(format t "~a" *doubled*)
(format t "~a" *sum*)

;; Structs (Data Classes) in Lisp
;; Define structure similar to data class
(defstruct person
  name
  age
  (city "Unknown"))

;; Usage
(defparameter *person1* (make-person :name "Alice" :age 25 :city "NYC"))
(defparameter *person2* (copy-person *person1*)) ; Copy
(setf (person-age *person2*) 26) ; Modify copy

;; Accessors
(person-name *person1*)
(person-age *person1*)
(person-city *person1*)

(format t "~a" *person1*)

;; Sealed Classes in Lisp (using CLOS)
;; Define generic function
(defgeneric handle-result (result))

;; Define classes
(defclass success ()
  ((data :initarg :data :accessor data)))

(defclass error ()
  ((message :initarg :message :accessor message)))

(defclass loading ()
  ())

;; Implement methods
(defmethod handle-result ((result success))
  (format t "Success: ~a" (data result)))

(defmethod handle-result ((result error))
  (format t "Error: ~a" (message result)))

(defmethod handle-result ((result loading))
  (format t "Loading..."))

;; Sealed interfaces simulation
(defgeneric area (shape))

(defclass circle ()
  ((radius :initarg :radius :accessor radius)))

(defclass rectangle ()
  ((width :initarg :width :accessor width)
   (height :initarg :height :accessor height)))

(defclass point ()
  ())

(defmethod area ((shape circle))
  (* pi (expt (radius shape) 2)))

(defmethod area ((shape rectangle))
  (* (width shape) (height shape)))

(defmethod area ((shape point))
  0)

;; Usage
(handle-result (make-instance 'success :data "Data loaded"))
(format t "~a" (area (make-instance 'circle :radius 5.0)))

;; Null Safety in Lisp
;; Lisp doesn't have built-in null safety like Kotlin
;; But we can implement patterns

;; Sentinel values
(defparameter *unset* :unset)

;; Safe access function
(defun safe-length (list)
  (if list (length list) 0))

;; Safe call pattern
(defun safe-call (obj &optional default)
  (if obj (funcall obj) default))

;; Elvis operator equivalent
(defun elvis (value default)
  (if value value default))

;; Safe casting
(defun safe-type (obj type)
  (if (typep obj type) obj nil))

;; Let function for null checks
(defun process-string (str)
  (when str
    (format t "String is: ~a" str)
    (format t "Length: ~a" (length str))))

;; Usage
(process-string "Hello")
(process-string nil)
(elvis nil "default")
(safe-type 10 'integer)

;; Control Flow in Lisp
;; If-else expression
(defparameter *age* 25)
(defparameter *status* (if (< *age* 18) "Minor" "Adult"))
(format t *status*)

;; Cond (switch replacement)
(defparameter *grade* 'A)
(defparameter *result* (cond
                         ((eq *grade* 'A) "Excellent")
                         ((eq *grade* 'B) "Good")
                         ((eq *grade* 'C) "Fair")
                         (t "Needs Improvement")))
(format t *result*)

;; Cond with ranges
(defparameter *score* 85)
(defparameter *grade2* (cond
                         ((<= 90 *score* 100) "A")
                         ((<= 80 *score* 89) "B")
                         ((<= 70 *score* 79) "C")
                         (t "F")))

;; For loop (using dotimes)
(dotimes (i 5)
  (format t "~a " i))

;; For loop with step
(loop for i from 1 to 10 by 2
      do (format t "~a " i))

;; For loop down to
(loop for i from 10 downto 1
      do (format t "~a " i))

;; While loop
(defparameter *i* 0)
(loop while (< *i* 5)
      do (format t "~a " *i*)
         (incf *i*))

;; Do-while loop
(loop do (format t "~a " *i*)
         (decf *i*)
      while (> *i* 0))

;; Classes and Inheritance in Lisp (CLOS)
;; Base class
(defclass animal ()
  ((name :initarg :name :accessor name)))

;; Generic function
(defgeneric make-sound (animal))

;; Derived class
(defclass dog (animal)
  ((breed :initarg :breed :accessor breed)))

(defmethod make-sound ((animal animal))
  (format t "Animal sound"))

(defmethod make-sound ((dog dog))
  (format t "Woof!"))

;; Abstract class simulation
(defclass vehicle ()
  ((started :initform nil :accessor started)))

(defgeneric start (vehicle))

(defmethod start ((vehicle vehicle))
  (setf (started vehicle) t)
  (format t "Started"))

;; Interface simulation (using generic functions)
(defgeneric fly (obj))
(defgeneric land (obj))
(defgeneric swim (obj))

(defclass duck ()
  ())

(defmethod fly ((duck duck))
  (format t "Flying"))

(defmethod land ((duck duck))
  (format t "Landing..."))

(defmethod swim ((duck duck))
  (format t "Swimming"))

;; Usage
(defparameter *dog* (make-instance 'dog :name "Rex" :breed "German Shepherd"))
(make-sound *dog*)
(name *dog*)

(defparameter *duck* (make-instance 'duck))
(fly *duck*)
(swim *duck*)

;; Properties in Lisp (using CLOS)
(defclass person ()
  ((name :initarg :name :accessor name
         :initform "")
   (age :initarg :age :accessor age
        :initform 0)
   (email :initarg :email :accessor email
          :initform "")
   (address :initarg :address :accessor address
            :initform nil)
   (expensive-data :initform nil)))

;; Lazy initialization
(defun get-expensive-data (obj)
  (unless (slot-value obj 'expensive-data)
    (format t "Computing expensive data...")
    (setf (slot-value obj 'expensive-data) "Expensive Result"))
  (slot-value obj 'expensive-data))

;; Property with validation
(defmethod (setf age) (new-value (obj person))
  (when (>= new-value 0)
    (setf (slot-value obj 'age) new-value)))

;; Property with transformation
(defmethod (setf name) (new-value (obj person))
  (setf (slot-value obj 'name) (string-trim " " new-value)))

(defmethod name ((obj person))
  (string-upcase (slot-value obj 'name)))

;; Usage
(defparameter *person* (make-instance 'person))
(setf (name *person*) "  Alice  ")
(format t "~a" (name *person*)) ; ALICE
(setf (age *person*) 25)
(format t "~a" (get-expensive-data *person*))

;; Companion Objects in Lisp (using packages)
;; Define package as companion
(defpackage :my-class
  (:use :cl)
  (:export :tag :counter :create))

(in-package :my-class)

(defparameter *tag* "MyClass")
(defparameter *counter* 0)

(defun create ()
  (incf *counter*)
  (make-instance 'my-class))

;; Define class
(defclass my-class ()
  ())

;; Usage
(in-package :cl)
(print my-class::*tag*)
(my-class::create)
(my-class::create)

;; Exception Handling in Lisp
;; Handler-case (try-catch)
(defun divide (a b)
  (handler-case
      (/ a b)
    (division-by-zero ()
      (format t "Division by zero!")
      0)))

;; Handler-bind for more control
(defun divide-safe (a b)
  (handler-case
      (/ a b)
    (error (e)
      (format t "Error: ~a" e)
      0)))

;; Custom exception
(define-condition invalid-age-exception (error)
  ((age :initarg :age :accessor age)
   (message :initarg :message :accessor message
            :initform "Invalid age"))
  (:report (lambda (c stream)
             (format stream "~a: ~a" 
                     (message c) (age c)))))

(defun validate-age (age)
  (if (or (< age 0) (> age 150))
      (error 'invalid-age-exception :age age)
      age))

;; Unwind-protect (finally)
(defun read-file ()
  (let ((file (open "test.txt" :if-does-not-exist nil)))
    (unwind-protect
         (if file
             (read-line file)
             (format t "File not found"))
      (when file
        (close file)
        (format t "Closing resources...")))))

;; Usage
(format t "~a" (divide 10 2))
(format t "~a" (divide 10 0))
(handler-case
    (validate-age 200)
  (invalid-age-exception (e)
    (format t "~a" e)))

;; Lambda Expressions in Lisp
;; Basic lambda
(defparameter *square* (lambda (x) (* x x)))

;; Lambda with multiple parameters
(defparameter *doubled* (lambda (x) (* x 2)))

;; Higher-order functions
(defun perform-operation (x y operation)
  (funcall operation x y))

;; Lambda with multiple lines
(defparameter *complex-operation* 
  (lambda (x)
    (let ((y (* x 2)))
      (+ y 10))))

;; Function reference
(defun multiply (x y)
  (* x y))

;; Returning lambda from function
(defun get-operation (type)
  (cond
    ((eq type 'add) (lambda (a b) (+ a b)))
    ((eq type 'subtract) (lambda (a b) (- a b)))
    (t (lambda (a b) 0))))

;; Usage
(format t "~a" (funcall *square* 5))
(format t "~a" (perform-operation 10 20 (lambda (x y) (* x y))))
(defparameter *add* (get-operation 'add))
(format t "~a" (funcall *add* 5 3))

;; Scope Functions in Lisp
;; let - execute block
(defun process-person (person)
  (when person
    (let ((name (getf person :name))
          (age (getf person :age)))
      (format t "Name: ~a" name)
      (setf (getf person :age) 26)
      person)))

;; let with local functions
(defun process-with-scope ()
  (let ((numbers '(1 2 3 4 5))
        (sum 0))
    (dolist (n numbers)
      (incf sum n))
    sum))

;; apply - configure object
(defun update-person (person)
  (apply #'make-instance 'person
         :name (getf person :name)
         :age (1+ (getf person :age))
         :city "SF"))

;; also - perform additional operations
(defun process-list (lst)
  (progn
    (format t "Before: ~a" lst)
    (append lst '(4))
    (format t "After: ~a" lst)
    lst))

;; take-if equivalent
(defun take-if (predicate value)
  (if (funcall predicate value) value nil))

;; Usage
(process-person '(:name "Alice" :age 25 :city "NYC"))
(process-with-scope)
(take-if (lambda (x) (>= x 18)) 25)

;; Extension Functions in Lisp
;; Since Lisp doesn't have extension functions directly,
;; we use generic functions or wrapper functions

;; Using wrapper functions
(defun string-is-email (str)
  (and (find #@ str) (find #. str)))

(defun string-add-prefix (str prefix)
  (concatenate 'string prefix str))

(defun int-is-even (n)
  (evenp n))

(defun int-is-odd (n)
  (oddp n))

;; List extension
(defun list-second-or-null (lst)
  (if (>= (length lst) 2)
      (nth 1 lst)
      nil))

;; String extension
(defun string-word-count (str)
  (length (split-string str " ")))

;; Generic extension using CLOS
(defgeneric is-even (obj))

(defmethod is-even ((obj integer))
  (evenp obj))

;; Usage
(string-is-email "test@example.com")
(string-add-prefix "Hello" "Greeting: ")
(int-is-even 5)
(string-word-count "Hello World")
(list-second-or-null '(1 2 3))
(is-even 4)

;; Type Aliases in Lisp
;; Lisp doesn't have type aliases directly
;; Using defparameter to create aliases

;; Function type alias
(defparameter *operation* nil) ; Used as a placeholder

;; Or using macros
(defmacro defalias (alias type)
  `(defparameter ,alias ,type))

;; Usage
(defparameter *add* (lambda (a b) (+ a b)))
(defparameter *multiply* (lambda (a b) (* a b)))

(defun execute (op a b)
  (funcall op a b))

;; For complex types
(defparameter *users* (make-hash-table))
(setf (gethash "user1" *users*) '("Alice" . 25))
(setf (gethash "user2" *users*) '("Bob" . 30))

;; Usage
(format t "~a" (execute *add* 5 3))
(format t "~a" (execute *multiply* 5 3))
(format t "~a" (car (gethash "user1" *users*)))

;; Inline Functions in Lisp
;; Lisp macros serve a similar purpose to inline functions
;; They expand at compile time

;; Inline macro
(defmacro measure-time (&body body)
  `(let ((start (get-universal-time)))
     ,@body
     (format t "Time: ~a seconds" (- (get-universal-time) start))))

;; Noinline equivalent - functions are always noinline in Lisp
(defun regular-function ()
  (format t "Regular function"))

;; Reified type parameter equivalent
(defmacro is-type (value type)
  `(typep ,value ,type))

;; Usage
(measure-time
 (sleep 1))

(format t "~a" (is-type "Hello" 'string))
(format t "~a" (is-type "Hello" 'integer))

;; Filter by type
(defun filter-by-type (lst type)
  (remove-if-not (lambda (x) (typep x type)) lst))

(defparameter *mixed* (list 1 "Hello" 3.14 "World"))
(defparameter *strings* (filter-by-type *mixed* 'string))
(format t "~a" *strings*)

;; Higher-Order Functions in Lisp
;; Function that takes a function as parameter
(defun apply-operation (a b operation)
  (funcall operation a b))

;; Function that returns a function
(defun get-multiplier (factor)
  (lambda (x) (* x factor)))

;; Function composition
(defun compose (f g)
  (lambda (x) (funcall f (funcall g x))))

;; Higher-order function with multiple lambdas
(defun process (value transform filter)
  (if (funcall filter value)
      (funcall transform value)
      nil))

;; Usage with lambda
(defparameter *result* (apply-operation 10 20 (lambda (a b) (+ a b))))
(format t "~a" *result*)

(defparameter *double* (get-multiplier 2))
(format t "~a" (funcall *double* 5))

(defparameter *square* (lambda (x) (* x x)))
(defparameter *add-ten* (lambda (x) (+ x 10)))
(defparameter *square-then-add-ten* (compose *add-ten* *square*))
(format t "~a" (funcall *square-then-add-ten* 5))

;; Using with named function
(defun add (a b) (+ a b))
(format t "~a" (apply-operation 10 20 #'add))

;; Coroutines in Lisp (simulated with threads)
;; Lisp doesn't have built-in coroutines like Kotlin
;; Using threads as an alternative

;; Basic thread
(defun fetch-data ()
  (sleep 1)
  "Data loaded")

;; Launch thread
(defun main-launch ()
  (let ((thread (sb-thread:make-thread
                 (lambda ()
                   (sleep 2)
                   (format t "Thread completed")))))
    (sb-thread:join-thread thread)))

;; Async/await simulation
(defun async-fetch ()
  (sb-thread:make-thread #'fetch-data))

(defun await-result (thread)
  (sb-thread:join-thread thread))

;; Parallel tasks
(defun parallel-tasks ()
  (let* ((task1 (async-fetch))
         (task2 (async-fetch))
         (results (list (await-result task1) (await-result task2))))
    (format t "Results: ~a" results)))

;; Timeout
(defun with-timeout (seconds fn)
  (let ((thread (sb-thread:make-thread fn)))
    (sleep seconds)
    (if (sb-thread:thread-alive-p thread)
        (progn
          (sb-thread:terminate-thread thread)
          (format t "Timed out!"))
        (sb-thread:join-thread thread))))

;; Usage
(main-launch)
(async-fetch)
(parallel-tasks)

;; Flows in Lisp (simulated with streams)
;; Lisp doesn't have built-in flows like Kotlin
;; Using streams and custom functions

;; Simple stream
(defun make-number-stream (n)
  (let ((i 1))
    (lambda ()
      (if (<= i n)
          (prog1 i (incf i))
          nil))))

;; Stream operators
(defun stream-filter (stream pred)
  (lambda ()
    (loop
      (let ((val (funcall stream)))
        (if (null val)
            (return nil)
            (if (funcall pred val)
                (return val)))))))

(defun stream-map (stream fn)
  (lambda ()
    (let ((val (funcall stream)))
      (if (null val)
          nil
          (funcall fn val)))))

(defun stream-collect (stream)
  (loop for val = (funcall stream)
        while val
        collect val))

;; Usage
(defparameter *numbers* (make-number-stream 5))
(defparameter *filtered* (stream-filter *numbers* (lambda (x) (evenp x))))
(defparameter *mapped* (stream-map *filtered* (lambda (x) (format nil "Number: ~a" x))))
(format t "~a" (stream-collect *mapped*))

;; State simulation
(defparameter *state* 0)
(defun get-state () *state*)
(defun set-state (val) (setf *state* val))
(defun increment () (incf *state*))

;; Channels in Lisp (using queues)
;; Lisp doesn't have built-in channels like Kotlin
;; Using queues and threads

;; Simple queue implementation
(defclass queue ()
  ((items :initform '() :accessor items)
   (lock :initform (sb-thread:make-mutex) :accessor lock)))

(defun queue-enqueue (queue item)
  (sb-thread:with-mutex ((lock queue))
    (setf (items queue) (append (items queue) (list item)))))

(defun queue-dequeue (queue)
  (sb-thread:with-mutex ((lock queue))
    (let ((item (car (items queue))))
      (setf (items queue) (cdr (items queue)))
      item)))

(defun queue-size (queue)
  (length (items queue)))

;; Basic channel
(defun basic-channel ()
  (let ((queue (make-instance 'queue)))
    (sb-thread:make-thread
     (lambda ()
       (queue-enqueue queue "Hello")
       (queue-enqueue queue "World")))
    (loop for i from 1 to 2
          do (format t "~a" (queue-dequeue queue)))))

;; Buffered channel
(defun buffered-channel ()
  (let ((queue (make-instance 'queue)))
    (sb-thread:make-thread
     (lambda ()
       (dotimes (i 5)
         (queue-enqueue queue i)
         (format t "Sent: ~a" i))))
    (dotimes (i 5)
      (sleep 0.1)
      (format t "Received: ~a" (queue-dequeue queue)))))

;; Sealed Classes and Enum Classes in Lisp
;; Enum simulation
(defparameter *colors* '(:red :green :blue))

(defparameter *status-codes* '((:success . 200)
                               (:error . 500)
                               (:loading . 100)))

;; Sealed class simulation using generic functions
(defclass ui-state ()
  ())

(defclass success (ui-state)
  ((data :initarg :data :accessor data)))

(defclass error (ui-state)
  ((message :initarg :message :accessor message)))

(defclass loading (ui-state)
  ())

(defclass idle (ui-state)
  ())

(defgeneric handle-state (state))

(defmethod handle-state ((state success))
  (format t "Data: ~a" (data state)))

(defmethod handle-state ((state error))
  (format t "Error: ~a" (message state)))

(defmethod handle-state ((state loading))
  (format t "Loading..."))

(defmethod handle-state ((state idle))
  (format t "Idle"))

;; Payment classes
(defclass payment () ())

(defclass cash (payment)
  ((amount :initarg :amount :accessor amount)))

(defclass credit-card (payment)
  ((number :initarg :number :accessor number)
   (expiry :initarg :expiry :accessor expiry)))

(defclass paypal (payment)
  ((email :initarg :email :accessor email)))

(defgeneric handle-payment (payment))

(defmethod handle-payment ((payment cash))
  (format t "Cash amount: ~a" (amount payment)))

(defmethod handle-payment ((payment credit-card))
  (format t "Card: ~a" (number payment)))

(defmethod handle-payment ((payment paypal))
  (format t "PayPal: ~a" (email payment)))

;; Generics in Lisp
;; Lisp is dynamically typed, so generics are less needed
;; But we can implement some patterns

;; Generic class using CLOS
(defclass box ()
  ((value :initarg :value :accessor value)))

;; Generic function
(defun swap (first second)
  (values second first))

;; Generic with constraints
(defun sum-numbers (items)
  (apply #'+ items))

;; Variance - using classes
(defclass producer ()
  ((produce :initarg :produce :accessor produce)))

(defclass consumer ()
  ((consume :initarg :consume :accessor consume)))

;; Invariant
(defclass transformer ()
  ((transform :initarg :transform :accessor transform)))

;; Generic function with type checking
(defun process-sequence (seq)
  (mapcar (lambda (x) (format nil "~a" x)) seq))

;; Usage
(defparameter *box* (make-instance 'box :value "Hello"))
(value *box*)

(multiple-value-bind (a b) (swap 1 2)
  (format t "~a, ~a" a b))

(sum-numbers '(1 2 3 4 5))

;; Delegation in Lisp
;; Class delegation using composition
(defclass repository ()
  ())

(defgeneric get-data (repo))
(defgeneric save-data (repo data))

(defclass database-repository (repository)
  ())

(defmethod get-data ((repo database-repository))
  "Data from database")

(defmethod save-data ((repo database-repository) data)
  (format t "Saving to database: ~a" data))

;; Delegation
(defclass cached-repository (repository)
  ((delegate :initarg :delegate :accessor delegate)
   (cache :initform nil :accessor cache)))

(defmethod get-data ((repo cached-repository))
  (or (cache repo)
      (let ((data (get-data (delegate repo))))
        (setf (cache repo) data)
        data)))

;; Property delegation (lazy)
(defclass lazy-property ()
  ((expensive-value :initform nil :accessor expensive-value)))

(defun get-expensive-value (obj)
  (unless (slot-value obj 'expensive-value)
    (format t "Computing...")
    (setf (slot-value obj 'expensive-value) "Result"))
  (slot-value obj 'expensive-value))

;; Observable property
(defclass observable-property ()
  ((name :initform "Initial" :accessor name)))

(defgeneric set-name (obj value))

(defmethod set-name ((obj observable-property) value)
  (let ((old (name obj)))
    (setf (slot-value obj 'name) value)
    (format t "~a -> ~a" old value)))

;; Usage
(defparameter *db* (make-instance 'database-repository))
(defparameter *cached* (make-instance 'cached-repository :delegate *db*))
(get-data *cached*)
(get-data *cached*)

(defparameter *lazy* (make-instance 'lazy-property))
(get-expensive-value *lazy*)
(get-expensive-value *lazy*)

;; Object Declarations and Singletons in Lisp
;; Singleton using closure
(defun make-app-config ()
  (let ((api-url "https://api.example.com")
        (timeout 5000))
    (lambda (command &optional value)
      (cond
        ((eq command 'get-api-url) api-url)
        ((eq command 'get-timeout) timeout)
        ((eq command 'print-config) 
         (format t "API URL: ~a~%Timeout: ~a" api-url timeout))
        (t nil)))))

(defparameter *app-config* (make-app-config))

;; Singleton using package
(defpackage :app-config
  (:use :cl)
  (:export :api-url :timeout :print-config))

(in-package :app-config)
(defparameter *api-url* "https://api.example.com")
(defparameter *timeout* 5000)
(defun print-config ()
  (format t "API URL: ~a~%Timeout: ~a" *api-url* *timeout*))

(in-package :cl)

;; Usage
(funcall *app-config* 'get-api-url)
(funcall *app-config* 'print-config)
app-config::*api-url*

;; DSL (Domain Specific Language) in Lisp
;; HTML DSL
(defmacro html (&body body)
  `(with-output-to-string (*standard-output*)
     ,@body))

(defmacro body (&body body)
  `(progn
     (format t "<body>")
     ,@body
     (format t "</body>")))

(defmacro h1 (text)
  `(format t "<h1>~a</h1>" ,text))

(defmacro p (text)
  `(format t "<p>~a</p>" ,text))

;; Builder pattern
(defclass user-builder ()
  ((name :initform "" :accessor name)
   (age :initform 0 :accessor age)
   (email :initform "" :accessor email)))

(defun build-user (builder)
  (list :name (name builder)
        :age (age builder)
        :email (email builder)))

;; User creation function
(defun user (&rest args)
  (let ((builder (make-instance 'user-builder)))
    (dolist (arg args)
      (cond
        ((eq (car arg) :name) (setf (name builder) (cdr arg)))
        ((eq (car arg) :age) (setf (age builder) (cdr arg)))
        ((eq (car arg) :email) (setf (email builder) (cdr arg)))))
    (build-user builder)))

;; Usage
(html
 (body
  (h1 "Welcome to Lisp DSL")
  (p "This is a paragraph")
  (p "Another paragraph")))

(user :name "Alice" :age 25 :email "alice@example.com")

;; Annotations in Lisp (using meta-programming)
;; Lisp doesn't have built-in annotations like Kotlin
;; Using macros and metadata

;; Custom annotation macro
(defmacro defannotated (name &rest body)
  `(progn
     (defparameter ,name
       (list :annotations ',(car body) :value ,(cadr body)))))

;; Using metadata
(defun annotate (obj &rest annotations)
  (setf (get obj 'annotations) annotations))

(defun get-annotations (obj)
  (get obj 'annotations))

;; Example usage
(defun annotated-method ()
  (format t "Annotated method"))

(annotate 'annotated-method :value "test")

;; Reflection simulation
(defun read-annotations (symbol)
  (get symbol 'annotations))

;; Repeatable annotations
(defun add-annotation (symbol annotation)
  (push annotation (get symbol 'annotations)))

(add-annotation 'annotated-method :permission "read")
(add-annotation 'annotated-method :permission "write")

;; Usage
(annotated-method)
(read-annotations 'annotated-method)

;; Reflection in Lisp
;; Reflection capabilities using CLOS and meta-object protocol

;; Class for reflection examples
(defclass person ()
  ((name :initarg :name :accessor name)
   (age :initarg :age :accessor age)
   (city :initarg :city :accessor city
         :initform "Unknown")))

(defmethod greet ((obj person))
  (format nil "Hello, my name is ~a" (name obj)))

(defmethod update-age ((obj person) new-age)
  (setf (age obj) new-age))

;; Basic reflection
(defun basic-reflection ()
  (let ((person (make-instance 'person :name "Alice" :age 25)))
    (format t "Class: ~a" (class-name (class-of person)))
    (format t "Slots: ~a" (closer-mop:class-slots (class-of person)))))

;; Accessing slots
(defun access-slots ()
  (let ((person (make-instance 'person :name "Alice" :age 25)))
    (dolist (slot (closer-mop:class-slots (class-of person)))
      (let ((name (closer-mop:slot-definition-name slot)))
        (format t "~a = ~a" name (slot-value person name))))))

;; Calling functions
(defun call-functions ()
  (let ((person (make-instance 'person :name "Alice" :age 25)))
    (format t "~a" (greet person))
    (update-age person 30)
    (format t "Updated age: ~a" (age person))))

;; Create instance
(defun create-instance ()
  (make-instance 'person :name "Bob" :age 30 :city "NYC"))

;; Coroutine Context and Dispatchers in Lisp
;; Using threads with different priorities

;; Different dispatchers simulation
(defun dispatcher-example ()
  (let ((threads '()))
    ;; Default
    (push (sb-thread:make-thread
           (lambda () (format t "Default: ~a" (sb-thread:thread-name sb-thread:*current-thread*))))
          threads)
    ;; IO
    (push (sb-thread:make-thread
           (lambda () (format t "IO: ~a" (sb-thread:thread-name sb-thread:*current-thread*))))
          threads)
    ;; Main (current thread)
    (format t "Main: ~a" (sb-thread:thread-name sb-thread:*current-thread*))
    (dolist (thread threads)
      (sb-thread:join-thread thread))))

;; Custom context
(defun custom-context ()
  (sb-thread:make-thread
   (lambda ()
     (format t "Context: Custom"))))

;; ThreadLocal simulation
(defparameter *thread-local* (make-hash-table))

(defun get-thread-local ()
  (gethash (sb-thread:thread-name sb-thread:*current-thread*) *thread-local*))

(defun set-thread-local (value)
  (setf (gethash (sb-thread:thread-name sb-thread:*current-thread*) *thread-local*) value))

(defun thread-local-example ()
  (set-thread-local "Main")
  (let ((thread (sb-thread:make-thread
                 (lambda ()
                   (set-thread-local "IO")
                   (format t "ThreadLocal: ~a" (get-thread-local))))))
    (sb-thread:join-thread thread))
  (format t "ThreadLocal restored: ~a" (get-thread-local)))

;; Shared Mutable State in Coroutines (Lisp)
;; Using locks for synchronization

;; Counter with mutex
(defclass counter-with-mutex ()
  ((value :initform 0 :accessor value)
   (lock :initform (sb-thread:make-mutex) :accessor lock)))

(defun increment-counter (counter)
  (sb-thread:with-mutex ((lock counter))
    (incf (value counter))))

(defun get-counter-value (counter)
  (value counter))

;; Using atomic operations
(defclass counter-with-atomic ()
  ((value :initform 0 :accessor value)))

(defun increment-atomic (counter)
  (sb-thread:with-mutex ((lock counter))
    (incf (value counter))))

;; Single-threaded dispatcher
(defclass counter-with-single-thread ()
  ((value :initform 0 :accessor value)
   (lock :initform (sb-thread:make-mutex) :accessor lock)))

(defun increment-single (counter)
  (sb-thread:with-mutex ((lock counter))
    (incf (value counter))))

;; Usage
(defun counter-example ()
  (let ((counter (make-instance 'counter-with-mutex)))
    (loop for i from 1 to 1000
          do (sb-thread:make-thread
              (lambda ()
                (dotimes (j 100)
                  (increment-counter counter)))))
    (sleep 5)
    (format t "Final count: ~a" (get-counter-value counter))))

;; Flow Operators and Transformations in Lisp
;; Stream transformations using functions

;; Simple stream
(defun make-number-stream (n)
  (let ((i 0))
    (lambda ()
      (if (< i n)
          (prog1 i (incf i))
          nil))))

;; Basic flow transformation
(defun flow-transform-example ()
  (let ((stream (make-number-stream 10)))
    (loop for val = (funcall stream)
          while val
          when (evenp val)
            do (format t "Number ~a" val))))

;; Flow with buffer
(defun flow-buffer-example ()
  (let ((stream (make-number-stream 5)))
    (loop for val = (funcall stream)
          while val
          do (format t "~a" val))))

;; Flow with conflate (drop intermediate values)
(defun flow-conflate-example ()
  (let ((stream (make-number-stream 10)))
    (loop for val = (funcall stream)
          while val
          do (progn
               (sleep 0.1)
               (format t "~a" val)))))

;; Flow with collect latest
(defun flow-collect-latest-example ()
  (let ((stream (make-number-stream 10)))
    (loop for val = (funcall stream)
          while val
          do (progn
               (format t "Processing ~a" val)
               (sleep 0.1)
               (format t "Done ~a" val)))))

;; FlatMap (flattening streams)
(defun flow-flatmap-example ()
  (let ((stream (make-number-stream 3)))
    (loop for val = (funcall stream)
          while val
          do (loop for letter in '(a b)
                   do (format t "~a-~a" val letter)))))

;; Coroutine Scopes and Lifecycle in Lisp
;; Using thread pools and managers

;; Custom scope with job
(defclass my-scope ()
  ((threads :initform '() :accessor threads)
   (cancelled :initform nil :accessor cancelled)))

(defun scope-launch (scope fn)
  (push (sb-thread:make-thread fn) (threads scope)))

(defun scope-cancel (scope)
  (setf (cancelled scope) t)
  (dolist (thread (threads scope))
    (sb-thread:terminate-thread thread)))

;; Lifecycle-aware scope
(defclass lifecycle-scope (my-scope)
  ())

(defun launch-when-created (scope fn)
  (scope-launch scope fn))

(defun on-destroy (scope)
  (scope-cancel scope))

;; GlobalScope vs CoroutineScope
(defun scope-comparison ()
  ;; GlobalScope - runs until complete
  (sb-thread:make-thread
   (lambda ()
     (sleep 1)
     (format t "GlobalScope")))

  ;; CoroutineScope - tied to parent
  (let ((scope (make-instance 'my-scope)))
    (scope-launch scope
                  (lambda ()
                    (sleep 1)
                    (format t "CoroutineScope")))
    (sleep 2)
    (scope-cancel scope)))

;; Scope with timeout
(defun timeout-scope (seconds fn)
  (let ((thread (sb-thread:make-thread fn)))
    (sleep seconds)
    (if (sb-thread:thread-alive-p thread)
        (progn
          (sb-thread:terminate-thread thread)
          (format t "Timed out")
          nil)
        (sb-thread:join-thread thread))))

;; SharedFlow and StateFlow in Lisp
;; Using observers and state management

;; StateFlow simulation
(defclass state-flow ()
  ((value :initform nil :accessor value)
   (observers :initform '() :accessor observers)))

(defun state-flow-update (flow new-value)
  (setf (value flow) new-value)
  (dolist (observer (observers flow))
    (funcall observer new-value)))

(defun state-flow-observe (flow callback)
  (push callback (observers flow)))

;; SharedFlow simulation
(defclass shared-flow ()
  ((events :initform '() :accessor events)
   (replay :initarg :replay :accessor replay)
   (replayed :initform '() :accessor replayed)
   (observers :initform '() :accessor observers)))

(defun shared-flow-emit (flow event)
  (push event (events flow))
  (setf (replayed flow) (cons event (replayed flow)))
  (when (> (length (replayed flow)) (replay flow))
    (setf (replayed flow) (subseq (replayed flow) 0 (replay flow))))
  (dolist (observer (observers flow))
    (funcall observer event)))

;; Distinct until changed
(defun distinct-example (flow)
  (let ((last-value nil))
    (state-flow-observe flow
                        (lambda (value)
                          (unless (equal value last-value)
                            (setf last-value value)
                            (format t "~a" value))))))

;; Combine flows
(defun combine-flows (flow1 flow2)
  (let ((result (make-instance 'state-flow)))
    (state-flow-observe flow1
                        (lambda (value)
                          (state-flow-update result
                                             (+ value (value flow2)))))
    (state-flow-observe flow2
                        (lambda (value)
                          (state-flow-update result
                                             (+ (value flow1) value))))))

;; Coroutine Exception Handling in Lisp
;; Using handler-case and handler-bind

;; Try-catch in thread
(defun try-catch-example ()
  (handler-case
      (sb-thread:make-thread
       (lambda ()
         (error "Error")))
    (error (e)
      (format t "Caught: ~a" e))))

;; Exception handler
(defun exception-handler ()
  (handler-case
      (sb-thread:make-thread
       (lambda ()
         (error "Test")))
    (error (e)
      (format t "Handler caught: ~a" e))))

;; Supervisor job for child isolation
(defun supervisor-example ()
  (let ((threads '()))
    ;; Child 1
    (push (sb-thread:make-thread
           (lambda ()
             (handler-case
                 (progn
                   (sleep 0.1)
                   (error "Child 1 error"))
               (error (e)
                 (format t "Child 1 caught: ~a" e)))))
          threads)
    ;; Child 2
    (push (sb-thread:make-thread
           (lambda ()
             (sleep 0.2)
             (format t "Child 2 still running")))
          threads)
    (dolist (thread threads)
      (sb-thread:join-thread thread))))

;; Flow exception handling
(defun flow-exception ()
  (handler-case
      (progn
        (format t "~a" 1)
        (error "Flow error"))
    (error (e)
      (format t "Flow caught: ~a" e)
      (format t "-1"))))

;; Supervisor scope
(defun supervisor-scope-example ()
  (let ((threads '()))
    (push (sb-thread:make-thread
           (lambda ()
             (error "Error")))
          threads)
    (push (sb-thread:make-thread
           (lambda ()
             (sleep 0.1)
             (format t "Still running")))
          threads)
    (dolist (thread threads)
      (sb-thread:join-thread thread))))

;; Channel Producers and Consumer Patterns in Lisp
;; Using queues for producer-consumer patterns

;; Producer-Consumer pattern
(defun producer-consumer ()
  (let ((queue (make-instance 'queue)))
    ;; Producer
    (sb-thread:make-thread
     (lambda ()
       (dotimes (i 20)
         (queue-enqueue queue i)
         (format t "Produced: ~a" i)
         (sleep 0.1))))
    ;; Consumer
    (sb-thread:make-thread
     (lambda ()
       (dotimes (i 20)
         (let ((val (queue-dequeue queue)))
           (when val
             (format t "Consumed: ~a" val)
             (sleep 0.15))))))))

;; Fan-out pattern
(defun fan-out-example ()
  (let ((queue (make-instance 'queue)))
    ;; Producer
    (sb-thread:make-thread
     (lambda ()
       (dotimes (i 20)
         (queue-enqueue queue i))))
    ;; Multiple consumers
    (dotimes (id 3)
      (sb-thread:make-thread
       (lambda ()
         (dotimes (i 20)
           (let ((val (queue-dequeue queue)))
             (when val
               (format t "Consumer ~a: ~a" id val)
               (sleep 0.1)))))))))

;; Fan-in pattern
(defun fan-in-example ()
  (let ((queue (make-instance 'queue)))
    ;; Multiple producers
    (dotimes (id 3)
      (sb-thread:make-thread
       (lambda ()
         (dotimes (i 5)
           (queue-enqueue queue (format nil "Producer ~a: ~a" id i))
           (sleep 0.05)))))
    ;; Single consumer
    (sb-thread:make-thread
     (lambda ()
       (dotimes (i 15)
         (format t "~a" (queue-dequeue queue)))))))

;; Coroutine Cancellation in Lisp
;; Thread termination and cooperative cancellation

;; Cooperative cancellation
(defun cooperative-cancellation ()
  (let ((cancelled nil))
    (sb-thread:make-thread
     (lambda ()
       (dotimes (i 100)
         (when cancelled (return))
         (format t "Working: ~a" i)
         (sleep 0.05))))

    (sleep 0.2)
    (setf cancelled t)))

;; Cancellation with finally
(defun cancellation-finally ()
  (let ((cancelled nil))
    (sb-thread:make-thread
     (lambda ()
       (unwind-protect
           (dotimes (i 100)
             (when cancelled (return))
             (format t "Processing: ~a" i)
             (sleep 0.1))
         (format t "Cleaning up")
         (sleep 0.1)
         (format t "Cleanup done"))))
    (sleep 0.25)
    (setf cancelled t)))

;; Cancellation with timeout
(defun cancellation-timeout ()
  (let ((thread (sb-thread:make-thread
                 (lambda ()
                   (dotimes (i 10)
                     (sleep 0.2)
                     (format t "Iteration: ~a" i))))))
    (sleep 1)
    (sb-thread:terminate-thread thread)
    (format t "Timed out")))

;; Custom cancellation check
(defun custom-cancellation ()
  (let ((cancelled nil))
    (sb-thread:make-thread
     (lambda ()
       (let ((i 0))
         (loop while (and (not cancelled) (< i 1000))
               do (when (= (mod i 100) 0)
                    (format t "Still running: ~a" i))
                  (incf i)
                  (sleep 0.001)))))
    (sleep 0.1)
    (setf cancelled t)))

;; Testing Coroutines in Lisp
;; Using unit testing frameworks

;; Basic test function
(defun test-coroutine ()
  (let ((result nil))
    (sb-thread:make-thread
     (lambda ()
       (sleep 1)
       (setf result "Success")))
    (sleep 1.5)
    (assert (equal result "Success") () "Test failed")))

;; Test with delay
(defun test-with-delay ()
  (let ((result nil))
    (sb-thread:make-thread
     (lambda ()
       (sleep 1)
       (setf result "Done")))
    ;; Simulate advance time
    (sleep 1)
    (assert (equal result "Done") () "Test failed")))

;; Test multiple coroutines
(defun test-multiple-coroutines ()
  (let ((results '()))
    (sb-thread:make-thread
     (lambda ()
       (sleep 0.5)
       (push "Task 1" results)))
    (sb-thread:make-thread
     (lambda ()
       (sleep 0.3)
       (push "Task 2" results)))
    (sleep 1)
    (assert (equal results '("Task 2" "Task 1")) () "Test failed")))

;; Test flow
(defun test-flow ()
  (let ((values '()))
    (dotimes (i 2)
      (push i values))
    (assert (equal values '(1 0)) () "Test failed")))

;; Time control test
(defun time-control-test ()
  (let ((counter 0)
        (running t))
    (sb-thread:make-thread
     (lambda ()
       (loop while running
             do (sleep 1)
                (incf counter))))
    (sleep 3)
    (setf running nil)
    (assert (<= counter 4) () "Test failed")))

;; Lisp Multiplatform (different implementations)
;; Using feature flags and different implementations

;; Platform-specific code
(defun platform-name ()
  #+sbcl "SBCL"
  #+clisp "CLISP"
  #+ccl "CCL"
  #+abcl "ABCL"
  #-(or sbcl clisp ccl abcl) "Unknown")

(defun greet ()
  (format nil "Hello from ~a" (platform-name)))

;; Platform-specific class simulation
(defclass platform ()
  ())

(defmethod get-version ((obj platform))
  #+sbcl "2.2.0"
  #+clisp "2.49"
  #+ccl "1.12"
  #+abcl "1.8.0"
  #-(or sbcl clisp ccl abcl) "Unknown")

;; Platform info
(defclass platform-info ()
  ())

(defun get-info ()
  (format nil "~a version ~a" 
          (greet) (get-version (make-instance 'platform))))

;; Multiplatform with serialization
(defun encode-user (user)
  (format nil "~a~%~a~%~a" 
          (getf user :id)
          (getf user :name)
          (getf user :email)))

(defun decode-user (data)
  (let ((lines (split-string data #Newline)))
    (list :id (parse-integer (first lines))
          :name (second lines)
          :email (third lines))))

;; Reverse a string
(defun reverse-string (str)
  (reverse str))
(format t "~a" (reverse-string "hello")) ; "olleh"

;; Using loop
(defun reverse-string-loop (str)
  (with-output-to-string (s)
    (do ((i (1- (length str)) (1- i)))
        ((< i 0))
      (write-char (char str i) s))))

;; Check palindrome
(defun is-palindrome (str)
  (let ((cleaned (string-downcase 
                  (remove-if-not #'alphanumericp str))))
    (string= cleaned (reverse cleaned))))
(format t "~a" (is-palindrome "racecar")) ; t
(format t "~a" (is-palindrome "hello")) ; nil

;; Two-pointer approach
(defun is-palindrome-two-pointer (str)
  (let ((cleaned (string-downcase 
                  (remove-if-not #'alphanumericp str)))
        (left 0)
        (right (1- (length str))))
    (loop while (< left right)
          do (if (char/= (char cleaned left) (char cleaned right))
                 (return nil)
                 (progn (incf left) (decf right))))))

;; Find max in array
(defun find-max (arr)
  (if (null arr)
      (error "Empty array")
      (reduce #'max arr)))
(format t "~a" (find-max '(1 5 3 9 2))) ; 9

;; Manual implementation
(defun find-max-manual (arr)
  (let ((max-val (car arr)))
    (dolist (num (cdr arr))
      (when (> num max-val)
        (setf max-val num)))
    max-val))

;; Remove duplicates
(defun remove-duplicates-list (arr)
  (remove-duplicates arr))
(format t "~a" (remove-duplicates-list '(1 2 2 3 3 4))) ; (1 2 3 4)

;; Using set
(defun remove-duplicates-set (arr)
  (coerce (make-hash-table) 'list))

;; Merge arrays
(defun merge-arrays (arr1 arr2)
  (append arr1 arr2))
(format t "~a" (merge-arrays '(1 2) '(3 4))) ; (1 2 3 4)

;; Alternative
(defun merge-arrays-plus (arr1 arr2)
  (append arr1 arr2))

;; Convert string to number
(defun string-to-number (str)
  (parse-integer str))
(format t "~a" (string-to-number "42")) ; 42

;; Safe conversion
(defun string-to-number-safe (str)
  (handler-case
      (parse-integer str)
    (error () nil)))

;; Loop through map (alist)
(defun loop-map (alist)
  (dolist (pair alist)
    (format t "~a => ~a" (car pair) (cdr pair))))

;; Alternative
(defun loop-map-alternate (alist)
  (mapc (lambda (pair)
          (format t "~a => ~a" (car pair) (cdr pair)))
        alist))

(loop-map '((name . "Alice") (age . 25) (city . "NYC")))

;; Delay function execution
(defun delayed-execution (delay-ms fn)
  (sleep (/ delay-ms 1000))
  (funcall fn))

;; Example usage
(delayed-execution 2000
                   (lambda ()
                     (format t "After 2 seconds")))

;; Using threads
(defun delayed-execution-thread (delay-ms fn)
  (sb-thread:make-thread
   (lambda ()
     (sleep (/ delay-ms 1000))
     (funcall fn))))

;; HTTP GET request
(defun fetch-data (url)
  (let ((stream (drakma:http-request url)))
    (when stream
      (with-output-to-string (s)
        (do ((line (read-line stream nil nil)
                   (read-line stream nil nil)))
            ((null line))
          (write-line line s))))))

;; Alternative using URL-REQUES
(defun fetch-data-url (url)
  (let ((stream (url-request:url-request url)))
    (if stream
        (with-output-to-string (s)
          (do ((line (read-line stream nil nil)
                     (read-line stream nil nil)))
              ((null line))
            (write-line line s)))
        nil)))

;; Create a promise-like Deferred
(defun create-deferred (should-resolve)
  (let ((thread nil)
        (result nil))
    (setf thread (sb-thread:make-thread
                  (lambda ()
                    (sleep 1)
                    (if should-resolve
                        (setf result "Success!")
                        (error "Failed!")))))
    (lambda ()
      (sb-thread:join-thread thread)
      result)))

;; Usage
(defparameter *deferred* (create-deferred t))
(handler-case
    (format t "~a" (funcall *deferred*))
  (error (e)
    (format t "Caught: ~a" e)))

;; Factorial
(defun factorial (n)
  (if (<= n 1)
      1
      (* n (factorial (- n 1)))))
(format t "~a" (factorial 5)) ; 120

;; Iterative version
(defun factorial-iterative (n)
  (do ((i 2 (1+ i))
       (result 1 (* result i)))
      ((> i n) result)))

;; Fibonacci
(defun fibonacci (n)
  (if (<= n 1)
      n
      (+ (fibonacci (- n 1)) (fibonacci (- n 2)))))
(format t "~a" (fibonacci 8)) ; 21

;; Iterative version
(defun fibonacci-iterative (n)
  (do ((a 0 b)
       (b 1 (+ a b))
       (i 2 (1+ i)))
      ((> i n) b)))

;; FizzBuzz
(defun fizzbuzz (n)
  (dotimes (i n)
    (let ((num (1+ i)))
      (cond
        ((zerop (mod num 15)) (format t "FizzBuzz"))
        ((zerop (mod num 3)) (format t "Fizz"))
        ((zerop (mod num 5)) (format t "Buzz"))
        (t (format t "~a" num))))))
(fizzbuzz 15)

;; Find missing number
(defun find-missing (arr)
  (let* ((n (1+ (length arr)))
         (total (/ (* n (1+ n)) 2))
         (sum (reduce #'+ arr)))
    (- total sum)))
(format t "~a" (find-missing '(1 2 4 5 6))) ; 3

;; Find duplicates
(defun find-duplicates (arr)
  (let ((seen '())
        (duplicates '()))
    (dolist (item arr)
      (if (member item seen)
          (push item duplicates)
          (push item seen)))
    duplicates))
(format t "~a" (find-duplicates '(1 2 3 2 4 3))) ; (3 2)

;; Sum of array
(defun sum-array (arr)
  (reduce #'+ arr))
(format t "~a" (sum-array '(1 2 3 4 5))) ; 15

;; Manual implementation
(defun sum-array-manual (arr)
  (let ((sum 0))
    (dolist (num arr)
      (incf sum num))
    sum))

;; Average of array
(defun average-array (arr)
  (/ (reduce #'+ arr) (length arr)))
(format t "~a" (average-array '(1 2 3 4 5))) ; 3

;; Manual implementation
(defun average-array-manual (arr)
  (/ (sum-array-manual arr) (length arr)))

;; Sort array ascending
(defun sort-ascending (arr)
  (sort (copy-seq arr) #'<))
(format t "~a" (sort-ascending '(5 2 8 1 9))) ; (1 2 5 8 9)

;; In-place sorting
(defun sort-ascending-in-place (arr)
  (sort arr #'<))

;; Sort array descending
(defun sort-descending (arr)
  (sort (copy-seq arr) #'>))
(format t "~a" (sort-descending '(5 2 8 1 9))) ; (9 8 5 2 1)

;; In-place sorting
(defun sort-descending-in-place (arr)
  (sort arr #'>))

;; Flatten nested array
(defun flatten-array (arr)
  (cond
    ((null arr) nil)
    ((listp (car arr)) 
     (append (flatten-array (car arr)) 
             (flatten-array (cdr arr))))
    (t (cons (car arr) (flatten-array (cdr arr))))))
(format t "~a" (flatten-array '(1 (2 (3 4) 5) 6))) ; (1 2 3 4 5 6)

;; Using recursion
(defun flatten-array-recursive (arr)
  (if (atom arr)
      (list arr)
      (mapcan #'flatten-array-recursive arr)))

;; Chunk array
(defun chunk-array (arr size)
  (loop for i from 0 below (length arr) by size
        collect (subseq arr i (min (+ i size) (length arr)))))
(format t "~a" (chunk-array '(1 2 3 4 5 6) 2)) ; ((1 2) (3 4) (5 6))

;; Manual implementation
(defun chunk-array-manual (arr size)
  (let ((result '()))
    (do ((i 0 (+ i size)))
        ((>= i (length arr)))
      (push (subseq arr i (min (+ i size) (length arr))) result))
    (reverse result)))

;; Binary search
(defun binary-search (arr target)
  (let ((left 0)
        (right (1- (length arr))))
    (loop while (<= left right)
          do (let ((mid (floor (+ left right) 2)))
               (cond
                 ((= (nth mid arr) target) (return mid))
                 ((< (nth mid arr) target) (setf left (1+ mid)))
                 (t (setf right (1- mid))))))
    -1))
(format t "~a" (binary-search '(1 2 3 4 5 6 7) 5)) ; 4

;; Using built-in
(defun binary-search-built-in (arr target)
  (position target arr :test #'<))

;; Quick sort
(defun quick-sort (arr)
  (if (<= (length arr) 1)
      arr
      (let* ((pivot (car arr))
             (rest (cdr arr))
             (left (remove-if-not (lambda (x) (< x pivot)) rest))
             (right (remove-if (lambda (x) (< x pivot)) rest)))
        (append (quick-sort left) (list pivot) (quick-sort right)))))

(format t "~a" (quick-sort '(5 3 8 4 2 7 1 6)))

;; Merge sort
(defun merge-sort (arr)
  (if (<= (length arr) 1)
      arr
      (let* ((mid (floor (length arr) 2))
             (left (subseq arr 0 mid))
             (right (subseq arr mid)))
        (merge-lists (merge-sort left) (merge-sort right)))))

(defun merge-lists (left right)
  (cond
    ((null left) right)
    ((null right) left)
    ((<= (car left) (car right))
     (cons (car left) (merge-lists (cdr left) right)))
    (t (cons (car right) (merge-lists left (cdr right))))))

;; Bubble sort
(defun bubble-sort (arr)
  (let ((sorted (copy-seq arr)))
    (do ((i 0 (1+ i)))
        ((= i (1- (length sorted))))
      (do ((j 0 (1+ j)))
          ((= j (- (length sorted) 1 i)))
        (when (> (nth j sorted) (nth (1+ j) sorted))
          (rotatef (nth j sorted) (nth (1+ j) sorted)))))
    sorted))

;; Optimized bubble sort
(defun bubble-sort-optimized (arr)
  (let ((sorted (copy-seq arr)))
    (do ((i 0 (1+ i)))
        ((= i (1- (length sorted))))
      (let ((swapped nil))
        (do ((j 0 (1+ j)))
            ((= j (- (length sorted) 1 i)))
          (when (> (nth j sorted) (nth (1+ j) sorted))
            (rotatef (nth j sorted) (nth (1+ j) sorted))
            (setf swapped t)))
        (unless swapped (return sorted))))
    sorted))

;; Intersection of arrays
(defun intersection-arrays (arr1 arr2)
  (remove-if-not (lambda (x) (member x arr2)) arr1))
(format t "~a" (intersection-arrays '(1 2 3 4) '(3 4 5 6))) ; (3 4)

;; Using set for efficiency
(defun intersection-set (arr1 arr2)
  (let ((set2 (make-hash-table)))
    (dolist (item arr2)
      (setf (gethash item set2) t))
    (remove-if-not (lambda (x) (gethash x set2)) arr1)))

;; Union of arrays
(defun union-arrays (arr1 arr2)
  (remove-duplicates (append arr1 arr2)))
(format t "~a" (union-arrays '(1 2 3) '(3 4 5))) ; (1 2 3 4 5)

;; Using set
(defun union-set (arr1 arr2)
  (remove-duplicates (append arr1 arr2)))

;; Difference of arrays
(defun difference-arrays (arr1 arr2)
  (remove-if (lambda (x) (member x arr2)) arr1))
(format t "~a" (difference-arrays '(1 2 3 4) '(3 4 5 6))) ; (1 2)

;; Symmetric difference
(defun symmetric-difference (arr1 arr2)
  (append (difference-arrays arr1 arr2)
          (difference-arrays arr2 arr1)))

;; Group by property
(defun group-by-property (items key)
  (let ((groups (make-hash-table :test 'equal)))
    (dolist (item items)
      (let ((key-value 
             (if (equal key "type")
                 (type item)
                 (name item))))
        (push item (gethash key-value groups))))
    groups))

;; Usage
(defstruct item type name)
(defparameter *data* 
  (list (make-item :type "fruit" :name "apple")
        (make-item :type "fruit" :name "banana")
        (make-item :type "veg" :name "carrot")))

(defun print-groups (groups)
  (maphash (lambda (key value)
             (format t "~a: ~a" key value))
           groups))

;; Deep clone object
(defun deep-clone (obj)
  (cond
    ((null obj) nil)
    ((atom obj) obj)
    ((listp obj) (mapcar #'deep-clone obj))
    ((hash-table-p obj)
     (let ((new (make-hash-table :test (hash-table-test obj))))
       (maphash (lambda (key value)
                  (setf (gethash key new) (deep-clone value)))
                obj)
       new))
    (t obj)))

;; Usage
(defstruct user name address)
(defstruct address city zip)

(defparameter *original* 
  (make-user :name "Alice" 
             :address (make-address :city "NYC" :zip "10001")))
(defparameter *cloned* (deep-clone *original*))

;; Immutable update
(defun update-immutable (obj path value)
  (let ((parts (split-string path ".")))
    (if (= (length parts) 1)
        (acons (car parts) value obj)
        (let* ((first (car parts))
               (rest (concatenate 'string (cdr parts) "."))
               (nested (cdr (assoc first obj))))
          (acons first 
                 (update-immutable nested rest value)
                 obj)))))

(defparameter *state* '((user (name "Alice") (age 25))))
(defparameter *new-state* (update-immutable *state* "user.age" 26))

;; Pipe function
(defun pipe (&rest fns)
  (lambda (value)
    (let ((result value))
      (dolist (fn fns)
        (setf result (funcall fn result)))
      result)))

(defun double (x) (* x 2))
(defun add-ten (x) (+ x 10))
(defun square (x) (* x x))

(defparameter *process* (pipe #'double #'add-ten #'square))
(format t "~a" (funcall *process* 5)) ; 400

;; Compose function
(defun compose (&rest fns)
  (lambda (value)
    (let ((result value))
      (dolist (fn (reverse fns))
        (setf result (funcall fn result)))
      result)))

(defparameter *process2* (compose #'square #'add-ten #'double))
(format t "~a" (funcall *process2* 5)) ; 400

;; Memoization
(defun memoize (fn)
  (let ((cache (make-hash-table :test 'equal)))
    (lambda (arg)
      (multiple-value-bind (value found) (gethash arg cache)
        (if found
            value
            (let ((result (funcall fn arg)))
              (setf (gethash arg cache) result)
              result))))))

(defvar *fibonacci-memo* 
  (memoize (lambda (n)
             (if (<= n 1)
                 n
                 (+ (funcall *fibonacci-memo* (- n 1))
                    (funcall *fibonacci-memo* (- n 2)))))))

(format t "~a" (funcall *fibonacci-memo* 10))

;; Once function
(defun once (fn)
  (let ((called nil)
        (result nil))
    (lambda ()
      (unless called
        (setf called t)
        (setf result (funcall fn)))
      result)))

(defparameter *initialize* 
  (once (lambda ()
          (format t "Initialized")
          '(id 1 name "App"))))

(funcall *initialize*) ; Prints "Initialized"
(funcall *initialize*) ; Returns cached result

;; Debounce with leading edge
(defun debounce-leading (delay-ms fn)
  (let ((last-call 0)
        (timer nil))
    (lambda ()
      (let ((now (/ (get-internal-real-time) 1000)))
        (if (< (- now last-call) (/ delay-ms 1000))
            (progn
              (when timer
                (sb-thread:terminate-thread timer))
              (setf timer 
                    (sb-thread:make-thread
                     (lambda ()
                       (sleep (/ delay-ms 1000))
                       (setf last-call (/ (get-internal-real-time) 1000))
                       (funcall fn)))))
            (progn
              (setf last-call now)
              (funcall fn)))))))

;; Throttle with leading edge
(defun throttle-leading (delay-ms fn)
  (let ((last-call 0))
    (lambda ()
      (let ((now (/ (get-internal-real-time) 1000)))
        (when (>= (- now last-call) (/ delay-ms 1000))
          (setf last-call now)
          (funcall fn))))))

;; Deep equal
(defun deep-equal (obj1 obj2)
  (cond
    ((eq obj1 obj2) t)
    ((or (null obj1) (null obj2)) nil)
    ((and (listp obj1) (listp obj2))
     (and (= (length obj1) (length obj2))
          (every #'deep-equal obj1 obj2)))
    ((and (hash-table-p obj1) (hash-table-p obj2))
     (and (= (hash-table-count obj1) (hash-table-count obj2))
          (maphash (lambda (key value)
                     (and (deep-equal value (gethash key obj2))
                          t))
                   obj1)))
    (t (equal obj1 obj2))))

;; Observable pattern
(defclass observable ()
  ((subscribers :initform '() :accessor subscribers)))

(defgeneric subscribe (observable callback))
(defgeneric notify (observable data))

(defmethod subscribe ((obs observable) callback)
  (push callback (subscribers obs))
  (lambda () (setf (subscribers obs) 
                   (remove callback (subscribers obs)))))

(defmethod notify ((obs observable) data)
  (dolist (callback (subscribers obs))
    (funcall callback data)))

;; Usage
(defparameter *obs* (make-instance 'observable))
(defparameter *unsubscribe* 
  (subscribe *obs* (lambda (data)
                     (format t "Received: ~a" data))))
(notify *obs* "Hello") ; Received: Hello
(funcall *unsubscribe*)
(notify *obs* "World") ; Nothing happens

;; Singleton pattern
(defvar *singleton* 
  (let ((data (make-hash-table)))
    (lambda (command &rest args)
      (case command
        (:set (setf (gethash (car args) data) (cadr args)))
        (:get (gethash (car args) data))
        (t nil)))))

;; Usage
(funcall *singleton* :set "name" "Alice")
(funcall *singleton* :get "name") ; Alice

;; Factory pattern
(defclass user () ())
(defclass admin (user) 
  ((name :initarg :name :accessor name)))
(defclass guest (user)
  ((name :initarg :name :accessor name)))
(defclass regular-user (user)
  ((name :initarg :name :accessor name)))

(defun create-user (type name)
  (case type
    (:admin (make-instance 'admin :name name))
    (:guest (make-instance 'guest :name name))
    (t (make-instance 'regular-user :name name))))

;; Usage
(create-user :admin "Alice")

;; Strategy pattern
(defgeneric pay (strategy amount))

(defclass credit-card-strategy () ())
(defclass paypal-strategy () ())
(defclass crypto-strategy () ())

(defmethod pay ((strategy credit-card-strategy) amount)
  (format t "Paid $~a with Credit Card" amount))

(defmethod pay ((strategy paypal-strategy) amount)
  (format t "Paid $~a with PayPal" amount))

(defmethod pay ((strategy crypto-strategy) amount)
  (format t "Paid $~a with Crypto" amount))

(defclass payment-context ()
  ((strategy :initarg :strategy :accessor strategy)))

(defgeneric execute-payment (context amount))

(defmethod execute-payment ((context payment-context) amount)
  (pay (strategy context) amount))

;; Usage
(defparameter *context* 
  (make-instance 'payment-context :strategy (make-instance 'credit-card-strategy)))
(execute-payment *context* 100)
(setf (strategy *context*) (make-instance 'paypal-strategy))
(execute-payment *context* 50)

;; Observer pattern
(defclass observer ()
  ())

(defgeneric update (observer data))

(defclass subject ()
  ((observers :initform '() :accessor observers)
   (state :initform "" :accessor state)))

(defmethod set-state ((subj subject) new-state)
  (setf (state subj) new-state)
  (notify-observers subj))

(defmethod attach ((subj subject) (obs observer))
  (push obs (observers subj)))

(defmethod detach ((subj subject) (obs observer))
  (setf (observers subj) (remove obs (observers subj))))

(defmethod notify-observers ((subj subject))
  (dolist (obs (observers subj))
    (update obs (state subj))))

(defclass concrete-observer ()
  ((name :initarg :name :accessor name)))

(defmethod update ((obs concrete-observer) data)
  (format t "~a received: ~a" (name obs) data))

;; Usage
(defparameter *subject* (make-instance 'subject))
(defparameter *observer1* (make-instance 'concrete-observer :name "Observer1"))
(defparameter *observer2* (make-instance 'concrete-observer :name "Observer2"))
(attach *subject* *observer1*)
(attach *subject* *observer2*)
(set-state *subject* "Hello World")

;; Decorator pattern
(defclass coffee ()
  ((cost :initarg :cost :accessor cost)
   (description :initarg :description :accessor description)))

(defun milk-decorator (coffee)
  (make-instance 'coffee
                 :cost (+ (cost coffee) 2.0)
                 :description (concatenate 'string (description coffee) ", Milk")))

(defun sugar-decorator (coffee)
  (make-instance 'coffee
                 :cost (+ (cost coffee) 1.0)
                 :description (concatenate 'string (description coffee) ", Sugar")))

;; Usage
(defparameter *coffee* (make-instance 'coffee :cost 5.0 :description "Coffee"))
(setf *coffee* (milk-decorator *coffee*))
(setf *coffee* (sugar-decorator *coffee*))
(format t "~a" (description *coffee*)) ; Coffee, Milk, Sugar
(format t "~a" (cost *coffee*)) ; 8.0

;; Command pattern
(defgeneric execute (command))
(defgeneric undo (command))

(defclass add-command ()
  ((receiver :initarg :receiver :accessor receiver)
   (value :initarg :value :accessor value)))

(defmethod execute ((cmd add-command))
  (push (value cmd) (receiver cmd)))

(defmethod undo ((cmd add-command))
  (setf (receiver cmd) 
        (remove (value cmd) (receiver cmd))))

;; Usage
(defparameter *receiver* '(1 2 3))
(defparameter *cmd* (make-instance 'add-command :receiver *receiver* :value 4))
(execute *cmd*)
(format t "~a" *receiver*) ; (4 1 2 3)
(undo *cmd*)
(format t "~a" *receiver*) ; (1 2 3)

;; Memento pattern
(defclass memento ()
  ((state :initarg :state :accessor state)))

(defclass originator ()
  ((state :initform "" :accessor state)))

(defmethod save-state ((obj originator))
  (make-instance 'memento :state (state obj)))

(defmethod restore-state ((obj originator) (memento memento))
  (setf (state obj) (state memento)))

(defclass caretaker ()
  ((mementos :initform '() :accessor mementos)))

(defmethod add-memento ((obj caretaker) memento)
  (push memento (mementos obj)))

(defmethod get-memento ((obj caretaker) index)
  (nth index (mementos obj)))

;; Usage
(defparameter *originator* (make-instance 'originator))
(defparameter *caretaker* (make-instance 'caretaker))

(setf (state *originator*) "State 1")
(add-memento *caretaker* (save-state *originator*))
(setf (state *originator*) "State 2")
(add-memento *caretaker* (save-state *originator*))
(setf (state *originator*) "State 3")

(restore-state *originator* (get-memento *caretaker* 0))
(format t "~a" (state *originator*)) ; State 1

;; Mediator pattern
(defclass mediator ()
  ((colleagues :initform '() :accessor colleagues)))

(defmethod register ((med mediator) colleague)
  (push colleague (colleagues med)))

(defmethod send-message ((med mediator) message sender)
  (dolist (col (colleagues med))
    (unless (eq col sender)
      (receive-message col message))))

(defclass colleague ()
  ((name :initarg :name :accessor name)
   (mediator :initarg :mediator :accessor mediator)))

(defmethod initialize-instance :after ((col colleague) &key)
  (register (mediator col) col))

(defmethod send-message ((col colleague) message)
  (send-message (mediator col) message col))

(defmethod receive-message ((col colleague) message)
  (format t "~a received: ~a" (name col) message))

;; Usage
(defparameter *mediator* (make-instance 'mediator))
(defparameter *alice* (make-instance 'colleague :name "Alice" :mediator *mediator*))
(defparameter *bob* (make-instance 'colleague :name "Bob" :mediator *mediator*))
(send-message *alice* "Hello Bob!")

;; Chain of Responsibility
(defclass handler ()
  ((next-handler :initform nil :accessor next-handler)))

(defgeneric set-next (handler next))
(defgeneric handle (handler request))

(defmethod set-next ((handler handler) next)
  (setf (next-handler handler) next)
  next)

(defclass auth-handler (handler)
  ())

(defmethod handle ((handler auth-handler) request)
  (if (getf request :token)
      (progn
        (format t "Authentication passed")
        (let ((next (next-handler handler)))
          (when next (handle next request))))
      (format t "Authentication failed")))

(defclass logger-handler (handler)
  ())

(defmethod handle ((handler logger-handler) request)
  (format t "Logging request: ~a" (getf request :url))
  (let ((next (next-handler handler)))
    (when next (handle next request))))

;; Usage
(defparameter *auth* (make-instance 'auth-handler))
(defparameter *logger* (make-instance 'logger-handler))
(set-next *auth* *logger*)
(handle *auth* '(:token "valid" :url "/api"))

;; State pattern
(defgeneric handle-state (state))

(defclass ready-state ()
  ())

(defclass processing-state ()
  ())

(defclass completed-state ()
  ())

(defmethod handle-state ((state ready-state))
  (format t "Ready: Waiting for input"))

(defmethod handle-state ((state processing-state))
  (format t "Processing: Working on task"))

(defmethod handle-state ((state completed-state))
  (format t "Completed: Task finished"))

(defclass context ()
  ((state :initform (make-instance 'ready-state)
          :accessor state)))

(defmethod request ((ctx context))
  (handle-state (state ctx)))

;; Usage
(defparameter *context* (make-instance 'context))
(request *context*) ; Ready: Waiting for input
(setf (state *context*) (make-instance 'processing-state))
(request *context*) ; Processing: Working on task
(setf (state *context*) (make-instance 'completed-state))
(request *context*) ; Completed: Task finished

;; Proxy pattern
(defclass real-subject ()
  ())

(defmethod request ((obj real-subject))
  (format t "RealSubject: Handling request"))

(defclass proxy ()
  ((real-subject :initform nil :accessor real-subject)))

(defmethod request ((obj proxy))
  (when (check-access obj)
    (unless (real-subject obj)
      (setf (real-subject obj) (make-instance 'real-subject)))
    (request (real-subject obj))
    (log-access obj)))

(defmethod check-access ((obj proxy))
  (format t "Proxy: Checking access")
  t)

(defmethod log-access ((obj proxy))
  (format t "Proxy: Logging access"))

;; Usage
(defparameter *proxy* (make-instance 'proxy))
(request *proxy*)

;; Flyweight pattern
(defclass flyweight ()
  ((shared-state :initarg :shared-state :accessor shared-state)))

(defmethod operation ((obj flyweight) unique-state)
  (format t "Shared: ~a, Unique: ~a" 
          (shared-state obj) unique-state))

(defclass flyweight-factory ()
  ((flyweights :initform (make-hash-table :test 'equal)
               :accessor flyweights)))

(defmethod get-flyweight ((factory flyweight-factory) shared-state)
  (or (gethash shared-state (flyweights factory))
      (setf (gethash shared-state (flyweights factory))
            (make-instance 'flyweight :shared-state shared-state))))

;; Usage
(defparameter *factory* (make-instance 'flyweight-factory))
(defparameter *fw1* (get-flyweight *factory* "state1"))
(defparameter *fw2* (get-flyweight *factory* "state1"))
(defparameter *fw3* (get-flyweight *factory* "state2"))
(operation *fw1* "unique1")
(operation *fw2* "unique2")
(operation *fw3* "unique3")

;; Bridge pattern
(defgeneric operation-impl (impl))

(defclass concrete-implementation-a ()
  ())

(defmethod operation-impl ((impl concrete-implementation-a))
  (format t "ConcreteImplementationA: Operation"))

(defclass concrete-implementation-b ()
  ())

(defmethod operation-impl ((impl concrete-implementation-b))
  (format t "ConcreteImplementationB: Operation"))

(defclass abstraction ()
  ((impl :initarg :impl :accessor impl)))

(defmethod operation ((abst abstraction))
  (format t "Abstraction: Additional logic")
  (operation-impl (impl abst)))

;; Usage
(defparameter *impl-a* (make-instance 'concrete-implementation-a))
(defparameter *impl-b* (make-instance 'concrete-implementation-b))
(defparameter *abstraction1* (make-instance 'abstraction :impl *impl-a*))
(defparameter *abstraction2* (make-instance 'abstraction :impl *impl-b*))
(operation *abstraction1*)
(operation *abstraction2*)

;; Adapter pattern
(defclass target ()
  ())

(defmethod request ((obj target))
  (format t "Target: Request"))

(defclass adaptee ()
  ())

(defmethod specific-request ((obj adaptee))
  (format t "Adaptee: Specific Request"))

(defclass adapter ()
  ((adaptee :initarg :adaptee :accessor adaptee)))

(defmethod request ((obj adapter))
  (specific-request (adaptee obj)))

;; Usage
(defparameter *adaptee* (make-instance 'adaptee))
(defparameter *adapter* (make-instance 'adapter :adaptee *adaptee*))
(request *adapter*)

;; Facade pattern
(defclass subsystem-a ()
  ())

(defmethod operation-a ((obj subsystem-a))
  (format t "SubsystemA: Operation"))

(defclass subsystem-b ()
  ())

(defmethod operation-b ((obj subsystem-b))
  (format t "SubsystemB: Operation"))

(defclass facade ()
  ((subsystem-a :initform (make-instance 'subsystem-a) :accessor subsystem-a)
   (subsystem-b :initform (make-instance 'subsystem-b) :accessor subsystem-b)))

(defmethod operation ((obj facade))
  (operation-a (subsystem-a obj))
  (operation-b (subsystem-b obj))
  (format t "Facade: Complex operation"))

;; Usage
(defparameter *facade* (make-instance 'facade))
(operation *facade*)

;; Composite pattern
(defgeneric operation (component))

(defclass leaf ()
  ((name :initarg :name :accessor name)))

(defmethod operation ((obj leaf))
  (format t "Leaf ~a: Operation" (name obj)))

(defclass composite ()
  ((name :initarg :name :accessor name)
   (children :initform '() :accessor children)))

(defmethod add ((obj composite) component)
  (push component (children obj)))

(defmethod remove ((obj composite) component)
  (setf (children obj) (remove component (children obj))))

(defmethod operation ((obj composite))
  (format t "Composite ~a: Operation" (name obj))
  (dolist (child (children obj))
    (operation child)))

;; Usage
(defparameter *leaf1* (make-instance 'leaf :name "A"))
(defparameter *leaf2* (make-instance 'leaf :name "B"))
(defparameter *composite* (make-instance 'composite :name "Root"))
(add *composite* *leaf1*)
(add *composite* *leaf2*)
(operation *composite*)

;; Visitor pattern
(defgeneric accept (element visitor))
(defgeneric visit (visitor element))

(defclass element-a ()
  ())

(defmethod accept ((obj element-a) visitor)
  (visit visitor obj))

(defclass element-b ()
  ())

(defmethod accept ((obj element-b) visitor)
  (visit visitor obj))

(defclass visitor ()
  ())

(defmethod visit ((visitor visitor) (element element-a))
  (format t "Visiting ElementA"))

(defmethod visit ((visitor visitor) (element element-b))
  (format t "Visiting ElementB"))

;; Usage
(defparameter *visitor* (make-instance 'visitor))
(defparameter *element-a* (make-instance 'element-a))
(defparameter *element-b* (make-instance 'element-b))
(accept *element-a* *visitor*)
(accept *element-b* *visitor*)

;; Iterator pattern
(defclass iterator ()
  ((collection :initarg :collection :accessor collection)
   (index :initform 0 :accessor index)))

(defgeneric next (iterator))
(defgeneric has-next (iterator))

(defmethod next ((it iterator))
  (if (has-next it)
      (let ((result (nth (index it) (collection it))))
        (incf (index it))
        result)
      nil))

(defmethod has-next ((it iterator))
  (< (index it) (length (collection it))))

(defclass custom-collection ()
  ((items :initform '() :accessor items)))

(defmethod add ((col custom-collection) item)
  (push item (items col)))

(defmethod get-iterator ((col custom-collection))
  (make-instance 'iterator :collection (items col)))

;; Usage
(defparameter *collection* (make-instance 'custom-collection))
(add *collection* "A")
(add *collection* "B")
(add *collection* "C")
(defparameter *iterator* (get-iterator *collection*))
(loop while (has-next *iterator*)
      do (format t "~a" (next *iterator*)))

;; Template Method pattern
(defclass abstract-class ()
  ())

(defgeneric template-method (obj))
(defgeneric step1 (obj))
(defgeneric step2 (obj))
(defgeneric step3 (obj))

(defmethod template-method ((obj abstract-class))
  (step1 obj)
  (step2 obj)
  (step3 obj))

(defmethod step1 ((obj abstract-class))
  (format t "Step 1"))

(defmethod step3 ((obj abstract-class))
  (format t "Step 3"))

(defclass concrete-class (abstract-class)
  ())

(defmethod step2 ((obj concrete-class))
  (format t "Concrete Step 2"))

;; Usage
(defparameter *concrete* (make-instance 'concrete-class))
(template-method *concrete*)

;; Builder pattern
(defclass product ()
  ((parts :initform '() :accessor parts)))

(defmethod add-part ((obj product) part)
  (push part (parts obj)))

(defmethod list-parts ((obj product))
  (format t "~a" (parts obj)))

(defclass builder ()
  ((product :initform (make-instance 'product) :accessor product)))

(defmethod reset ((obj builder))
  (setf (parts (product obj)) '()))

(defmethod build-step-a ((obj builder))
  (add-part (product obj) "Part A"))

(defmethod build-step-b ((obj builder))
  (add-part (product obj) "Part B"))

(defmethod get-result ((obj builder))
  (product obj))

(defclass director ()
  ((builder :initarg :builder :accessor builder)))

(defmethod build-minimal ((obj director))
  (build-step-a (builder obj)))

(defmethod build-full ((obj director))
  (build-step-a (builder obj))
  (build-step-b (builder obj)))

;; Usage
(defparameter *builder* (make-instance 'builder))
(defparameter *director* (make-instance 'director :builder *builder*))
(build-minimal *director*)
(defparameter *product* (get-result *builder*))
(list-parts *product*)

;; Prototype pattern
(defclass prototype ()
  ((name :initarg :name :accessor name)
   (nested :initarg :nested :accessor nested)))

(defmethod clone ((obj prototype))
  (make-instance 'prototype
                 :name (name obj)
                 :nested (copy-list (nested obj))))

(defmethod deep-clone ((obj prototype))
  (make-instance 'prototype
                 :name (name obj)
                 :nested (deep-copy (nested obj))))

(defun deep-copy (obj)
  (cond
    ((null obj) nil)
    ((atom obj) obj)
    ((listp obj) (mapcar #'deep-copy obj))
    ((hash-table-p obj)
     (let ((new (make-hash-table :test (hash-table-test obj))))
       (maphash (lambda (key value)
                  (setf (gethash key new) (deep-copy value)))
                obj)
       new))
    (t obj)))

;; Usage
(defparameter *original* 
  (make-instance 'prototype :name "Original" :nested '((value . 42))))
(defparameter *copy* (clone *original*))
(setf (name *copy*) "Copy")
(setf (cdr (assoc 'value (nested *copy*))) 99)
(format t "~a" (name *original*)) ; Original
(format t "~a" (cdr (assoc 'value (nested *original*)))) ; 42 (shallow copy)

(defparameter *deep-copy* (deep-clone *original*))
(setf (cdr (assoc 'value (nested *deep-copy*))) 100)
(format t "~a" (cdr (assoc 'value (nested *original*)))) ; 42 (deep copy)