Шаг 123.
Решенные задачи. Задачи для иллюстрации императивного программирования на языке LISP

    На этом шаге мы приведем задачи, иллюстрирующие императивный стиль программированияя на языке LISP.


    Задача 1.
   ; ----------------------------------------------------- ;
   ; Найдется ли такое натуральное число I, не превосходя- ;
   ; щее  заданного  числа   N, что  число  2*I+15  будет  ;
   ;                        составным                      ;
   ; ----------------------------------------------------- ;
   (DEFUN ZAD19 (LAMBDA (N)
      (SETQ I 1)
      (LOOP
         ( (> I N) PRIN1 "Нет такого числа!" )
         ( (SIMPLE (+ (* 2 I) 15)) I  )
         (SETQ I (+ I 1))
      )
   ))
   ; --------------------- ;
   (DEFUN SIMPLE (LAMBDA (N)
      (SETQ FLAG 1)
      (COND ( (AND (EQ (MOD N 2) 0) (NOT (EQ N 2))) NIL )
            (  T  ( (SETQ I 3)
                    (LOOP
                       ( (< (CAR (DIVIDE N 2)) I) )
                       ( (EQ (CDR (DIVIDE N I)) 0)
                            (SETQ FLAG 0) )
                       ( SETQ I (+ I 2) )
                    )
                    (COND ( (EQ FLAG 0)  NIL )
                          (   T          T   ))) )
      )
   ))
Текст этой библиотеки можно взять здесь.


    Задача 2.
   ; ---------------------------------------------- ;
   ; Определить, какой цифрой оканчивается число 7, ;
   ;           возведенное в степень 77             ;
   ; ---------------------------------------------- ;
   (DEFUN CON (LAMBDA (NUM1 NUM2)
      (CAR (REVERSE (UNPACK (POWER NUM1 NUM2))))
   ))
   ; ---------------------------- ;
   (DEFUN POWER (LAMBDA (NUM1 NUM2)
       ( (AND (ZEROP NUM1) (MINUSP NUM2))
             (PRINT "Результат не существует!") )
       (SETQ NUM3 1)
       (LOOP
          (SETQ NUM2 (DIVIDE NUM2 2))
          ( ( (EQ (CDR NUM2) 1)
                 (SETQ NUM3 (* NUM1 NUM3)) ) )
          ( SETQ NUM2 (CAR NUM2) )
          ( (ZEROP NUM2) NUM3 )
          ( SETQ NUM1 (* NUM1 NUM1))
       )
   ))
Текст этой библиотеки можно взять здесь.


    Задача 3.
   ; ------------------------------------------------- ;
   ; Дописать к 523... три цифры так, чтобы полученное ;
   ;    шестизначное число делилось на 7, 8 и на 9     ;
   ; ------------------------------------------------- ;
   (DEFUN DEL (LAMBDA ()
      (SETQ N  523000)
        (LOOP
           ((EQ N 999999) 0)
           ((AND (ZEROP (CDR (DIVIDE N 7)))
                 (ZEROP (CDR (DIVIDE N 8)))
                 (ZEROP (CDR (DIVIDE N 9)))) N)
           (SETQ N (+ N 1))
         )
   ))
Текст этой функции можно взять здесь.


    Задача 4.
   ; ------------------------------------------------- ;
   ; Установить, является ли число 210-p простым, если ;
   ;           число p простое и 100<p<200             ;
   ; ------------------------------------------------- ;
   (DEFUN PROST (LAMBDA (P)
      (COND ( (AND (SIMPLE P)
                   (AND (> P 100) (< P 200))
              )
              (SIMPLE (- 210 P))
            )
      )
   ))
   ; --------------------- ;
   (DEFUN SIMPLE (LAMBDA (N)
   ; Предикат, позволяющий установить, является ли ;
   ;          заданное целое число N простым       ;
      (SETQ FLAG 1)
      (COND ( (AND (EQ (MOD N 2) 0) (NOT (EQ N 2))) PRIN1 "Не простое!" )
            (  T  ( (SETQ I 3)
                    (LOOP
                       ( (< (CAR (DIVIDE N 2)) I) )
                       ( (EQ (CDR (DIVIDE N I)) 0)
                            (SETQ FLAG 0) )
                       ( SETQ I (+ I 2) )
                    )
                    (COND ( (EQ FLAG 0)  NIL )
                          (   T          T   ))) )
      )
   ))
