Форум программистов, компьютерный форум, киберфорум
Lisp
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.50/4: Рейтинг темы: голосов - 4, средняя оценка - 4.50
0 / 0 / 0
Регистрация: 26.10.2012
Сообщений: 20
1

Описать функцию (уникум x)

15.04.2013, 16:55. Просмотров 838. Ответов 11
Метки нет (Все метки)

Списки, являющиеся аргументами функций, могут содержать подсписки. Рекурсия распространяется как в направлении cdr, так и в направлении car, т.е. на подсписки. Для определения главной функции можно использовать собственные подфункции. В задачах вариантов 4-9, 14, 15 можно вначале исходный список выровнять, затем сделать из него множество. Например: ((a b) b ((c)) a) --> (a b b c a) --> (a b c) После этого к списку можно применить основную функцию. Можно воспользоваться и другими более эффективными подфункциями. При решении задач остальных вариантов выравнивать списки не нужно.
0
Миниатюры
Описать функцию (уникум x)  
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
15.04.2013, 16:55
Ответы с готовыми решениями:

Описать функцию в классе Name и создать объект, вызывающий данную функцию.
Описать функцию в классе Name и создать объект, вызывающий данную функцию. Проверить истинность...

Задачка на массивы (описать функцию случайной генерации элементов массива, а за тем логическую функцию)
Необходимо описать функцию случайной генерации элементов массива, а за тем логическую функцию,...

Описать функцию F(m,n)=n!*m!/(n+m)!, где n, m - неотрицательные целые числа. (Определить внутреннюю функцию, вычисляющую факториал)
Задача: Описать функцию F(m,n)=n!*m!/(n+m)!, где n, m - неотрицательные целые числа. (Определить...

Написать функцию, которая вычисляет объем и площадь поверхности параллелепипеда, описать функцию IsSquare(K)
Здравствуйте, нужна помощь по решению двух зачад в TC++(Turbo C++); Задача 1. Написать функцию,...

11
4330 / 4057 / 321
Регистрация: 12.05.2012
Сообщений: 2,865
15.04.2013, 17:13 2
Лучший ответ Сообщение было отмечено как решение

Решение

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun flat (w &optional acc) 
  (cond ((null w) acc)
        ((atom w) (cons w acc))
        ((flat (car w) (flat (cdr w) acc)))))
 
(defun unique (w &optional (v w))
  (cond ((null w) nil)
        ((> (count (car w) v) 1) (unique (cdr w) v))
        ((cons (car w) (unique (cdr w) v)))))
 
(defun unique-atoms (w)
  (unique (flat w)))
 
