Добрый день, товарисчи.
есть код на scheme, который решает задачу:
1.Напишите функцию, (f F1), которая выдает логическую формулу F2, получающуюся из логической формулы F1 внесением всех операторов отрицания внутрь конъюнкций и дизъюнкций.
пример входных данных:
(f '(~ (& (~ (v b (& c d))) (v c (~ d)))))
'(v (v b (& c d)) (& (~ c) d))
нужна помощь, как переписать этот код на homelisp?
а конкретней, вот эту функцию normal-args?
;;;; Применение правил де Моргана

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Определим элементы исчисления высказываний L

;;;; Множество булевых чисел Boolean = {#t, #f}

;;;; Множество формул F

;;;; Множество простых высказываний P - состоит из букв латинского алфавита,
;;;; исключая "v". Каждому p из P соответствует некоторое значение из Boolean

;;;; Множество логических связок S = {~, v, &},
;;;; каждому элементу которого соответсвует единственный
;;;; элемент из множества S1 логических функций Lisp. S1 = {not, or, and}
;;;; ~: F     -> F (not)
;;;; v: F x F -> F (or)
;;;; &: F x F -> F (and)

;;;; Множество формул F определим по индукции
;;;; 1) если p - простое высказывание, то p - формула
;;;; 2) если p, q - формулы, то (~ p), (& p q), (v p q) - тоже формулы
;;;; Формулы также являются высказываниями
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Законы де Моргана
;;;; (~ (v p q)) <-> ((~p) & (~q))
;;;; (~ (& p q)) <-> ((~p) v (~q))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Функция S? - является ли символ связкой
;;; S?: Symbol -> Boolean
(define (S? sym)
  (cond ((eq? sym 'v)
         #t)
        ((eq? sym '&)
         #t)
        ((eq? sym '~)
         #t)
        (else
         #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Функция arity - арность связки
;;; arity: S -> Number
(define (arity s)
  (if (eq? s '~)
      1
      2))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Функция normal-args-count? - проверяет, соответсвует ли число аргументов
;;; формулы арности связки
;;; normal-args-count: F -> Boolean
(define (normal-args-count? p)
  (= (length (cdr p))
     (arity (car p))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Функция normal-args? - проверяет число и типы аргументов связки в формуле
;;; normal-args?: F -> Boolean
(define (normal-args? p)
  (if (normal-args-count? p)
      (let iter ((args (cdr p))
                 (cnt (arity (car p))))
        (cond ((= cnt 0)
               #t)
              ((and (not (list? (car args)))
                    (S? (car args)))
               #f)
              (else
               (iter (cdr args) (- cnt 1)))))
      #f))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Функция get-f - возвращает для 'v '& и наоборот
;;; get-f: S -> S
(define (get-f s)
  (cond ((eq? s 'v)
         '&)
        ((eq? s '&)
         'v)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Функция f - применение законов де Моргана
;;; f: F -> F
(define (f F1)
  ;; Функция process - преобразование формул по законам де Моргана
 ;; process: P -> P
 (define (process F1)
    (let ((s (car F1)))
      (if (S? s)
          (cond ((not (normal-args? F1))
                 (error "process -- некорректная формула:" F1))
                ((eq? s '~)
                 (f (cadr F1)))
                (else
                 (list (get-f s)
                       (f (list '~ (cadr F1)))
                       (f (list '~ (caddr F1))))))
          (error "process -- переданный символ не является связкой:" s))))
  
  (cond ((null? F1)
         '())
        ((list? F1)
         (let ((s (car F1)))
           (if (S? s)
               (cond ((not (normal-args? F1))
                      (error "f -- некорректная формула:" F1))
                     ((eq? s '~)
                      (if (list? (cadr F1))
                          (process (cadr F1))
                          F1))
                     (else
                      (list s (f (cadr F1)) (f (caddr F1)))))
               (error "f -- переданный символ не является связкой:" s))))
        (else
         F1)))

До сессии вроде бы ещё далеко...

а по делу есть что сказать?

всем спасибо, сам разобрался:)
(defun S (sym)
        (cond ((eq sym 'v) t)
        ((eq sym '&) t)
        ((eq sym '~) t)
        (t nil)
        )
)
(defun arity (s)
          (if (eq s '~) 1 2)
)
(defun normal-args-count (p)
          (= (length (cdr p))(arity (car p))
        )
)
(defun normal-args (p)
          (if (normal-args-count p)
                 (let ((args (cdr p)) (cnt (arity (car p))))
                                (labels ((iter (args cnt)
                                        (cond
                                                ((= cnt 0) t)
                                              ((and (not (list (car args))) (S (car args))) nil)
                                              (t (iter (cdr args)(- cnt 1)))
                                        ))
                                        
                                ) (iter (cdr p) (arity (car p))))
                )
        )
)
(defun get-f (s)
          (cond ((eq s 'v) '&)
                 ((eq s '&) 'v)
        )
)
(defun f (F1)
          (defun process (F1)
                (let ((ca (car F1)))         
                        (if (S ca)
                                (cond ((not (normal-args F1)) ("pr -- некорректная формула:"))
                                ((eq ca '~) (f (cadr F1)))
                                (t (list (get-f ca) (f (list '~ (cadr F1)))
                                       (f (list '~ (caddr F1)))))
                                )
                          ("proc -- переданный символ не является связкой:")
                        )
                )
        )
             (cond         ((null F1) '())
                 ((not (atom F1)) (let ((ca (car F1)))
                          (if (S ca)
                               (cond ((not (normal-args F1)) "f -- некорректная формула:")
                                     ((eq ca '~) (if (not (atom (cadr F1))) (process (cadr F1)) F1))
                                     (t (list ca (f (cadr F1)) (f (caddr F1))))
                                )
                       ("f -- переданный символ не является связкой:"))))
                 (t F1))
 
        )