Текст этой библиотеки можно взять здесь.


    Задача 5.
   ; ------------------------------------------------ ;
   ; При каком наименьшем натуральном М число М^3+3^M ;
   ;                 делится на 7                     ;
   ; ------------------------------------------------ ;
   (DEFUN FAY (LAMBDA (K)
      (SETQ M 1)
      ( LOOP
          ( (> M K) 0 )
          ( SETQ L (STEPEN 3 M) )
          ( SETQ N (STEPEN M 3) )
          ( SETQ T (+ L N)   )
          ( (ZEROP (CDR (DIVIDE T 7)))  M )
          ( SETQ M (+ M 1) )
      )
   ))
   ; ----------------------- ;
   (DEFUN STEPEN (LAMBDA (X A)
      (COND ( (ZEROP A) 1 )
            ( (ZEROP (- A 1))     X            )
            (  T  (* X (STEPEN X (- A 1))) )
      )
   ))
Текст этой библиотеки можно взять здесь.


    Задача 6.
   ; --------------------------------------- ;
   ; Найти целые числа от 1 до N, которые    ;
   ;      делятся и на 3, и на 5, и на 7     ;
   ; --------------------------------------- ;
   (DEFUN DA1 (LAMBDA (N)
      (SETQ L 0)
      (SETQ I 1)
      ( LOOP
          ( (> I N) ((PRINT "Всего чисел") L) )
          (COND ( (AND (ZEROP (CDR (DIVIDE I 3)))
                       (ZEROP (CDR (DIVIDE I 5)))
                       (ZEROP (CDR (DIVIDE I 7))))
                                ( (SETQ L (+ L 1)) (PRINT I))  ))
          (SETQ I (+ I 1))
      )
   ))
Текст этой функции можно взять здесь.


    Задача 7.
   ; -------------------------------------------- ;
   ; Существуют ли 4 последовательных натуральных ;
   ; числа, сумма квадратов которых  равна  сумме ;
   ;  квадратов трех следующих натуральных чисел? ;
   ; -------------------------------------------- ;
   (DEFUN SM (LAMBDA NIL
      (SETQ I 22)
      (LOOP
         ( (EQ I 1000) )
         (SETQ A1 (*       I          I   ))
         (SETQ A2 (* (+ I 1) (+ I 1)))
         (SETQ A3 (* (+ I 2) (+ I 2)))
         (SETQ A4 (* (+ I 3) (+ I 3)))
         ; ----------------------------------- ;
         (SETQ A5 (* (+ I 4) (+ I 4)))
         (SETQ A6 (* (+ I 5) (+ I 5)))
         (SETQ A7 (* (+ I 6) (+ I 6)))
         ; ------------------------------------- ;
         (SETQ B1 (+ A1 (+ A2 (+ A3 A4))))
         (SETQ B2          (+ A5 (+ A6 A7)))
         ( (EQ B1 B2) (PRINT I) )
         (SETQ I (+ I 1))
      )
   ))
Текст этой функции можно взять здесь.


    Задача 8.
   ; -------------------------------------------------- ;
   ; По данному целому числу К>7 найти пару целых неот- ;
   ;   рицательных чисел A и B таких, что K = 3A + 5B   ;
   ; -------------------------------------------------- ;
   (DEFUN PARA (LAMBDA (K)
      (SETQ N 100) (PRIN1 "Значение A и B ...: ") (SETQ A 0)
      ( LOOP
          ( (> A N) )
          (SETQ B 0)
          (LOOP
             ( (> B N) )
             ( (EQ K (+ (* A 3) (* B 5)))
                     ((PRIN1 A) (PRIN1 " ") (PRINT B))
             )
             (SETQ B (+ B 1))
          )
          (SETQ A (+ A 1))
      )
   ))
Текст этой функции можно взять здесь.


    Задача 9.
   ; ------------------------------------------ ;
   ; Определить функцию FIB(N), вычисляющую N-й ;
   ;    элемент последовательности Фибоначчи    ;
   ; ------------------------------------------ ;
   ;     Императивный стиль программирования    ;
   ; ------------------------------------------ ;
   (DEFUN FIB1 (LAMBDA (K)
      (COND
          ( (EQ K 1) 1 )
          ( (EQ K 2) 1 )
          (  T  ( (SETQ I 3) (SETQ F1 1)
                  (SETQ F2 1) (SETQ F3 2)
                  ( LOOP
                      ( (> I K) F3)
                      (SETQ F3 (+ F1 F2))
                      (SETQ F1 F2) (SETQ F2 F3)
                      (SETQ I (+ I 1)))) )
      )
   ))
   ; ------------------------------------- ;
   ; Функциональный стиль программирования ;
   ; ------------------------------------- ;
   (DEFUN FIB (LAMBDA (K)
      (COND ( (ZEROP K) 0)
            ( (EQ K 1)  1)
            (   T  (+ (FIB (- K 1))
                         (FIB (- K 2))) )
      )
   ))
