Advertisement
Nuparu00

♥♥♥

Jan 3rd, 2022
2,603
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 6.54 KB | None | 0 0
  1. (defun flatten (list)
  2.   (cond ((null list) nil)
  3.         ((consp (car list)) (append (flatten (car list)) (flatten (cdr list))))
  4.         (t (cons (car list) (flatten (cdr list))))))
  5.  
  6. (defun deep-reverse (list)
  7.   (labels ((deep (list copy)  
  8.              (cond ((null list) copy)
  9.                    ((consp (car list)) (deep (cdr list) (cons (deep-reverse (car list)) copy)))
  10.                    (t (deep (cdr list) (cons (car list) copy)))
  11.                    )))
  12.     (deep list '())))
  13.  
  14.  
  15. ;;(let ((x 1)) (let ((x (- x 10)) (y (1+ x))) y))
  16. ;;let ((x 1)) (let* ((x (- x 10)) (y (1+ x))) y))
  17.  
  18.  
  19. (defun blabla (x)
  20.   (if (consp x)
  21.       (cons (blabla (cdr x))
  22.             (blabla (car x)))
  23.     x))
  24.  
  25. (defun tailz (list)
  26.   (cond ((null list) (cons nil nil))
  27.         (t (cons list (tailz (cdr list)))
  28.            )))
  29.  
  30. (defun new-from-two (seq)
  31.   (lambda (x) (* (funcall seq x) (funcall seq (1+ x)))))
  32.  
  33. (defun all-intervals (start end)
  34.   (cond ((> start end) nil)
  35.         (t (append (func start end start) (all-intervals (1+ start) end)))))
  36.  
  37.  
  38. (defun func (start end count)
  39.   (cond ((> count end) nil)
  40.         (t (cons (cons start count) (func start end (1+ count))))))
  41.  
  42. (defun tree-height (tree)
  43.   (cond ((null tree) 0)
  44.         (t (1+ (max-height-children (cdr tree))))
  45.         ))
  46.  
  47. (defun max-height-children (children)
  48.   (cond ((null children) -1)
  49.         (t (max (tree-height (car children)) (max-height-children (cdr children))))))
  50.  
  51. ;;(defun spiral (length count)
  52. ;;  (cond ((<= count 0) 0)
  53. ;;        (t (progn (turtle:draw length) (turtle:turn pi/2) (spiral (* (/ 3 4) length) (1- count))))))
  54.  
  55.  
  56.  
  57.  
  58. (defun last-n (list n)
  59.   (let ((res (hilfe list list n)))
  60.     (cond ((>= (cdr res) n) (car res))
  61.           (t (- n (cdr res))))))
  62.  
  63. ;; ( (0 1 2 3 4) . 5)
  64. (defun hilfe(orig list n)
  65.   (cond ((null list) (cons nil 0))
  66.         (t (let ((next (hilfe orig (cdr list) n)))
  67.              (cond ((>= (cdr next) n) next)
  68.                    (t (cons (cons (car list) (car next)) (1+ (cdr next)))))))))
  69.  
  70.  
  71. (defun last-nn (list n)
  72.               (cond ((null list) n)
  73.                     ((= n 0) nil)
  74.                     ((= n 1) list)
  75.                     (t (last-nn (cdr list) (- n 1)))))
  76.  
  77. (defun last-nnn (list n)
  78.   (cond ((null list) n)
  79.         ((= n 0) nil)
  80.         ((> n (length list)) (- n (length list)))
  81.         (t (iter list (- (length list) n)))))
  82.  
  83. (defun iter (list x)
  84.   (if (> x 0)
  85.       (iter (cdr list) (- x 1))
  86.     list))
  87.  
  88.  
  89. (defun tbl-test (row col)
  90.   (* row (+ col 1)))
  91.  
  92. (defun zero-row-p (tbl row)
  93.   (labels ((test (col) (or (> col 9)
  94.                            (and (= 0 (funcall tbl row col))
  95.                                 (test (1+ col))))))
  96.     (test 0)))
  97.  
  98.  
  99. (defun fandom (fun)
  100.   (let ((rnd (random 100)))
  101.     (if (funcall fun rnd) rnd (fandom fun))  
  102.     ))
  103.  
  104. (defun interleave (a b)
  105.   (cond ((null a) b)
  106.         ((null b) a)
  107.         (t (cons (car a) (interleave b (cdr a))))))
  108.  
  109. (defun pascal (col row)
  110.   (cond ((= 0 col) 1)
  111.         ((= col row) 1)
  112.         (t (+ (pascal (1- col) (1- row)) (pascal col (1- row))))))
  113.  
  114. (defun pascal-row (row)
  115.   (labels ((lokal (col)
  116.              (cond ((> col row) nil)
  117.                    (t (cons (pascal col row) (lokal (1+ col)))))))
  118.     (lokal 0)))
  119.                          
  120.  
  121. (defun first-less (seqA seqB)
  122.   (labels ((test (x) (cond ((< (funcall seqA x) (funcall seqB x)) x)
  123.                            (t (test (1+ x))))))
  124.     (test 0)))
  125.  
  126. (defun max-path♥♥ (tree)
  127.   (car (max-path♥ tree)))
  128.  
  129.  
  130. (defun max-path♥ (tree)
  131.   (cond ((null tree) (cons nil -1))
  132.         (t (let ((children (max-path-children (cdr tree) (cons nil -1))))
  133.              (cons (cons (car tree) (car children)) (1+ (cdr children)))
  134. ))))
  135.  
  136. (defun max-path-children (children max)
  137.   (cond ((null children) max)
  138.         (t (let ((child (max-path♥ (car children))))
  139.              (if (< (cdr max) (cdr child))
  140.                  (max-path-children (cdr children) child )
  141.                (max-path-children (cdr children) max))))))
  142.                
  143.  
  144. ;;(let ((x 5))(print x)(x))
  145.  
  146. ;;(countz '(1 (2 3) 4) )
  147. (defun countz (list)
  148.   (cond ((consp list) (+ (countz (car list))
  149.                          (countz (cdr list))))
  150.         ((null list) (progn (print list) 1))
  151.         (t 0)))
  152.  
  153. (defun each-2nd (list)
  154.   (labels ((♥♥♥ (list c)
  155.              (cond ((null list) nil)
  156.                    ((evenp c) (cons (car list) (♥♥♥ (cdr list) (1+ c))))
  157.                    (t (♥♥♥ (cdr list) (1+ c))))))(♥♥♥ list 1)))
  158.  
  159. (defun trianglep (a b c)
  160.   (> (+ a b c) (* 2 (max a b c))))
  161.  
  162. (defun digit-count (x) (digit-count-internal x 0))
  163.  
  164. (defun digit-count-internal (x count)
  165.        (if (< x 1) count (digit-count-internal (/ x 10) (+ count 1))))
  166.  
  167. ;;Returns the digit at Nth position from the right without using mod/rem, starts from 1
  168. (defun digit (x n)
  169.         (floor (* (- (/ x (power 10 (1+ n)))
  170.             (floor (/ x (power 10 (1+ n)))) ) 10)) )
  171.  
  172. ;;12
  173. (defun power (x n) (power-internal x n 1))
  174.  
  175. (defun power-internal (x n res) (if (> n  0) (power-internal x (- n 1) (* res x)) res))
  176.  
  177. (defun digit-sum (x) (digit-sum-internal x (digit-count x) 0 0))
  178.  
  179. (defun digit-sum-internal (x length pos sum)
  180.   (if (> pos length) sum (digit-sum-internal x length (+ pos 1) (+ sum (digit x pos)))))
  181.  
  182. ;;Uses digit-sum --> see 5 lines above
  183. ;;(defun multiply-of-9-internal-p (x) (if (>= x 10) (multiply-of-9-internal-p (digit-sum x)) (= x 9) ))
  184.  
  185. ;;(defun multiply-of-9-p (x) (multiply-of-9-internal-p (digit-sum x)))
  186.  
  187. (defun notsofunnyfunc (x)
  188.   (cond ((> x 9) (notsofunnyfunc (digit-sum x)))
  189.         ((> x 0) (notsofunnyfunc (- x 3)))
  190.         ((= x 0) t)
  191.         (t nil)))
  192.  
  193. (defun pp (x)
  194.   (or (and (> x 9) (pp (digit-sum x)))
  195.       (and (> x 0) (pp (- x 3)))
  196.       (= x 0)))
  197.  
  198. (defun lidl (predi list)
  199.   (and (not (null list)) (or (funcall predi (car list)) (lidl predi (cdr list)))))
  200.  
  201. (defun my-signum (x)
  202.   (signum x))
  203.  
  204. (defun euler (n)
  205.   (labels ((phun (x denom) (cond ((> x n) 0)
  206.                            (t (+ (/ 1 (* x denom)) (phun (1+ x) (* x denom))))))) (* 1.0 (1+ (phun 1 1)))))
  207.  
  208. (defun same-sums-p (list)
  209.   (apply #'= (mapcar #'sumsum list)))
  210.  
  211. (defun sumsum (list)
  212.   (apply #'+ list))
  213.  
  214. (defun prefix-to-infox (input)
  215.   (cond ((<= (length input) 2) input)
  216.         (t (infixee (car input) (cdr input)))))
  217.  
  218.  
  219. (defun infixee (op args)
  220.   (cond ((null (cdr args)) (cons (car args) nil))
  221.         (t (cons (car args) (cons op (infixee op (cdr args)))))))
  222.  
  223. (defun seq-shift (seq shift)
  224.   (lambda (x) (if (< (+ x shift) 0) 0 (funcall seq (+ x shift)))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement