Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > LISP > Элементы, встречающиеся более 1 раза

Автор: malaja 28.3.2009, 14:45

Здравствуйте!
У меня такая задача в XLISP:
Определить функцию, зависящую от одного аргумента, которая по данному списку вычисляет список его элементов, встречающихся в нём более одного раза.
Подскажите, что неверно, не работает.

Код

(DEFUN KOLAM (LAMBDA (LST)
      (TH (LIST-SET LST) LST)
   ))
   ; ------------------------- ;
   (DEFUN LIST-SET (LAMBDA (LST)
   ; Функция LIST-SET преобразует список LST в множество ;
      (COND ( (NULL LST) NIL )
            ( (MEMBER (CAR LST) (CDR LST))
                (LIST-SET (CDR LST)) )
            ( T (CONS (CAR LST) (LIST-SET (CDR LST))) )
      )
   ))
   ; ------------------------ ;
   (DEFUN TH (LAMBDA (LST LST0)
      (COND ( (NULL LST) NIL)
         (> (KOL (CAR LST) LST0) 1)
            (  T  (CONS (LIST (CAR LST)
                              ))
                        (TH (CDR LST) LST0)) ))
   ))

   (DEFUN KOL (LAMBDA (M LST)
   ; Подсчет количества повторений элемента M в списке LST ;
      (COND ( (NULL LST) 0 )
            ( (EQ (CAR LST) M)
                 (+ (KOL M (CDR LST)) 1) )
            (  T  (KOL M (CDR LST)))
      )
   ))

Автор: VH_ 28.3.2009, 15:09

Код

(defun F (L)
  (cond
   ((null L) nil)
   ((member (car L) (cdr L)) (cons (car L) (F (cdr L))))
   (T (F (cdr L)))))

Автор: malaja 29.3.2009, 09:26

Привет!!! Так просто?
Сразу видно, что Шустрый мыслит в стиле функционального программирования. Но всё же не совсем верно, так как получается:

из списка (3 3 3 3 5 4 6 9 9 9) делает список (3 2 9 9), то есть повторяет элементы, которые были написаны более 2 раз - девятки.

Добавлено через 5 минут и 23 секунды
Я неверно первый список дала:

(3 3 5 4 6 9 9 9 9) то есть две тройки были...

Автор: VH_ 30.3.2009, 22:12

Код

(defun F (L &optional acc)
 (if (null L)
  (reverse acc)
  (if (member (car L) (cdr L))
   (if (member (car L) acc)
    (F (cdr L) acc)
    (F (cdr L) (cons (car L) acc)))
   (F (cdr L) acc))))

Шустрый не мой ник.

Автор: malaja 1.4.2009, 17:16

Привет, VH!

Извиняюсь за неправильный ник. Огромное спасибо за помощь, всё работает.
Может быть подмогнёшь решить ещё одну задачку:
Определить функцию, зависящую от двух аргументов u и n, которая по данному списку строит список его элементов, встречающихся в нём не менее n раз. Проверить работу этой функции на примере ( a a b a c b c a b b d a d ) для n=1, 2, 5, 0.

По-честному, решение у меня имеется но оно такое-же как и к первой задаче. Но это не то,что надо. Я надеюсь на помощь.

Для VH и всех кто зайдёт сегодня - 1 апреля сюда:

Поздравляю с праздником,
Праздником - проказником!
Никому не надоели
Шутки первого апреля,
А скорей - наоборот:
Посмеяться рад народ!

Автор: VH_ 1.4.2009, 18:29

Код

(defun F (L N &optional acc)
  (if L
   (F
    (cdr L)
    N
    ((lambda (elem link)
      (if link
       (substitute (cons elem (1+ (cdr link))) link acc :test 'EQUAL)
       (cons (cons elem 1) acc)))
     (car L)
     (assoc (car L) acc)))
   (apply 'append
    (mapcar
    '(lambda (elem)
      (if (>= (cdr elem) N)
       (cons (car elem) nil)))
     acc))))

Автор: malaja 5.4.2009, 11:22

Привет, VH!

