fork download
copy 
  1. ; your code goes here
  2. ;;; =============================================
  3. ;;; Функції (deffunctions)
  4. ;;; =============================================
  5.  
  6. (deffunction cantor-cdf (?x) ;;; Функція для обчислення кумулятивної функції розподілу Кантора
  7.   (if (<= ?x 0.0) then (return 0.0))
  8.   (if (>= ?x 1.0) then (return 1.0))
  9.   (if (and (> ?x 0.0) (<= ?x (/ 1.0 3.0))) then
  10.      (return (/ (cantor-cdf (* 3.0 ?x)) 2.0)))
  11.   (if (and (> ?x (/ 1.0 3.0)) (<= ?x (/ 2.0 3.0))) then
  12.      (return 0.5))
  13.   (if (and (> ?x (/ 2.0 3.0)) (< ?x 1.0)) then
  14.      (return (+ 0.5 (/ (cantor-cdf (- (* 3.0 ?x) 2.0)) 2.0))))
  15.   (return 0.0) ;;; Не повинно досягатися, якщо x в [0,1]
  16. )
  17.  
  18. ;;; Допоміжні функції для роботи з multifields
  19. (deffunction get-min-from-multifield ($?mf) ;;; Отримати мінімальне значення з multifield
  20.     (if (eq (length$ $?mf) 0) then (return 0.0))
  21.     (bind ?min-val (nth$ 1 $?mf))
  22.     (foreach ?val $?mf
  23.         (if (< ?val ?min-val) then (bind ?min-val ?val))
  24.     )
  25.     (return ?min-val)
  26. )
  27.  
  28. (deffunction get-max-from-multifield ($?mf) ;;; Отримати максимальне значення з multifield
  29.     (if (eq (length$ $?mf) 0) then (return 0.0))
  30.     (bind ?max-val (nth$ 1 $?mf))
  31.     (foreach ?val $?mf
  32.         (if (> ?val ?max-val) then (bind ?max-val ?val))
  33.     )
  34.     (return ?max-val)
  35. )
  36.  
  37. (deffunction generate-thresholds (?min-val ?max-val ?alphabet-size) ;;; Генерує пороги інтервалів
  38.   (bind ?range-val (- ?max-val ?min-val))
  39.   (bind ?thresholds (create$))
  40.   ;;; Цикл alphabet_size + 1 разів для обчислення i/alphabet_size
  41.   (loop-for-count (?i 0 ?alphabet-size) 
  42.     (bind ?p (if (= ?alphabet-size 0) then 0.0 else (/ (float ?i) ?alphabet-size)))
  43.     (bind ?cdf-val (cantor-cdf ?p))
  44.     (bind ?threshold-val (+ ?min-val (* ?cdf-val ?range-val)))
  45.     (bind ?thresholds (create$ ?thresholds ?threshold-val))
  46.   )
  47.   ;;; Переконуємося, що останній поріг точно дорівнює max-val, якщо діапазон не нульовий (для обробки можливих неточностей float)
  48.   (if (and (> ?range-val 0.0) (> (length$ ?thresholds) 0) )
  49.   then
  50.       (if (< (nth$ (length$ ?thresholds) ?thresholds) ?max-val)
  51.       then
  52.           (bind ?thresholds (replace$ ?thresholds (length$ ?thresholds) (length$ ?thresholds) ?max-val))
  53.       )
  54.   )
  55.   (return ?thresholds)
  56. )
  57.  
  58. (deffunction map-value-to-letter (?value ?intervals-mf ?alphabet-chars-mf) ;;; Відображає числове значення на символ алфавіту
  59.   (bind ?num-chars (length$ ?alphabet-chars-mf))
  60.   (bind ?mapped-letter (nth$ ?num-chars ?alphabet-chars-mf)) ;;; За замовчуванням остання літера
  61.  
  62.   (loop-for-count (?idx 1 ?num-chars)
  63.     (bind ?lower-bound (nth$ ?idx ?intervals-mf))
  64.     (bind ?upper-bound (nth$ (+ ?idx 1) ?intervals-mf))
  65.     (if (and (< ?idx ?num-chars) (>= ?value ?lower-bound) (< ?value ?upper-bound)) then
  66.        (bind ?mapped-letter (nth$ ?idx ?alphabet-chars-mf))
  67.        (return ?mapped-letter)
  68.     )
  69.     ;;; Останній інтервал включає верхню межу
  70.     (if (and (= ?idx ?num-chars) (>= ?value ?lower-bound) (<= ?value ?upper-bound)) then 
  71.        (bind ?mapped-letter (nth$ ?idx ?alphabet-chars-mf))
  72.        (return ?mapped-letter)
  73.     )
  74.   )
  75.   (return ?mapped-letter)
  76. )
  77.  
  78. (deffunction build-linguistic-row-mf (?original-series-mf ?intervals-mf ?alphabet-chars-mf) ;;; Будує лінгвістичний ряд (multifield)
  79.   (bind ?ling-row (create$))
  80.   (foreach ?val ?original-series-mf
  81.     (bind ?letter (map-value-to-letter ?val ?intervals-mf ?alphabet-chars-mf))
  82.     (bind ?ling-row (create$ ?ling-row ?letter))
  83.   )
  84.   (return ?ling-row)
  85. )
  86.  
  87. ;;; =============================================
  88. ;;; Шаблони фактів (deftemplates)
  89. ;;; =============================================
  90. (deftemplate precedence-cell ;;; Шаблон для комірки матриці передування
  91.   (slot char1 (type SYMBOL))
  92.   (slot char2 (type SYMBOL))
  93.   (slot count (type INTEGER) (default 0))
  94. )
  95.  
  96. ;;; =============================================
  97. ;;; Початкові факти та керування (deffacts)
  98. ;;; =============================================
  99. (deffacts initial-data
  100.   (numeric-series-raw (values 2.828 2.804 2.776 2.772 2.795 2.77 2.74 2.726 2.716 2.72 2.737))
  101.   (alphabet-definition (name "ABCDE"))
  102.   (status (phase initialize)) ;;; Початковий стан
  103. )
  104.  
  105. ;;; =============================================
  106. ;;; Правила - Керування потоком та логіка (defrules)
  107. ;;; =============================================
  108.  
  109. ;;; --- Фаза 1: Налаштування ---
  110. (defrule setup-alphabet-and-sorting-init
  111.   (status (phase initialize))
  112.   (alphabet-definition (name ?alpha-name))
  113.   (numeric-series-raw (values $?nums))
  114.   =>
  115.   (assert (alphabet (chars (explode$ ?alpha-name))))
  116.   (printout t "Фаза: Налаштування завершено. Алфавіт завантажено." crlf)
  117.   (foreach ?num ?nums
  118.     (assert (number-to-sort (value ?num)))
  119.   )
  120.   (assert (sorted-list-accumulator (values)))
  121.   (printout t "Фаза: Ініціалізація сортування..." crlf)
  122.   (assert (status (phase sorting)))
  123. )
  124.  
  125. ;;; --- Фаза 2: Сортування (Стиль сортування вибором) ---
  126. (defrule selection-sort-step
  127.   ?s <- (status (phase sorting))
  128.   ?min-fact <- (number-to-sort (value ?min-val))
  129.   (not (number-to-sort (value ?v&:(< ?v ?min-val)))) ;;; ?min-val - поточний мінімум
  130.   ?acc <- (sorted-list-accumulator (values $?sorted-vals))
  131.   =>
  132.   (retract ?min-fact)
  133.   (modify ?acc (values $?sorted-vals ?min-val))
  134.   (printout t "Відсортовано: " ?min-val crlf) 
  135. )
  136.  
  137. (defrule finish-sorting
  138.   (status (phase sorting))
  139.   (not (number-to-sort)) ;;; Всі числа переміщено з number-to-sort
  140.   ?acc <- (sorted-list-accumulator (values $?final-sorted-list))
  141.   =>
  142.   (retract ?acc)
  143.   (assert (sorted-series (values $?final-sorted-list)))
  144.   (printout t "Фаза: Сортування завершено. Відсортований ряд: " $?final-sorted-list crlf)
  145.   (assert (status (phase intervals-needed)))
  146. )
  147.  
  148. ;;; --- Фаза 3: Генерація інтервалів ---
  149. (defrule generate-intervals-rule
  150.   (status (phase intervals-needed))
  151.   (sorted-series (values $?s))
  152.   (alphabet (chars $?a))
  153.   =>
  154.   (bind ?min-val (nth$ 1 $?s)) ;;; Припускаємо, що $?s не порожній після сортування
  155.   (bind ?max-val (nth$ (length$ $?s) $?s))
  156.   (bind ?alphabet-size (length$ $?a))
  157.   ;;; Уникаємо ділення на нуль, якщо алфавіт порожній
  158.   (if (= ?alphabet-size 0) then (bind ?alphabet-size 1)) 
  159.  
  160.   (bind ?thresholds-mf (generate-thresholds ?min-val ?max-val ?alphabet-size))
  161.   (assert (intervals (thresholds ?thresholds-mf)))
  162.   (printout t "Фаза: Інтервали згенеровано. Пороги: " ?thresholds-mf crlf)
  163.   (assert (status (phase linguistic-row-needed)))
  164. )
  165.  
  166. ;;; --- Фаза 4: Побудова лінгвістичного ряду ---
  167. (defrule build-linguistic-row-rule
  168.   (status (phase linguistic-row-needed))
  169.   ;;; Використовуємо оригінальний несортований ряд для відображення
  170.   (numeric-series-raw (values $?orig-s)) 
  171.   (intervals (thresholds $?t))
  172.   (alphabet (chars $?a))
  173.   =>
  174.   (bind ?ling-row-mf (build-linguistic-row-mf ?orig-s $?t $?a))
  175.   (assert (linguistic-series (letters ?ling-row-mf)))
  176.   (printout t "Фаза: Лінгвістичний ряд побудовано. Ряд: " ?ling-row-mf crlf)
  177.   (assert (status (phase matrix-needed)))
  178. )
  179.  
  180. ;;; --- Фаза 5: Побудова матриці передування ---
  181. (defrule matrix-initialization-and-computation
  182.   (status (phase matrix-needed))
  183.   (alphabet (chars $?alphabet_chars))
  184.   (linguistic-series (letters $?ling_series))
  185.   =>
  186.   ;;; Ініціалізація всіх можливих комірок матриці передування нулями
  187.   (printout t "Фаза: Ініціалізація комірок матриці передування..." crlf)
  188.   (foreach ?char1 ?alphabet_chars
  189.     (foreach ?char2 ?alphabet_chars
  190.       (assert (precedence-cell (char1 ?char1) (char2 ?char2) (count 0)))
  191.     )
  192.   )
  193.  
  194.   ;;; Обчислення значень лічильників матриці з лінгвістичного ряду
  195.   (printout t "Фаза: Обчислення значень лічильників матриці..." crlf)
  196.   (if (> (length$ ?ling_series) 1) then
  197.     (loop-for-count (?idx 1 (- (length$ ?ling_series) 1))
  198.       (bind ?c1 (nth$ ?idx ?ling_series))
  199.       (bind ?c2 (nth$ (+ ?idx 1) ?ling_series))
  200.  
  201.       (bind ?cell-facts (find-all-facts ((?f precedence-cell)) 
  202.                                        (and (eq ?f:char1 ?c1) (eq ?f:char2 ?c2))))
  203.       (if (> (length$ ?cell-facts) 0) then
  204.           (bind ?cell-fact (nth$ 1 ?cell-facts)) ;;; Має бути унікальним
  205.           (modify ?cell-fact (count (+ (fact-slot-value ?cell-fact count) 1)))
  206.       else
  207.           ;;; Цей випадок в ідеалі не має траплятися, якщо всі комірки були ініціалізовані
  208.           (printout t "Увага: Комірка для " ?c1 " -> " ?c2 " не знайдена під час оновлення лічильника." crlf)
  209.           (assert (precedence-cell (char1 ?c1) (char2 ?c2) (count 1)))
  210.       )
  211.     )
  212.   )
  213.   (printout t "Фаза: Обчислення матриці завершено." crlf)
  214.   (assert (status (phase reporting)))
  215. )
  216.  
  217. ;;; --- Фаза 6: Формування звіту ---
  218. (defrule display-results
  219.   (status (phase reporting))
  220.   (alphabet (chars $?a))
  221.   (intervals (thresholds $?t))
  222.   (linguistic-series (letters $?ls))
  223.   (numeric-series-raw (values $?origs))
  224.   (sorted-series (values $?sorteds))
  225.   =>
  226.   (printout t crlf "--- ФІНАЛЬНІ РЕЗУЛЬТАТИ ---" crlf) 
  227.   (printout t "Початковий числовий ряд: " $?origs crlf)
  228.   (printout t "Відсортований числовий ряд: " $?sorteds crlf)
  229.   (printout t "Алфавіт:                     " (implode$ ?a) crlf)
  230.   (printout t "Пороги інтервалів:        " ?t crlf)
  231.   (printout t "Лінгвістичний ряд:          " ?ls crlf)
  232.   (printout t "Матриця передування:" crlf)
  233.   (printout t "    ")
  234.   (foreach ?char-col-hdr ?a (printout t ?char-col-hdr "  "))
  235.   (printout t crlf)
  236.   (foreach ?char-row ?a
  237.     (printout t ?char-row " | ")
  238.     (foreach ?char-col ?a
  239.       (do-for-all-facts ((?f precedence-cell)) 
  240.                         (and (eq ?f:char1 ?char-row) (eq ?f:char2 ?char-col))
  241.         (printout t ?f:count "  ")
  242.       )
  243.     )
  244.     (printout t crlf)
  245.   )
  246.   (printout t "--- КІНЕЦЬ ЗВІТУ ---" crlf) 
  247.   (assert (status (phase done)))
  248.   (halt)
  249. )
  250.  
  251. ;;; Для запуску, зазвичай, потрібно виконати (reset) а потім (run).
  252. (exit)
  253. ; empty line at the end