Текст этой библиотеки можно взять здесь.


    Задача 10.
   ; ------------------------------------------------- ;
   ; Если введенный номер числа Фибоначчи  K  и  само  ;
   ; это число кратны пяти, то вернуть список из числа ;
   ; Фибоначчи и его номера, в противном случае - NIL  ;
   ; ------------------------------------------------- ;
   (DEFUN FIBFIFE (LAMBDA (K)
      (COND ( (AND (ZEROP (CDR (DIVIDE      K  5)))
                   (ZEROP (CDR (DIVIDE (FIB K) 5)))
              )    (LIST (FIB K) K)
            )
            (  T  NIL )
      )
   ))
   ; ------------------ ;
   (DEFUN FIB (LAMBDA (K)
      (COND
          ( (EQ K 1) 1 )
          ( (EQ K 2) 1 )
          (  T  ( (SETQ I 3)  (SETQ F1 1)
                   (SETQ F2 1) (SETQ F3 2)
                   ( LOOP
                        ( (> I K) F3 )
                        (SETQ F3 (+ F1 F2))
                        (SETQ F1 F2)
                        (SETQ F2 F3)
                        (SETQ I (+ I 1)))) )
      )
   ))
Текст этой библиотеки можно взять здесь.


    Задача 11.
   ; ---------------------------------------------------- ;
   ; Перевести число N в систему счисления с основанием F ;
   ; ---------------------------------------------------- ;
   (DEFUN EEE (LAMBDA (N F)
      (SETQ LST NIL)
      (SETQ REM (CDR (DIVIDE N F)))
      (SETQ I   (CAR (DIVIDE N F)))
      (SETQ LST (CONS REM LST))
      ( LOOP
          (SETQ N I)
          (SETQ REM (CDR (DIVIDE N F)))
          (SETQ I   (CAR (DIVIDE N F)))
          (SETQ LST (CONS REM LST))
          ( (< I F) )
      )
      (PRINT (SETQ LST (CONS I LST)))
   ))
Текст этой функции можно взять здесь.


    Задача 12.
   ; ---------------------------------------------------- ;
   ; Напишите  наименьшее трехзначное  число, кратное  3, ;
   ; так, чтобы первая цифра его была 6, и все цифры были ;
   ;                   бы различны                        ;
   ; ---------------------------------------------------- ;
   (DEFUN CHCH (LAMBDA NIL
      (SETQ I 0)
      (LOOP
         ( (> I 9) )
         (SETQ J 0)
         ( LOOP
             ( (> J 9) )
             (COND
                ( (AND (ZEROP (MOD
                                  (+ (* 10 I)
                                        (+ J 600)) 3))
                       (NOT (EQ I J))
                       (NOT (EQ I 6)) (NOT (EQ J 6)))
                     (PRIN1 6) (PRIN1 I)
                     (PRIN1 J) (PRIN1 " ")) )
             (SETQ J (+ J 1))
         )
         (SETQ I (+ I 1))
      )
   ))
Текст этой функции можно взять здесь.


    Задача 13.
   ; ----------------------------------------------- ;
   ; Натуральные числа m и n взаимно просты и n < m. ;
   ; Какое число больше:                             ;
   ;   (1*m/n) + (2*m/n) +...+ (n*m/n)               ;
   ;                      или                        ;
   ;   (1*n/m) + (2*n/m) +...+ (m*n/m)?              ;
   ; ----------------------------------------------- ;
   (DEFUN SUMMA (LAMBDA (N М)
      (SETQ S2 0) (SETQ I 1)
      (PRIN1 "Введите M... ") (SETQ M (READ))
      (PRIN1 "Введите N... ") (SETQ N (READ))
      (LOOP
          ( (> I M) S2 )
          (SETQ S2 (+ S2 (CAR (DIVIDE (* I N) M))))
          (SETQ I (+ I 1))
      )
      (SETQ S1 0) (SETQ I 1)
      (LOOP
         ( (> I N ) S1 )
         (SETQ S1 (+ S1 (CAR (DIVIDE (* I M) N))))
         (SETQ I (+ I 1))
      )
      (COND
         ( (> S1 S2) (PRINT "Первое число больше") )
         (     T            (PRINT "Второе число больше") )
      )
      (PRIN1 "Разность... ") (- S1 S2)
   ))