Делаю вызов функции следующим образом:
(F '(2 5 5 5 5 5 3 6) 2) ->
В одних случаях  - ЛИСП не выдаёт никакого результата, в других случаях выдаёт ошибку функции SUBSTITUTE.
Я неверно вызываю функцию или ошибка в программном коде?
Пытаюсь разобраться не очень-то получается...
Функция  SUBSTITUTE заменяет вхождения данного элемента на новый, используя предикат сравнения :test 'EQUAL.
Поясните, пожалуйста, какие элементы сравниваются в данном случае и почему элементы надо заменять, а не удалять.
Не могу разобраться, подскажите...
Очень жду.

Автор: VH_ 5.4.2009, 14:30

XLISP-PLUS version 3.04
Portions Copyright © 1988, by David Betz.
Modified by Thomas Almy and others.
> (defun F (L N &optional acc)
  (if L
   (F
    (cdr L)
    N
    ((lambda (elem link)
      (if link
       (substitute (cons elem (1+ (cdr link))) link acc :test 'EQUAL)
       (cons (cons elem 1) acc)))
     (car L)
     (assoc (car L) acc)))
   (apply 'append
    (mapcar
    '(lambda (elem)
      (if (>= (cdr elem) N)
       (cons (car elem) nil)))
     acc))))
F
> (F '(2 5 5 5 5 5 3 6) 2)
(5)
> (trace F)
(F)
> (F '(2 5 5 5 5 5 3 6) 2)
Entering: F, Argument list: ((2 5 5 5 5 5 3 6) 2)
Entering: F, Argument list: ((5 5 5 5 5 3 6) 2 ((2 . 1)))
  Entering: F, Argument list: ((5 5 5 5 3 6) 2 ((5 . 1) (2 . 1)))
   Entering: F, Argument list: ((5 5 5 3 6) 2 ((5 . 2) (2 . 1)))
    Entering: F, Argument list: ((5 5 3 6) 2 ((5 . 3) (2 . 1)))
     Entering: F, Argument list: ((5 3 6) 2 ((5 . 4) (2 . 1)))
      Entering: F, Argument list: ((3 6) 2 ((5 . 5) (2 . 1)))
       Entering: F, Argument list: ((6) 2 ((3 . 1) (5 . 5) (2 . 1)))
        Entering: F, Argument list: (NIL 2 ((6 . 1) (3 . 1) (5 . 5) (2 . 1)))
        Exiting: F, Value: (5)
       Exiting: F, Value: (5)
      Exiting: F, Value: (5)
     Exiting: F, Value: (5)
    Exiting: F, Value: (5)
   Exiting: F, Value: (5)
  Exiting: F, Value: (5)
Exiting: F, Value: (5)
Exiting: F, Value: (5)
(5)
>

Автор: VH_ 5.4.2009, 15:29

Идея такая:
Пока список L не кончился, функция (F) вызывается для «хвоста» списка, при этом в аккумуляторе acc накапливаются счетчики экземпляров элементов списка в виде точечных пар (элемент_списка . количество), то есть если на очередном этапе счетчика первого элемента списка в аккумуляторе нет, то в аккумулятор добавляется счетчик (элемент . 1), а если такой элемент ранее уже встречался в списке и его счетчик уже есть в аккумуляторе, то поле количество увеличивается на единицу и "новый" счетчик заменяет "старый" в аккумуляторе. Когда список L заканчивается, из аккумулятора извлекаются (в списке) те элементы, количества которых в списке не меньше числа N.

Автор: malaja 9.4.2009, 14:59

Привет, VH!

Спасибо, спасибо за исчерпывающий ответ!
Но у меня всё же программулина не работает, дело в том, что у меня версия Лиспа 2.1, он наверное просто не понимает функцию SUBSTITUTE.

Автор: VH_ 9.4.2009, 16:27

Код

(defun SUBSTITUTE (New Old L)
 (mapcar '(lambda (elem) (if (equal elem Old) New elem)) L))

LISP тем и хорош, что при отсутствии необходимого средства его можно определить самостоятельно и на ходу.

Автор: malaja 23.4.2009, 14:48

Спасибо за помощь!!!

Автор: _sg 25.4.2014, 07:42

как вариант:

Код


(defun occur-more (w n &aux (v (remove-duplicates w)))
  (loop for a in v when (> (count a w) n) collect a))

> (occur-more '(a a b a c b c a b b d a d) 2)
(B A)