Найти в одноуровневом числовом списке возрастающий подсписок максимальной длины

@Catstail · Регистрация: 12.02.2012

Студворк — интернет-сервис помощи студентам

(Под влиянием предыдущей задачи). Мое решение (ищется первый список):

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
;; Дать длину возрастающей последовательности 
;; с начала списка:
 
(defun len-inc (lst)
  (cond ((null (cdr lst)) 1)
        ((> (cadr lst) (car lst)) (1+ (len-inc (cdr lst))))
        (t 1)))
 
;; Первый возрастающий список максимальной длины:
 
(defun max-len-inc (lst)
 (let* ((lens (maplist #'len-inc lst))
        (m (apply 'max lens))
        (p (position m lens)))
       (subseq lst p (+ p m))))   
 
==> max-len-inc
 
(max-len-inc '(1 2 3 4 1 2 3 4))
 
==> (1 2 3 4)
 
(max-len-inc '(1 2 3 4 1 2 3 4 5 6 2 3))
 
==> (1 2 3 4 5 6)

@_sg · 16.04.2013, 13:46

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
(defun seq (w &optional (b (car w)))
  (cond ((null w) nil)
        ((> b (car w)) nil)
        ((cons (car w) (seq (cdr w) (car w))))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (cond ((null w) ac)
        ((> (length v) (length ac)) (maxeq (cdr w) v))
        ((maxeq (cdr w) ac))))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

Добавлено через 4 минуты

Lisp
1
2
3
4
5
6
7
8
9
10
(defun seq (w &optional (b (car w)))
  (when w (when (<= b (car w)) (cons (car w) (seq (cdr w) (car w))))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (cond ((null w) ac)
        ((> (length v) (length ac)) (maxeq (cdr w) v))
        ((maxeq (cdr w) ac))))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

Добавлено через 1 минуту

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
(defun seq (w &optional (b (car w)))
  (when w (when (<= b (car w)) (cons (car w) (seq (cdr w) (car w))))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (if w
      (if  (> (length v) (length ac))
           (maxeq (cdr w) v)
           (maxeq (cdr w) ac))
      ac))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

Добавлено через 1 минуту

Lisp
1
2
3
4
5
6
7
8
(defun seq (w &optional (b (car w)))
  (when w (when (<= b (car w)) (cons (car w) (seq (cdr w) (car w))))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (if w (maxeq (cdr w) (if (> (length v) (length ac)) v ac)) ac))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

Добавлено через 1 минуту

Lisp
1
2
3
4
5
6
7
8
(defun seq (w &optional (b (car w)))
  (when (and w (<= b (car w))) (cons (car w) (seq (cdr w) (car w)))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (if w (maxeq (cdr w) (if  (> (length v) (length ac)) v ac)) ac))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

Добавлено через 6 минут

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
(defun seq (w &optional (b (car w)))
  (when (and w (<= b (car w))) (cons (car w) (seq (cdr w) (car w)))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (if w (maxeq (cdr w) (if  (check v ac) v ac)) ac))
 
(defun check (w v)
  (cond ((null w) nil)
        ((null v) t)
        ((check (cdr w) (cdr v)))))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

Добавлено через 1 минуту

Lisp
1
2
3
4
5
6
7
8
9
10
11
(defun check (w v)
  (when w  (if  v (check (cdr w) (cdr v)) t)))
 
(defun seq (w &optional (b (car w)))
  (when (and w (<= b (car w))) (cons (car w) (seq (cdr w) (car w)))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (if w (maxeq (cdr w) (if  (check v ac) v ac)) ac))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

@Catstail · 16.04.2013, 14:04 **[ТС]**

_sg, Да... Снимаю шляпу!

@helter · 16.04.2013, 17:39

У меня получилось длинно и банально, зато экономично (однопроходно).

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
(defun max-len-inc (lst &key (key #'identity) (test #'<=))
  (labels ((foo (lst prev-key cur-list cur-len max-list max-len)
             (if (null lst)
                 (values (nreverse max-list) max-len)
                 (let* ((new-list (rest lst))
                        (cur-key (funcall key (first lst)))
                        (testp (funcall test prev-key cur-key))
                        (new-max-p (and testp (>= cur-len max-len)))
                        (new-cur-list (if testp
                                          (cons (first lst) cur-list)
                                          (list (first lst))))
                        (new-cur-len (if testp
                                         (1+ cur-len)
                                         1))
                        (new-max-list (if new-max-p
                                          new-cur-list
                                          max-list))
                        (new-max-len (if new-max-p
                                         new-cur-len
                                         max-len)))
                   (foo new-list cur-key new-cur-list new-cur-len new-max-list new-max-len)))))
    (if lst
        (foo (rest lst)
             (funcall key (first lst))
             (list (first lst))
             1
             (list (first lst))
             1)
        (values nil 0))))
 
CL-USER> (max-len-inc '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)
4
CL-USER> (max-len-inc '((1 a) (2 b) (3 c d) (1 e) (2 a) (3 x) (4 z) (1) (2)) :key #'car :test #'>=)
((3 C D) (1 E))
2

Хотел засунуть эту хвостовую рекурсию в do - не получилось.

@korvin_ · 16.04.2013, 18:38

Сообщение от helter

У меня получилось длинно и банально, зато экономично (однопроходно).
...
Хотел засунуть эту хвостовую рекурсию в do - не получилось.

Хм...

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(defun longest-increasing-sublist (xs)
  (let* ((len 1)
         (lst (list (car xs)))
         (max-len len)
         (max-lst lst))
    (dolist (x (cdr xs))
      (cond ((>= x (car lst))
             (push x lst)
             (incf len))
            (t (when (> len max-len)
                 (setf max-len len)
                 (setf max-lst lst))
               (setf len 1)
               (setf lst (list x)))))
    (nreverse (if (> len max-len) lst max-lst))))
 
(longest-increasing-sublist '(1 2 3 1 2 3 4 1 2))
; (1 2 3 4)

@helter · 16.04.2013, 18:42

Было функциональное настроение.

@korvin_ · 16.04.2013, 19:06

Сообщение от helter

Было функциональное настроение.

Хм... =)

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
(defun longest-increasing-sublist/fun (xs)
  (labels ((next (x len lst max-len max-lst)
             (cond ((>= x (car lst)) (list (+ len 1) (cons x lst) max-len max-lst))
                   ((> len max-len)  (list 1 (list x) len lst))
                   (t                (list 1 (list x) max-len max-lst))))
           (last (len lst max-len max-lst)
             (nreverse (if (> len max-len) lst max-lst))))
    (apply #'last (reduce #'(lambda (st x) (apply #'next (cons x st))) (cdr xs)
                          :initial-value (list 1 (list (car xs)) 1 (list (car xs)))))))
 
(longest-increasing-sublist/fun '(1 2 3 1 2 3 4 1 2))
; (1 2 3 4)

@helter · 16.04.2013, 21:14

Сообщение от korvin_

Хм... =)

Ой, это очень мне нравится.

@Catstail · 20.02.2015, 20:06 **[ТС]**

Вот еще одно решение:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(defun max-incr (lst)
  (let ((l (length lst))
        (ll 0)
        (ss 0))
   (iter (for i from 0 to (- l 2))
     (iter (for j from (+ 1 i) to l)
        (let ((test (subseq lst i j))
              (n (- j i)))
           (when (and (apply '< test) (> n ll)) (setq ss test ll n)))))
   ss)) 
 
==> max-incr
 
(max-incr '(1 2 3 2 6 7 8 9 -5 8 12 13))
 
==> (2 6 7 8 9)
 
(max-incr '(1 2 3 2 6 7 8 9 -5 8 12 13 14 15 16 18))
 
==> (-5 8 12 13 14 15 16 18)

@korvin_ · 21.02.2015, 02:21

Хех... Подняли старую тему.

Сообщение от helter

Ой, это очень мне нравится.

А я вот, спустя почти два года, смотрю на этот свой код и нифига не могу понять, как он работает, поэтому мне он что-то не очень нравится. =)))

@castorsky · 21.02.2015, 02:37

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
;; racket-lang.org
(define (sawn-list lst p)
  (let loop ((lst lst) (len 1) (acc (list (car lst))))
    (if (or (null? (cdr lst))
            (not (p (car lst) (cadr lst))))
        (values (cdr lst) len acc)
        (loop (cdr lst) (add1 len) (cons (cadr lst) acc)))))
 
 
(define (foo lst #:compare (p <))
  (let loop ((lst lst) (len 0) (acc null))
    (if (null? lst)
        (reverse acc)
        (let-values (((tail sub-list-len sub-list) (sawn-list lst p)))
          (if (> sub-list-len len)
              (loop tail sub-list-len sub-list)
              (loop tail len acc))))))
 
(foo '(1 2 3 1 2 3 4 1 1))
;'(1 2 3 4)
(foo '(1 2 3 1 2 3 4 1 1) #:compare =)
;'(1 1)

Добавлено через 12 минут

Сообщение от korvin_

нифига не могу понять, как он работает

так в реальности же

Lisp
1
(defun foo (...) "описание функции" (тело-с-комментариями))

@_sg · 21.02.2015, 02:38

Lisp
1
2
3
4
5
6
7
8
9
10
11
(defun check (w v)
  (when w (if v (check (cdr w) (cdr v)) t)))
 
(defun seq (w &optional (b (car w)) &aux (a (car w)))
  (when (and w (<= b a)) (cons a (seq (cdr w) a))))
 
(defun maxeq (w &optional ac &aux (v (seq w)))
  (if w (maxeq (cdr w) (if (check v ac) v ac)) ac))
 
> (maxeq '(1 2 3 1 2 3 4 1 2))
(1 2 3 4)

Новые блоги и статьи Все статьи Все блоги /
Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .	Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .
модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .	Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .	Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ

@Catstail Супер-модератор 38201 / 21133 / 4310 Регистрация: 12.02.2012 Сообщений: 34,740 Записей в блоге: 14
	16.04.2013, 14:04 [ТС]
	_sg, Да... Снимаю шляпу! 0

@helter 4528 / 3522 / 358 Регистрация: 12.03.2013 Сообщений: 6,038
	16.04.2013, 18:42
	Было функциональное настроение. 0

Найти в одноуровневом числовом списке возрастающий подсписок максимальной длины

Решение