Текст этой функции можно взять здесь.


    Задача 14.
   ; --------------------------------------- ;
   ; Найдите трехзначные числа, равные сумме ;
   ;         факториалов своих цифр          ;
   ; --------------------------------------- ;
   (DEFUN MAIN (LAMBDA ()
      (SETQ N 100)
      (LOOP
         ( (EQ N 999) 999 )
         ( (EQ N (+
                    (FACT (CAR  (STRING-NUM (UNPACK N))))
                    (+
                      (FACT
                         (CADR  (STRING-NUM (UNPACK N))))
                         (FACT (CADDR
                                 (STRING-NUM (UNPACK N))))
                       )
                 )
           )
           ( (PRINT "Число... ") N )
         )
         ( SETQ N (+ N 1) )
      )
   ))
   ; ------------------- ;
   (DEFUN FACT (LAMBDA (X)
      (COND
         ( (ZEROP X) 1 )
         (  T  (* X (FACT (- X 1))) )
      )
   ))
   ; ------------------------- ;
   (DEFUN STRING-NUM (LAMBDA (X)
   ; Перевод списка цифр в список, содержащий ;
   ;    соответствующие однозначные числа     ;
       (COND ( (EQ (LENGTH X) 1)
                   (CONS
                      (POSITION (CAR X) (UNPACK 123456789))
                      NIL) )
             (  T  (CONS
                      (POSITION (CAR X) (UNPACK 123456789))
                      (STRING-NUM (CDR X))) ))
   ))
   ; --------------------------- ;
   (DEFUN POSITION (LAMBDA (X LST)
   ; Функция  POSITION  возвращает  положение атома X ;
   ; в одноуровневом списке LST (первый элемент имеет ;
   ; номер 1). Если элемента в списке нет, то функция ;
   ;                  возвращает 0                    ;
      (COND ( (NULL LST)       0 )
            ( (EQ X (CAR LST)) 1 )
            ( (MEMBER X LST)
                 (+ 1 (POSITION X (CDR LST))) )
            ( T  0 )
      )
   ))
Текст этой библиотеки можно взять здесь.


    Задача 15.
   ; ----------------------------------------------------- ;
   ; Написать  программу, в результате выполнения  которой ;
   ; выясняется, входит ли цифра 2 в запись данного целого ;
   ;                      числа n                          ;
   ;------------------------------------------------------ ;
   (DEFUN MAIN (LAMBDA ()
      (SETQ LST (STRING-NUM (UNPACK (READ))))
      (SETQ FLAG 0)
      (LOOP
         ( (NULL LST) FLAG )
         ( (EQ (CAR LST) 2) (SETQ FLAG 1) )
         (  SETQ LST (CDR LST) )
      )
      (COND
         ( (EQ FLAG 1) (PRINT "Есть в записи число 2") )
         (    T        (PRINT "Нет  в записи числа 2") )
      )
   ))
   ; ------------------------- ;
   (DEFUN STRING-NUM (LAMBDA (X)
   ; Перевод списка цифр в список, содержащий ;
   ;     соответствующие однозначные числа    ;
      (COND ( (NULL X) NIL )
            (  T  (CONS (POSITION (CAR X) (UNPACK 123456789))
                        (STRING-NUM (CDR X))
                  )
            )
      )
   ))
   ; --------------------------- ;
   (DEFUN POSITION (LAMBDA (X LST)
   ; Функция  POSITION  возвращает  положение атома X ;
   ; в одноуровневом списке LST (первый элемент имеет ;
   ; номер 1). Если элемента в списке нет, то функция ;
   ;                  возвращает 0                    ;
      (COND ( (NULL LST)       0 )
            ( (EQ X (CAR LST)) 1 )
            ( (MEMBER X LST)
                 (+ 1 (POSITION X (CDR LST))) )
            ( T  0 )
      )
   ))
Текст этой библиотеки можно взять здесь.

    Мы закончили изложение основ языка программирования LISP.




Предыдущий шаг Содержание