> (unique-atoms '(1 2 (((2 3 4))) 7 (8 (9 1))))
(3 4 7 8 9)
Добавлено через 19 секунд
Lisp
1
2
3
4
5
6
7
8
9
10
(defun unique-atoms (w &optional acc ac
                     &aux (a (car w)) (d (cdr w)))
  (cond ((null w) (set-difference acc ac))
        ((listp a)
         (unique-atoms a (unique-atoms d acc ac) ac))
        ((member a acc) (unique-atoms d acc (cons a ac)))
        ((unique-atoms d (cons a acc) ac))))
 
> (unique-atoms '(1 2 (((2 3 4))) 7 (8 (9 1))))
(4 3 9 8 7)
Добавлено через 19 секунд
Lisp
1
2
3
4
5
6
7
8
9
10
(defun unique-atoms (w &optional acc ac
                     &aux (a (car w)) (d (cdr w)))
  (cond ((null w) (set-difference acc ac))
        ((listp a)
         (unique-atoms d (unique-atoms a acc ac) ac))
        ((member a acc) (unique-atoms d acc (cons a ac)))
        ((unique-atoms d (cons a acc) ac))))
 
> (unique-atoms '(1 2 (((2 3 4))) 7 (8 (9 1))))
(9 8 7 4 3)
Добавлено через 1 минуту
Lisp
1
2
3
4
5
6
7
(defun flat-unique (w &optional ac) 
  (cond ((null w) ac)
        ((atom w) (if (member w ac) ac (cons w ac)))
        ((flat-unique (car w) (flat-unique (cdr w) ac)))))
 
> (flat-unique '((a b) ((a)) a c))
(B A C)
4
Модератор
26284 / 13690 / 2605
Регистрация: 12.02.2012
Сообщений: 22,459
15.04.2013, 17:48 3
Лучший ответ Сообщение было отмечено как решение

Решение

Вот решение в два действия с ассоциативным списком:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun mkpair (lst &optional asso)
  (cond ((null lst) asso)
        ((atom (car lst)) 
          (let ((pair (assoc (car lst) asso)))
               (cond (pair (rplacd pair (1+ (cdr pair)))
                             (mkpair (cdr lst) asso))
                     (t (mkpair (cdr lst) (cons (cons (car lst) 1) asso))))))
        (t (mkpair (cdr lst) (mkpair (car lst) asso)))))
 
(defun task (lst)
  (mapcar 'car (remove-if #'(lambda (x) (> (cdr x) 1)) (mkpair lst))))
 
==> task
 
(task '(a b (c a) (((s))) d))
 
==> (d s c b)
 
(task '(a b (c a) s (((s))) d))
 
==> (d c b)
Решение более громоздкое, зато допускает обобщение типа: "дать список атомов, входящих не более n раз, или от n до k раз" и т.д.
3
0 / 0 / 0
Регистрация: 26.10.2012
Сообщений: 20
15.04.2013, 17:57  [ТС] 4
Большое спасибо, очень выручили!
0
0 / 0 / 0
Регистрация: 26.10.2012
Сообщений: 20
10.06.2013, 18:17  [ТС] 5
Цитата Сообщение от Catstail Посмотреть сообщение
Вот решение в два действия с ассоциативным списком:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun mkpair (lst &optional asso)
  (cond ((null lst) asso)
        ((atom (car lst)) 
          (let ((pair (assoc (car lst) asso)))
               (cond (pair (rplacd pair (1+ (cdr pair)))
                             (mkpair (cdr lst) asso))
                     (t (mkpair (cdr lst) (cons (cons (car lst) 1) asso))))))
        (t (mkpair (cdr lst) (mkpair (car lst) asso)))))
 
(defun task (lst)
  (mapcar 'car (remove-if #'(lambda (x) (> (cdr x) 1)) (mkpair lst))))
 
==> task
 
(task '(a b (c a) (((s))) d))
 
==> (d s c b)
 
(task '(a b (c a) s (((s))) d))
 
==> (d c b)
Решение более громоздкое, зато допускает обобщение типа: "дать список атомов, входящих не более n раз, или от n до k раз" и т.д.
можно его как-то упростить? Сделать проще (без mapcar, #, &optional)?
0
Модератор
26284 / 13690 / 2605
Регистрация: 12.02.2012
Сообщений: 22,459
10.06.2013, 20:07 6
См. решения, предложенные _sg
0
1044 / 938 / 107
Регистрация: 04.11.2012
Сообщений: 971
Записей в блоге: 3
10.06.2013, 21:35 7
Лучший ответ Сообщение было отмечено как решение

Решение

Или чтоб еще больше запутать.
Lisp
1
2
3
4
5
6
7
8
;Единичные оставить.
(defun unique (lst)
  (if (every #'atom lst)
    (remove-if #'(lambda (x) (< 1 (count x lst))) lst)
    (unique (reduce #'nconc (mapcar #'(lambda (x) (if (atom x) (list x) x)) lst)))))
 
> (unique '(1 (3 6 (8 7)) 8 nil (8 9 7 ((3 2) 8 9))))
(1 6 nil 2)
3
0 / 0 / 0
Регистрация: 26.10.2012
Сообщений: 20
10.06.2013, 22:04  [ТС] 8
без mapcar, #, &optional надо, вот в чем дело
0
4330 / 4057 / 321
Регистрация: 12.05.2012
Сообщений: 2,865
10.06.2013, 22:37 9
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun flat (w acc) 
  (cond ((null w) acc)
        ((atom w) (cons w acc))
        ((flat (car w) (flat (cdr w) acc)))))
 
(defun unique (w v)
  (cond ((null w) nil)
        ((> (count (car w) v) 1) (unique (cdr w) v))
        ((cons (car w) (unique (cdr w) v)))))
 
(defun unique-atoms (w)
  (let ((v (flat w nil)))
    (unique v v)))
 
> (unique-atoms '(1 2 (((2 3 4))) 7 (8 (9 1))))
(3 4 7 8 9)
3
Модератор
26284 / 13690 / 2605
Регистрация: 12.02.2012
Сообщений: 22,459
11.06.2013, 07:21 10
Лучший ответ Сообщение было отмечено как решение

Решение

Или в одно действие (но запускать с доп. параметром - плата за запрет &optional):

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
(defun uniq (lst res)
  (cond ((null lst) res)
        ((atom (car lst)) 
           (cond ((member (car lst) res) (uniq (cdr lst) (remove (car lst) res)))
                 (t (uniq (cdr lst) (cons (car lst) res)))))
        (t (uniq (cdr lst) (uniq (car lst) res)))))
 
==> uniq
 
 
(uniq '(1 2 3 1 2 3) nil)
 
==> NIL
 
(uniq '(1 2 3 2 3) nil)
 
==> (1)
 
(uniq '(1 (2) (((3))) 2 3) nil)
 
==> (1)
 
(uniq '(1 (2) (((1))) 2 3) nil)
 
==> (3)
 
(uniq '(1 (2) (((3))) 2 3) nil)
 
==> (1)
 
(uniq '((2) (((3))) 2 3) nil)
 
==> NIL
 
(uniq '((2) (((3))) 2 1) nil)
 
==> (1 3)
3
4330 / 4057 / 321
Регистрация: 12.05.2012
Сообщений: 2,865
19.11.2014, 10:23 11
как вариант:
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun flat (w)
  (loop for a in w 
        if (and a (atom a)) collect a
        else nconc (flat a)))
 
(defun unique (w &optional (v w))
  (cond ((null w) nil)
        ((> (count (car w) v) 1) (unique (cdr w) v))
        ((cons (car w) (unique (cdr w) v)))))
 
(defun unique-atoms (w)
  (unique (flat w)))
 
> (unique-atoms '(1 2 (((2 3 4))) 7 (8 (9 1))))
(9 8 7 4 3)
2
1975 / 1078 / 87
Регистрация: 29.11.2013
Сообщений: 3,354
20.11.2014, 01:23 12
Lisp
1
2
3
4
5
6
7
8
9
;; racket-lang.org
(define (foo lst)
  (let loop ([lst lst] [acc null])
    (cond [(empty? lst) acc]
          [(list? lst) (loop (car lst) (loop (cdr lst) acc))]
          [else (if (member lst acc) acc (cons lst acc))])))
 
(foo '((a b) b ((c)) a))
;'(b c a)
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
20.11.2014, 01:23

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Описать функцию max (X) для определения максимального элемента вектора X, введя вспомогательную рекурсивную функцию
Всем доброго времени суток. Помогите пожалуйста разобраться в условиях задачи, а то что-то у...

Описать функцию, имитирующую встроенную функцию strip_tags()
Описать функцию, имитирующую встроенную функцию Strip_tags. Параметры: обрабатываемая переменная,...

Описать функцию, функцию Test(G), проверяющую, что в группе самая высокая из женщин ниже самого высокого из мужчин
type name = (Mary, Jane, Kim, Bob, Jan, Pit, Tom, Sara); data = record male: boolean; {пол:...

Описать функцию
В составе программы описать функцию, которая удаляет из списка каждый N элемент. Если можно с...

описать функцию
сама функция на рисунке..заранее спасибо...

Описать функцию
Помогите написать функцию.Код основного блока программы запрещено менять. Также нельзя использовать...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.