Success #stdin #stdout 0.04s 5356KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
[EXPRNPSR3] Missing function declaration for values.

ERROR:
(deffacts MAIN::initial-data
   (numeric-series-raw (values

[PRNTUTIL2] Syntax Error:  Check appropriate syntax for defrule.

ERROR:
(defrule MAIN::setup-alphabet-and-sorting-init
   (status (

[PRNTUTIL2] Syntax Error:  Check appropriate syntax for defrule.

ERROR:
(defrule MAIN::selection-sort-step
   ?s <- (status (

[PRNTUTIL2] Syntax Error:  Check appropriate syntax for defrule.

ERROR:
(defrule MAIN::finish-sorting
   (status (

[PRNTUTIL2] Syntax Error:  Check appropriate syntax for defrule.

ERROR:
(defrule MAIN::generate-intervals-rule
   (status (

[PRNTUTIL2] Syntax Error:  Check appropriate syntax for defrule.

ERROR:
(defrule MAIN::build-linguistic-row-rule
   (status (

[PRNTUTIL2] Syntax Error:  Check appropriate syntax for defrule.

ERROR:
(defrule MAIN::matrix-initialization-and-computation
   (status (

[PRNTUTIL2] Syntax Error:  Check appropriate syntax for defrule.

ERROR:
(defrule MAIN::display-results
   (status (
https://ideone.com/hNdzqN
language:
Clips (clips 6.30)
created:
4 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!