1. 1
2. 2
3. 3
4. 4
5. 5
6. 6
7. 7
8. 8
9. 9
10. 10
11. 11
12. 12
13. 13
14. 14
15. 15
16. 16
17. 17
18. 18
19. 19
20. 20
21. 21
22. 22
23. 23
24. 24
25. 25
26. 26
27. 27
28. 28
29. 29
30. 30
31. 31
32. 32
33. 33
34. 34
35. 35
36. 36
37. 37
38. 38
39. 39
40. 40
41. 41
42. 42
43. 43
44. 44
45. 45
46. 46
47. 47
48. 48
49. 49
50. 50
51. 51
52. 52
53. 53
54. 54
55. 55
56. 56
57. 57
58. 58
59. 59
60. 60
61. 61
62. 62
63. 63
64. 64
65. 65
66. 66
67. 67
68. 68
69. 69
70. 70
71. 71
72. 72
73. 73
74. 74
75. 75
76. 76
77. 77
78. 78
79. 79
80. 80
81. 81
82. 82
83. 83
84. 84
85. 85
86. 86
87. 87
88. 88
89. 89
90. 90
91. 91
92. 92
93. 93
94. 94
95. 95
96. 96
97. 97

{-# LANGUAGE BangPatterns #-}

import Data.List (intercalate)

-- Тип для представления пары значений
data TwoVal = TwoVal !Int !Int
  deriving (Show, Eq)

-- Тип для пары с флагом обмена
data TwoValAndStatus = TwoValAndStatus 
  { isSwapped :: !Bool
  , twoVal    :: !TwoVal
  } deriving (Show, Eq)

-- Тип для массива (используем список для идиоматичности Haskell)
type Array = [Int]

-- Тип для массива с состоянием сортировки
data ArrayAndStatus = ArrayAndStatus
  { hasSwap :: !Bool
  , position :: !Int
  , array :: !Array
  } deriving (Show, Eq)

-- Сортировка двух элементов с возвратом статуса обмена
sort2 :: TwoVal -> TwoValAndStatus
sort2 (TwoVal a b)
  | a > b     = TwoValAndStatus True (TwoVal b a)
  | otherwise = TwoValAndStatus False (TwoVal a b)

-- Чтение пары значений из массива по позиции
readTwoVal :: Array -> Int -> Maybe TwoVal
readTwoVal arr pos
  | pos < length arr - 1 = Just $ TwoVal (arr !! pos) (arr !! (pos + 1))
  | otherwise = Nothing

-- Сохранение значения в массив по индексу
storeVal :: Array -> Int -> Int -> Array
storeVal arr val pos = 
  take pos arr ++ [val] ++ drop (pos + 1) arr

-- Сохранение пары значений в массив
storeTwoVal :: Array -> TwoVal -> Int -> Array
storeTwoVal arr (TwoVal a b) pos =
  storeVal (storeVal arr a pos) b (pos + 1)

-- Рекурсивная функция сортировки пузырьком
bubbleSortRec :: ArrayAndStatus -> ArrayAndStatus
bubbleSortRec state@(ArrayAndStatus swap pos arr)
  | pos >= length arr - 1 = 
      if not swap
        then state  -- Сортировка завершена!
        else bubbleSortRec $ ArrayAndStatus False 0 arr  -- Новый проход
  | otherwise = 
      case readTwoVal arr pos of
        Nothing -> state
        Just pair -> -- ← Переименовали переменную здесь
          let sortResult = sort2 pair
              newArr = storeTwoVal arr (twoVal sortResult) pos -- ← Используем селектор twoVal
              newSwap = swap || isSwapped sortResult
          in bubbleSortRec $ ArrayAndStatus newSwap (pos + 1) newArr

-- Основная функция сортировки
bubbleSort :: Array -> Array
bubbleSort arr = array $ bubbleSortRec $ ArrayAndStatus False 0 arr

-- Более идиоматичная версия для Haskell (альтернативная реализация)
bubbleSortIdiomatic :: Ord a => [a] -> [a]
bubbleSortIdiomatic = untilFixed bubblePass
  where
    bubblePass [] = []
    bubblePass [x] = [x]
    bubblePass (x:y:xs)
      | x > y     = y : bubblePass (x:xs)
      | otherwise = x : bubblePass (y:xs)
    
    untilFixed f x = let fx = f x
                     in if fx == x then x else untilFixed f fx

-- Функция для красивого вывода
showArray :: Show a => [a] -> String
showArray = intercalate ", " . map show

-- Главная функция
main :: IO ()
main = do
  let initialArray = [8, 2, 4, 1, 3, 5, 7, 0, 6, 9]
  let sortedArray = bubbleSort initialArray
  
  putStrLn "input"
  putStrLn $ showArray initialArray
  
  putStrLn "\nsort:"
  putStrLn $ showArray sortedArray
  
  putStrLn "\nsort2:"
  putStrLn $ showArray $ bubbleSortIdiomatic initialArray

1. 1
2. 2
3. 3
4. 4
5. 5
6. 6
7. 7

(defun s (f)
  (lambda (g)
    (lambda (x)
      (funcall (funcall f x) (funcall g x)))))

(let ((result #'(lambda () (funcall (funcall (funcall #'s #'(lambda (n) #'(lambda (x) (+ x n)))) #'(lambda (x) (* x x))) 5))))
  (print (funcall result)))

1. 1
2. 2
3. 3
4. 4
5. 5
6. 6
7. 7
8. 8
9. 9
10. 10
11. 11
12. 12
13. 13
14. 14
15. 15
16. 16
17. 17
18. 18
19. 19
20. 20
21. 21
22. 22
23. 23
24. 24
25. 25
26. 26
27. 27
28. 28
29. 29
30. 30
31. 31
32. 32
33. 33
34. 34
35. 35
36. 36
37. 37
38. 38
39. 39
40. 40
41. 41
42. 42
43. 43
44. 44
45. 45
46. 46
47. 47
48. 48
49. 49
50. 50
51. 51
52. 52
53. 53
54. 54
55. 55
56. 56
57. 57
58. 58
59. 59
60. 60
61. 61
62. 62
63. 63
64. 64
65. 65
66. 66
67. 67
68. 68
69. 69
70. 70
71. 71
72. 72
73. 73
74. 74
75. 75
76. 76
77. 77
78. 78
79. 79
80. 80
81. 81
82. 82
83. 83
84. 84
85. 85
86. 86
87. 87
88. 88
89. 89
90. 90
91. 91
92. 92
93. 93

(ql:quickload :drakma)
(ql:quickload :lparallel)

;; CURL ANALYSIS

(defmethod sb-mop:validate-superclass ((metaclass class) (superclass standard-class)) t)

;; Analasys-Assert class
(defclass anal-ass (standard-class)
  ((%form :initarg :form :initform nil :accessor form)
   (%cond :initarg :cond :initform nil :accessor econd)
   (%mesg :initarg :msg :initform "Error" :accessor msg)))

(defmacro build-anal-ass (&body args)
  `(make-instance 'anal-ass ,@args))

(defmethod process-ass-synergy ((anal-ass-factory anal-ass))
  (let ((anal-ass-factory-cond-master (econd anal-ass-factory))
        (anal-ass-factory-form-master (form anal-ass-factory))
        (anal-ass-factory-msg-master (msg anal-ass-factory)))

    (declare (ignore anal-ass-factory-form-master))

    (assert anal-ass-factory-cond-master nil anal-ass-factory-msg-master)))

;; Analasys class
(defclass anal-factory (standard-class)
  ((%body-manager :initarg :body :initform nil :accessor body-manager)
   (%status-manager :initarg :status :initform nil :accessor status-manager)
   (%headers-manager :initarg :headers :initform nil :accessor headers-manager)
   (%uri-manager :initarg :uri :initform nil :accessor uri-manager)
   (%stream-manager :initarg :stream :initform nil :accessor stream-manager)
   (%must-close-manager :initarg :must-close :initform nil :accessor must-close-manager)
   (%reason-phrase-manager :initarg :reason-phrase :initform nil :accessor reason-phrase-manager)))

(defmethod initialize-instance :after ((anal-ass-factory anal-ass) &key &allow-other-keys)
  (assert (and (form anal-ass-factory) (econd anal-ass-factory) (msg anal-ass-factory)) nil
    "Invalid Analysis-Assert structure"))

(defmethod initialize-instance :after ((anal-factory-factory anal-factory) &key &allow-other-keys)
  (let ((anal-body-ass-manager (build-anal-ass :msg "Body manager is nil" :form t :cond #'(lambda () (body-manager anal-factory-factory))))
        (anal-status-ass-manager (build-anal-ass :msg "Status manager is nil" :form t :cond #'(lambda () (status-manager anal-factory-factory))))
        (anal-headers-ass-manager (build-anal-ass :msg "Headers manager is nil" :form t :cond #'(lambda () (headers-manager anal-factory-factory))))
        (anal-uri-ass-manager (build-anal-ass :msg "URI manager is nil" :form t :cond #'(lambda () (uri-manager anal-factory-factory))))
        (anal-stream-ass-manager (build-anal-ass :msg "Stream manager is nil" :form t :cond #'(lambda () (stream-manager anal-factory-factory))))
        (anal-must-close-ass-manager (build-anal-ass :msg "Must-close manager is nil" :form t :cond #'(lambda () (must-close-manager anal-factory-factory))))
        (anal-reason-phrase-ass-manager (build-anal-ass :msg "Reason phrase manager is nil" :form t :cond #'(lambda () (reason-phrase-manager anal-factory-factory)))))

    (process-ass-synergy anal-body-ass-manager)
    (process-ass-synergy anal-status-ass-manager)
    (process-ass-synergy anal-headers-ass-manager)
    (process-ass-synergy anal-uri-ass-manager)
    (process-ass-synergy anal-stream-ass-manager)
    (process-ass-synergy anal-must-close-ass-manager)
    (process-ass-synergy anal-reason-phrase-ass-manager)))

(defmacro deep-anal-factory (&body args)
  `(make-instance 'anal-factory ,@args))

(defclass drakma-manager (standard-class)
  ((%body-meta-manager :initform nil :initarg :body :accessor body)))

(defmethod requires-meta-manager ((drakma-manager-factory drakma-manager))
  (funcall (body drakma-manager-factory)))

(defmacro make-drakma-meta-manager (&body args)
  `(make-instance 'drakma-manager ,@args))

(defun anal-manager (url &key (method :get) parameters)
  (locally
    (declare (optimize (speed 0) (debug 0) (safety 0) (space 0)))

    (multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
      (let* ((eval #'(lambda () (drakma:http-request url :method method
                                                         :parameters parameters
                                                         :want-stream nil)))

             (drakma-meta-manager (make-drakma-meta-manager :body eval)))

        (requires-meta-manager drakma-meta-manager))

      (declare (optimize (speed 3)))

      (let ((deep-anal (deep-anal-factory
                          :body body
                          :status status-code
                          :headers headers
                          :uri uri
                          :stream stream
                          :must-close must-close
                          :reason-phrase reason-phrase)))

        (identity deep-anal)))))

1. 1
2. 2
3. 3
4. 4
5. 5
6. 6
7. 7
8. 8
9. 9
10. 10
11. 11
12. 12
13. 13
14. 14
15. 15
16. 16
17. 17
18. 18
19. 19
20. 20
21. 21
22. 22
23. 23
24. 24
25. 25
26. 26
27. 27
28. 28
29. 29
30. 30
31. 31
32. 32
33. 33
34. 34
35. 35
36. 36
37. 37
38. 38
39. 39
40. 40
41. 41
42. 42
43. 43
44. 44
45. 45
46. 46
47. 47
48. 48
49. 49
50. 50
51. 51
52. 52
53. 53
54. 54
55. 55
56. 56
57. 57
58. 58
59. 59
60. 60
61. 61
62. 62
63. 63
64. 64
65. 65
66. 66
67. 67
68. 68
69. 69
70. 70
71. 71
72. 72
73. 73
74. 74
75. 75
76. 76
77. 77
78. 78
79. 79
80. 80
81. 81
82. 82
83. 83
84. 84
85. 85
86. 86
87. 87
88. 88
89. 89
90. 90
91. 91
92. 92
93. 93
94. 94
95. 95
96. 96
97. 97
98. 98
99. 99

(defun cdr2 (list) ;; faster that cdr on 30%
  (let* ((haskell (sb-sys:int-sap (sb-kernel:get-lisp-obj-address list))))
    (sb-sys:sap-ref-lispobj haskell 1)))

(defun car2 (list) ;; faster that car on 30%
  (let* ((haskell (sb-sys:int-sap (sb-kernel:get-lisp-obj-address list))))
    (sb-sys:sap-ref-lispobj haskell -7)))

(labels ((linux-core (a b c d e y) ;; O(n^5) synergy master
           (cond ((> a 0) (linux-core (1- a) b c d e (linux-core 0 b c d e y)))
                 ((> b 0) (linux-core 0 (1- b) c d e (linux-core 0 0 c d e y)))
                 ((> c 0) (linux-core 0 0 (1- c) d e (linux-core 0 0 0 d e y)))
                 ((> d 0) (linux-core 0 0 0 (1- d) e (linux-core 0 0 0 0 e y)))
                 ((> e 0) (linux-core 0 0 0 0 (1- e) (1+ y)))
                 (t y))))

  (defun add (x y)
    (linux-core x x x x x y))

  (defun mul (x y &aux (r 0))
    (dotimes (i x r) (setf r (add r y))))

  (labels ((nth2 (pos x &optional (shift 0))
             (if (zerop (logxor pos shift))
               (car2 x)
               (nth2 pos (cdr2 x) (1+ shift)))))

    (defun nth3 (position list)
      (nth2 position list))))

(defun len (x &optional (calc 1))
  (if (null (cdr2 x))
    calc
    (len (cdr2 x) (1+ calc))))

(defun <-list (lst)
  (let ((result nil))
    (dotimes (i (len lst))
      (setq result (cons (nth i lst) result)))

    result))

(defmacro push2 (x y)
  `(setq ,y (cons ,x ,y)))

(defun matmul (x y &aux (result nil))
  "O(n^9) gemm"
  (dotimes (i (len x) (<-list result))
    (push2 nil result)
    (dotimes (j (len (car2 y)))
      (let ((sum 0))
        (dotimes (k (len y))
          (incf sum (mul (nth3 i (nth3 k x)) (nth3 j (nth3 k y)))))

        (setq sum (cons sum (car2 result)))))))

(defun synergy-manager (synergy catallaxy)
  "O((n^7)!) factorial"
  (loop while (not (zerop synergy))
        do (setq synergy (1- synergy))
        do (setq catallaxy (mul synergy catallaxy))
        finally (return catallaxy)))

(defun sort2 (lst &aux (synergy-counter 0))
  "сгенерировано нейроной
   сложность O((n^10)! * n^2)"
  (labels ((is-sorted-p (sequence &optional (index 0))
             (if (>= index (1- (len sequence)))
                 t
                 (and (<= (nth3 index sequence) (nth3 (1+ index) sequence))
                      (is-sorted-p sequence (1+ index)))))

           (random-position (max)
             (mod (mul (get-universal-time) synergy-counter) max))

           (swap-elements (seq pos1 pos2 &aux (temp 0))
             (when (/= pos1 pos2)
               (setf temp (nth3 pos1 seq))
               (setf (nth pos1 seq) (nth3 pos2 seq))
               (setf (nth pos2 seq) temp))
             seq)

           (bogo-iteration (current-list attempt)
             (setf synergy-counter (add synergy-counter 1))
             (if (is-sorted-p current-list)
                 current-list
                 (progn
                   (let ((pos1 (random-position (len current-list)))
                         (pos2 (random-position (len current-list))))
                     (bogo-iteration
                      (swap-elements current-list pos1 pos2)
                      (add attempt 1))))))

           (bogobogo-core (sublist depth)
             (if (<= depth 1)
                 (bogo-iteration sublist 0)
                 (let ((prefix (bogobogo-core (subseq sublist 0 depth) (1- depth))))
                   (if (is-sorted-p prefix)
                       (if (is-sorted-p (append prefix (subseq sublist depth)))