Clojure Найти наибольшую последовательность чисел в списке

@Vaderkos · Регистрация: 31.03.2015

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

Нужно найти в списке самую длинную убывающую или растущую последовательность чисел
Например
Вводим список
8 4 2 3 2

Получаем две последовательности 8 4 2 и 3 2, нам нужен 8 4 2 так как он длиннее.

@Vaderkos · 27.10.2015, 02:01 **[ТС]**

_Ivana, Если бы я понимал, да и этой реализации лиспа не знаю

@_Ivana · 27.10.2015, 02:08

Да, и в при проверке на null? надо конечно выбрать из текущего результата и аккумулятора

Lisp
1
2
(cond (null? l) (cond (> acc-size res-size) (cons acc acc-size) (cons res res-size))
.......

Добавлено через 1 минуту
Vaderkos, это хорошо, что не знаете - будете хоть немного думать сами.

@Vaderkos · 27.10.2015, 02:52 **[ТС]**

Почему цикл останавливается после первого второго раза?

Добавлено через 5 минут
По-моему заработало?

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun find-longest (arr) 
    (let ((longest '()) (long-len 0) (temp (list (first arr))) (temp-len 1))
        (dolist (el (rest arr))
            (if (>= el (first temp)) 
                (progn (push el temp)   (incf temp-len))
                (when (> temp-len long-len)
                    (setf longest temp)
                    (setf long-len temp-len)
                    (setf temp-len 1)
                    (setf temp (list el)))))
        (if (> temp-len long-len) 
            (progn
                (setf longest temp)
                (setf long-len temp-len)))
                    (reverse longest)))

Добавлено через 3 минуты
Не пошло, опять(

Добавлено через 7 минут
Помоему, я все-таки нашел ошибку

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun find-longest (arr) 
    (let ((longest '()) (long-len 0) (temp (list (first arr))) (temp-len 1))
        (dolist (el (rest arr))
            (if (>= el (first temp)) 
                (progn (push el temp)   (incf temp-len))
                (progn (when (> temp-len long-len)
                (setf longest temp)
                (setf long-len temp-len))
                    (setf temp-len 1)
                    (setf temp (list el)))
            ))
        (if (> temp-len long-len) 
            (progn
                (setf longest temp)
                (setf long-len temp-len)))
                    (reverse longest)))

@helter · 27.10.2015, 03:58

Vaderkos, по-моему, всё правильно. Замечательно! Можете быть довольны собой, задача решена.

Вот вам бонус.

Во-первых, функцию резко можно сделать гораздо более универсальной. Дело в том, что сравнение с помощью >= можно не хардкодить, а задавать в качестве аргумента функции. Даже в си можно передавать аргументом ссылку на функцию, а в лиспе функции вообще граждане первого класса, можно обращаться с ними как с любыми другими объектами. Получа
ется код такой:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defun find-longest (list test) 
  (let ((longest '())
        (long-len 0)
        (temp (list (first list)))
        (temp-len 1))
    (dolist (el (rest list))
      (if (funcall test el (first temp)) 
          (progn
            (push el temp)
            (incf temp-len))
          (progn
            (when (> temp-len long-len)
              (setf longest temp)
              (setf long-len temp-len))
            (setf temp-len 1)
            (setf temp (list el)))))
    (when (> temp-len long-len) 
      (setf longest temp)
      (setf long-len temp-len))
    (values
      (nreverse longest)
      long-len)))

Во-первых, я косметически поменял arr на list, потому что в лиспе есть настоящие массивы. Во-вторых, я поставил nreverse вместо reverse, потому что список longest мы строили с нуля внутри функции, и его можно смело разрушать. В-третьих, в качестве второго значения я вернул длину найденной подпоследовательности, чтобы потом не считать её второй раз. В лиспе очень удобно работать с множественными значениями функций, поэтому если вычисления имеет побочные более-менее полезные результаты, можно их возвращать дополнительными значениями. Если они не нужны, они будут просто игнорироваться.

В-четвёртых ― самое главное ― я добавил аргумент test ― функцию сравнения. Эта функция вызывается вместо <=. Здесь приходится писать funcall ― коряво с точки зрения функционального программирования.

Почему мы не можем написать (test el (first temp))? Потому что символ на первом месте списка должен быть именем функции. А test ― имя переменной. В Common Lisp имена функций и переменных существуют независимо друг от друга (например, я назвал аргумент функции list, что никак не затеняет функцию list). Funcall используется, чтобы вытащить функцию из переменной test.

К двум пространствам имён надо привыкнуть.

Теперь вы можете писать, например,

Lisp
1
(find-longest '(1 2 3 1 2) #'<)

Lisp
1
(find-longest '(1 2 3 1 2) #'>=)

Здесь, опять из-за двух пространств имён, приходится писать #'. Почему? Потому что символы < и >= являются именами функций. А имена функций «работают» только на первом месте списка. Символы, стоящие на других местах, интерпретируются как переменные. Однако переменной < у нас нет, была бы ошибка.

Чтобы получить по имени функцию саму функцию, используется специальный оператор function. Так, < ― имя функции «меньше», (function <) ― сама функция «меньше». Сокращённо то же самое записывается #'<. Таким образом, в функцию find-longest передаются сами функции.

Ту же функцию можно применять, например, к спискам символов, сравнивая их с помощью char< или подобных функций, и ещё много к чему. Не так сложно было бы добавить опциональный аргумент key, как у некоторых стандартных функций, тогда функций стала бы ещё более универсальной (например, можно было бы рассматривать списки строк и находить наибольшие подсписки с возрастающей длиной).

Мораль: возможность передавать в функцию функциональные аргументы может многократно увеличивать её полезность.

Таким образом, ваша обёртка может быть такая:

Lisp
1
2
3
4
5
6
(defun foo (list)
  (multiple-value-bind (longest<= len<=) (find-longest list #'<=)
    (multiple-value-bind (longest>= len>= (find-longest list #'>=))
      (if (> len<= len>=)
          longest<=
          longest>=))))

(не тестил, но вроде тут негде ошибиться).

Такая функция достаточно эффективно работает и с длинными списками. Но за два прохода.

Если у вас огромные совокупности данных, то, может быть, имело бы смысл не собирать их в список, а рассматривать их по одному, навроде генератора. Тогда мы не можем позволить себе два прохода, и нужны функции чуть посложнее. Если интересует, могу рассказать.

@_Ivana · 27.10.2015, 04:00

Без реверсов. Все-таки динамическая типизация в данном примере сильно усложняет написание кода - конструировать и разбирать пары-тройки, реализованные через списки, и элементами которых также могут быть списки, достаточно нудно, и главное - компилятор всегда все воспринимает как должное, даже если ты ошибся, и не подскажет.

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(defn task (l)
    (defn sub-pred (pred)
        (defn take-pred (l x)
            (def h (car l) t (cdr l))
            (cond (null? l) '((0 ()) ())
                  (or (null? x) (pred x h))
                      ((def r (take-pred t h) hr (car r))
                      (cons (cons (+ 1 (car hr)) (cons h (cadr hr)) nil) (cdr r)))
                  (cons '(0 ()) (cons l nil)) ))
        (defn go (l size val)
            (def a (take-pred l nil) a-size (caar a) a-val (cadar a) t (cadr a))
            (printLn (str a-size a-val t))
            (cond (null? l) (cons size val nil)
                  (> a-size size) (go t a-size a-val)
                                  (go t size val) ))
        (go l 0 nil))
    (def a (sub-pred <) d (sub-pred >))
    (cond (> (car a) (car d)) (cadr a) (cadr d)) )

@helter · 27.10.2015, 04:07

Не очень элегантно смотрится дублирование кода проверки. В принципе, можно создать для него локальную функцию. Я помещу её объявление внутрь объявлений переменных, чтобы она имела к ним доступ:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defun find-longest (list test) 
  (let ((longest '())
        (long-len 0)
        (temp (list (first list)))
        (temp-len 1))
    (flet ((update-longest ()
             (when (> temp-len long-len)
               (setf longest temp)
               (setf long-len temp-len))))
      (dolist (el (rest list))
        (if (funcall test el (first temp)) 
            (progn
              (push el temp)
              (incf temp-len))
            (progn
              (update-longest)
              (setf temp-len 1)
              (setf temp (list el)))))
      (update-longest)
      (values
        (nreverse longest)
        long-len))))

Может, так и лучше.

Добавлено через 5 минут
А, забыл ещё. Алгоритм-то для непустых списков, так что надо изначально сделать проверку на пустоту и для пустого вернуть (values nil 0).

@_sg · 27.10.2015, 08:51

как вариант:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
(defun max-length-seq (w &aux (a (m w '<=)) (b (m w '>=)))
  (if (>= (length a) (length b)) a b))
 
(defun s (w p &optional (b (car w)) &aux (a (car w)))
  (when w (when (funcall p b a) (cons a (s (cdr w) p a)))))
 
(defun m (w p &optional a &aux (v (s w p)))
  (if w (m (cdr w) p (if (> (length v) (length a)) v a)) a))
 
> (max-length-seq '(8 4 2 3 4 5 2))
(2 3 4 5)
> (max-length-seq '(8 4 2 3 2))
(8 4 2)

@Vaderkos · 27.10.2015, 12:16 **[ТС]**

helter, Еще вопрос, допустим по убыванию нашли список равный найденному списку по возрастанию, по заданию нам нужно вернуть тот список который стоит раньше, нужно ввести переменную счетчик для такого случая?

Добавлено через 17 минут
Не список а последовательность

Добавлено через 1 час 24 минуты
helter, да я хотел на ходу считать поэтому я и считывать и решать пытался одновременно в самом начале так как чисел от 0 до 10в7 а ращмер каждого от 0до 10 в 9. Даже сейчас я из-за этого получаю ошибку в части тестов.

@helter · 27.10.2015, 15:50

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

Даже сейчас я из-за этого получаю ошибку в части тестов.

Честно говоря, не вижу, откуда могут возникнуть ошибки. По-моему, должно работать с любыми списками, которые физически помещаются в компьютер.

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

по заданию нам нужно вернуть тот список который стоит раньше, нужно ввести переменную счетчик для такого случая?

Как в жизни: задание меняется на ходу.

Ну да, можно ещё одну переменную. Надо будет добавить её в let и внутрь update-longest. Вот чем хорошо, когда код не дублируется: изменения вносятся только в одном месте. И можно возвращать позицию третьим значением.

Добавлено через 1 час 47 минут
Чтобы работать с последовательными числами, мы используем замыкания. Замыкание ― это функция вместе с какими-то внешними данными.

Сначала ― простейший пример. Убедитесь, что он понятен.

Lisp
1
2
3
4
5
6
(let ((c (let ((i 0))
           (lambda ()
             (incf i)))))
  (print (funcall c))
  (print (funcall c))
  (print (funcall c)))

Печатает 1, 2, 3.

Здесь внутренний let возвращает функцию (лямбду), которую мы связываем с переменной c. Эта лямбда имеет доступ к переменной i. Когда мы вызываем лямбду, она увеличивает i на 1 и возвращает увеличенное значение. Так что когда внизу мы вызываем эту лямбду 3 раза, она печатает сначала 1 (при этом становится i = 1), потом ― 2, потом ― 3. То есть лямбда помнит переменную i, в контексте которой она определялась. При этом сама переменная i уже не видна за пределами внутреннего let-а. Вот я попробую её использовать:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
(let ((c (let ((i 0))
           (lambda ()
             (incf i)))))
  (print (funcall c))
  (print (funcall c))
  (print (funcall c))
  i)
==>
1 
2 
3 The variable I is unbound.
   [Condition of type UNBOUND-VARIABLE]

Таким образом, лямбда «захватывает» данные из окружающей программы, а переменная i всегда видна внутри области видимости, созданной let-ом, даже когда программа выходит из let-а. Такая видимость называется лексической, а функция с захваченными (инкапсулированными) данными ― замыканием. Let над lambd'ой ― прототипическое замыкание (и название известной книги о лиспе, в которой много говорится о замыканиях).

Предположим, вам понравились счётчики, и вы хотите их много-много в своей программе. Тогда вам нужна функция, создающая счётчики. Это значит, нужна лямбда над летом над лямбдой.

Lisp
1
2
3
4
(defun make-counter ()
  (let ((i 0))
    (lambda ()
      (incf i))))

Значением let-а является лямбда, которая и возвращается функцией. Однако эта функция помнит о переменной i. Извне defun-а нет никакого способа получить доступ к i, кроме возвращённой функции. Работает вот так:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(let ((c1 (make-counter))
      (c2 (make-counter)))
  (format t "Первый счётчик: ~A~%" (funcall c1))
  (format t "Первый счётчик: ~A~%" (funcall c1))
  (format t "Первый счётчик: ~A~%" (funcall c1))
  (format t "Второй счётчик: ~A~%" (funcall c2))
  (format t "Второй счётчик: ~A~%" (funcall c2))
  (format t "Первый счётчик: ~A~%" (funcall c1)))
==>
Первый счётчик: 1
Первый счётчик: 2
Первый счётчик: 3
Второй счётчик: 1
Второй счётчик: 2
Первый счётчик: 4
NIL

Здесь можно обратить внимание, что счётчики c1 и c2 не конфликтуют. Это потому, что у них разные экземпляры i, созданные разными вызовами let-а. (На схеме этот пример смотрелся бы красивее, потому что не было бы funcall-а.)

Конечно, замыкать можно любые лексические переменные, а не только созданные с помощью let. Например, лексическими переменными являются формальные параметры в теле defun-а. Можно модифицировать make-counter, задавая начальное значение:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun make-counter (&optional (initial-value 0))
  (let ((i (1- initial-value)))
    (lambda ()
      (incf i))))
 
(let ((c1 (make-counter))
      (c2 (make-counter 101)))
  (format t "Первый счётчик: ~A~%" (funcall c1))
  (format t "Первый счётчик: ~A~%" (funcall c1))
  (format t "Первый счётчик: ~A~%" (funcall c1))
  (format t "Второй счётчик (со 101): ~A~%" (funcall c2))
  (format t "Второй счётчик (со 101): ~A~%" (funcall c2))
  (format t "Первый счётчик: ~A~%" (funcall c1)))
==>
Первый счётчик: 0
Первый счётчик: 1
Первый счётчик: 2
Второй счётчик (со 101): 101
Второй счётчик (со 101): 102
Первый счётчик: 3
NIL

@smoke853 · 27.10.2015, 19:56

Не по теме:

Как вариант, наверняка медленный, но все же.
P.S. Все никак нет времени поставить на виртуалку linux + emacs + clojure :pardon: Поэтому решение опять на Scala.

Код

Java
1
2
3
4
5
6
7
8
9
10
11
12
13
14
package com.smoke
 
object Main {
  def main(args: Array[String]): Unit = {
    val lists = List(List(8, 4, 2, 3, 2), List(8, 4, 2, 3, 4, 2), List(8, 4, 2, 3, 4, 5, 2))
    lists foreach (x => println(task(x)))
  }
 
  def task(lst: List[Int]) =
    lst.tails flatMap (_.inits) filter (x => isSorted(x)(_ < _) || isSorted(x)(_ > _)) maxBy (_.length)
 
  def isSorted(lst: List[Int])(f: (Int, Int) => Boolean) =
    lst.isEmpty || (lst zip lst.tail forall f.tupled)
}

Вывод:

Code
1
2
3
List(8, 4, 2)
List(8, 4, 2)
List(2, 3, 4, 5)

@helter · 27.10.2015, 20:01

Теперь мы попробуем применить замыкания к нашей задаче.

Идея ― иметь функцию, которой «скармливаются» последовательные элементы последовательности, и которая внутри запоминает информацию о длиннейших монотоных подпоследовательностям. Раньше у нас «скармливанием» занимался dolist внутри функции. Теперь механизм итерирования выносится из функции. То есть я хочу иметь что-то такое:

Lisp
1
2
3
4
5
6
7
8
(let ((list '(2 3 4 1 2 3 4 5 1 2 3 1)))
  (let ((lf (longfinder #'<=)) longest long-len long-pos)
    (dolist (el list (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall lf el)))))
==>
(1 2 3 4 5)
5
3

Здесь longfinder ― производитель замыканий, выделяющих самые длинные монотонные подпоследовательности. В качестве аргумента принимает тестовую функцию. С помощью этого производителя я создаю замыкание f, с помощью которого анализирую список list. Генерация последовательных элементов списка производится циклом dolist, но замыканию всё равно ― с таким же успехом можно было бы читать числа из потока, например.

Чтобы переделать код find-longest в код longfinder, по сути надо «вынести за лямбду» все переменные, кроме el, и вернуть лямбду, зависящую от el. Я сделаю небольшие модификации алгоритма. Во-первых, замыкание никак не знает, последний элемент ему передали или нет. Либо вводить способ оповещения, что аргумент последний, либо делать апдейт длиннейшего списка на каждой итерации. Я выбираю второе: проигрывается несколько присваиваний, что, думаю, некритично; зато просто. Во-вторых, я буду первый элемент обрабатывать по тем же правилам, как и остальные. Для этого я temp изначально выставляю в nil, и в цикле делаю проверку, пустой он или нет. Опять же, не думаю, что эта проверка критично отзовётся на производительности. В качестве значений замыкание каждый раз будет возвращать перевёрнутую длиннейшую монотонную последовательность, её длину и позицию начала. В примере выше я каждый раз присваиваю возвращаемые значения переменным longest, long-len и long-pos (не тем, которые в функции), и возвращаю последнее присвоенное значение.

Код longfinder:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defun longfinder (test) 
  (let ((longest '())
        (long-len 0)
        (long-pos nil)
        (temp nil)
        (temp-len 0)
        (temp-pos nil)
        (pos 0))
    (lambda (el)
      (cond ((or (null temp) (funcall test (first temp) el))
             (push el temp)
             (incf temp-len))
            (t 
             (setf temp (list el))
             (setf temp-len 1)
             (setf temp-pos pos)))
      (when (> temp-len long-len)
        (setf longest temp)
        (setf long-len temp-len)
        (setf long-pos temp-pos))
      (incf pos)
      (values longest long-len long-pos))))

По-моему, работает нормально, но потестировать не помешает. Производительность на моём компе:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defparameter *list* (loop repeat 10000000 collect (random 1000000)))
(time
  (let ((f (longfinder #'<=)) longest long-len long-pos)
    (dolist (el *list* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el)))))
==>
Evaluation took:
  0.576 seconds of real time
  0.630000 seconds of total run time (0.630000 user, 0.000000 system)
  109.38% CPU
  977,348,579 processor cycles
  160,004,864 bytes consed
  
(249750 379806 418120 459598 477939 641898 712335 740597 790079 835458)
10
2371221

Вроде ничего.

Вывод: по функциональности longfinder эквивалентна find-longest ― это универсальная функция, принимающая различные тестовые функции. Разница в интерфейсе: find-longest работает только по списку, longfinder возвращает замыкания, принимающие значения последовательности одно за другим. find-longest ― простенькая функция, аналог которой можно было бы написать на многих языках (хотя функциональный аргумент делает её очень гибкой). longfinder ― более интересная и более лиспоспецифичная. Common Lisp не функционален по мелочам, но важные идеи из функционального программирования он содержит. Замыкания ― одна из них.

@_sg · 28.10.2015, 09:34

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(defun helter (test) 
  (let ((longest)
        (long-len 0)
        (long-pos)
        (temp)
        (temp-len 0)
        (temp-pos)
        (pos 0))
    (lambda (el)
      (cond ((or (null temp) (funcall test (car temp) el))
             (push el temp)
             (incf temp-len))
            ((setf temp (list el))
             (setf temp-len 1)
             (setf temp-pos pos)))
      (when (> temp-len long-len)
        (setf longest temp)
        (setf long-len temp-len)
        (setf long-pos temp-pos))
      (incf pos)
      (values longest long-len long-pos))))
 
> (defparameter *w* '(8 4 2 3 4 5 2))
*W*
> (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el))))
(2 3 4 5)
4
2
> (defparameter *w* '(8 4 2 3 2))
*W*
> (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el))))
(2 3)
2
2
> (defparameter *w* (loop repeat 1000000 collect (random 1000000)))
*W*
> (time
  (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el)))))
 
Real time: 34.320965 sec.
Run time: 33.368614 sec.
Space: 680001324 Bytes
GC: 163, GC time: 3.8376245 sec.
(216291 325954 397023 596428 602798 603906 718373 783547 809859)
9
795048

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

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
> (defparameter *w* (loop repeat 1000000 collect (random 1000000)))
*W*
> (time
  (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el)))))
 
Real time: 34.07095 sec.
Run time: 33.649414 sec.
Space: 680001324 Bytes
GC: 299, GC time: 4.258827 sec.
(2203 8467 80402 98814 102758 587044 591255 835694 935103)
9
178331

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

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
(defun max-length-seq (w &aux (a (m w '<=)) (b (m w '>=)))
  (if (>= (length a) (length b)) a b))
 
(defun s (w p &optional (b (car w)) &aux (a (car w)))
  (when w (when (funcall p b a) (cons a (s (cdr w) p a)))))
 
(defun m (w p &optional a &aux (v (s w p)))
  (if w (m (cdr w) p (if (> (length v) (length a)) v a)) a))
 
> (max-length-seq '(8 4 2 3 4 5 2))
(2 3 4 5)
> (max-length-seq '(8 4 2 3 2))
(8 4 2)
> (defparameter *w* (loop repeat 1000000 collect (random 1000000)))
*W*
> (time (max-length-seq *w*))
Real time: 3.7262132 sec.
Run time: 3.7284238 sec.
Space: 27489712 Bytes
GC: 7, GC time: 0.3900025 sec.
(5497 106027 125610 131075 265060 584137 866993 930315 960601)
> (defparameter *w* (loop repeat 1000000 collect (random 1000000)))
*W*
> (time (max-length-seq *w*))
Real time: 3.567204 sec.
Run time: 3.572423 sec.
Space: 27481048 Bytes
GC: 6, GC time: 0.2340015 sec.
(998733 964178 873281 843105 817805 794879 760122 730057 289221 285153 236462 230293)

Добавлено через 5 минут
на одном *w*:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
> (defparameter *w* (loop repeat 1000000 collect (random 1000000)))
*W*
> (time (max-length-seq *w*))
Real time: 3.4321964 sec.
Run time: 3.432022 sec.
Space: 27504784 Bytes
GC: 12, GC time: 0.1404009 sec.
(75084 217593 277494 330218 638271 645774 865937 875797 981781)
 
> (time
  (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el)))))
 
Real time: 31.342793 sec.
Run time: 31.0754 sec.
Space: 704014824 Bytes
GC: 289, GC time: 1.7628113 sec.
(75084 217593 277494 330218 638271 645774 865937 875797 981781)
9
234374

@helter · 28.10.2015, 12:56

_sg, не могу повторить ваших результатов. Тот же самый, в принципе, код:

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(defparameter *w* (loop repeat 1000000 collect (random 1000000)))
 
(defun helter (test) 
  (let ((longest)
        (long-len 0)
        (long-pos)
        (temp)
        (temp-len 0)
        (temp-pos)
        (pos 0))
    (lambda (el)
      (cond ((or (null temp) (funcall test (car temp) el))
             (push el temp)
             (incf temp-len))
            ((setf temp (list el))
             (setf temp-len 1)
             (setf temp-pos pos)))
      (when (> temp-len long-len)
        (setf longest temp)
        (setf long-len temp-len)
        (setf long-pos temp-pos))
      (incf pos)
      (values longest long-len long-pos))))
 
 
(defun s (w p &optional (b (car w)) &aux (a (car w)))
  (when w (when (funcall p b a) (cons a (s (cdr w) p a)))))
 
(defun m (w p &optional a &aux (v (s w p)))
  (if w (m (cdr w) p (if (> (length v) (length a)) v a)) a))
 
(defun max-length-seq (w &aux (a (m w '<=)) (b (m w '>=)))
  (if (>= (length a) (length b)) a b))
 
(time (max-length-seq *w*))
 
;;;;;;;;;;;;;;;;;;;   SBCL 1.2.16 ;;;;;;;;;;;;;;;;;;;;;;;;;
 
> (benchmark:with-timing (100)
  (max-length-seq *w*))
-                SAMPLES  TOTAL       MINIMUM   MAXIMUM   MEDIAN    AVERAGE     DEVIATION  
REAL-TIME        100      28.398      0.281     0.339     0.282     0.28398     0.006521   
RUN-TIME         100      29.79       0         1.37      0         0.2979      0.392624   
USER-RUN-TIME    100      29.789997   0         1.369999  0         0.2979      0.392613   
SYSTEM-RUN-TIME  100      0           0         0         0         0           0.0        
PAGE-FAULTS      100      0           0         0         0         0           0.0        
GC-RUN-TIME      100      1.227       0         1.173     0         0.01227     0.116744   
BYTES-CONSED     100      5499673632  54983232  55048016  54984704  54996736.0  16459.96   
EVAL-CALLS       100      0           0         0         0         0           0.0        
NIL
> (benchmark:with-timing (100)
  (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el)))))
-                SAMPLES  TOTAL       MINIMUM   MAXIMUM   MEDIAN    AVERAGE     DEVIATION  
REAL-TIME        100      5.955       0.055     0.077     0.055     0.05955     0.005972   
RUN-TIME         100      5.66        0         1.477     0         0.0566      0.277549   
USER-RUN-TIME    100      5.66        0         1.476667  0         0.0566      0.277548   
SYSTEM-RUN-TIME  100      0           0         0         0         0           0.0        
PAGE-FAULTS      100      0           0         0         0         0           0.0        
GC-RUN-TIME      100      0           0         0         0         0           0.0        
BYTES-CONSED     100      1600016064  15989808  16023552  15990784  16000161.0  14881.261  
EVAL-CALLS       100      0           0         0         0         0           0.0        
NIL

Судя по медлительности вашей реализации и по виду вывода time, предположил, что это CLISP. Однако там ваша функция у меня в принципе не заработала:

Lisp
1
2
3
4
5
6
> (time (max-length-seq *w*))
 
*** - Program stack overflow. RESET
Real time: 0.037392 sec.
Run time: 0.036667 sec.
Space: 193840 Bytes

На *w* из 10^5 элементов — аналогично. ЧЯДНТ?

@_sg · 28.10.2015, 13:13

helter, мистика.

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

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(defun max-length-seq (w &aux (a (m w '<=)) (b (m w '>=)))
  (if (>= (length a) (length b)) a b))
 
(defun s (w p &optional (b (car w)) &aux (a (car w)))
  (when w (when (funcall p b a) (cons a (s (cdr w) p a)))))
 
(defun m (w p &optional a &aux (v (s w p)))
  (if w (m (cdr w) p (if (> (length v) (length a)) v a)) a))
 
> (defparameter *w* (loop repeat 1000000 collect (random 1000000)))
*W*
> (time (max-length-seq *w*))
Evaluation took:
  3.326 seconds of real time
  3.276022 seconds of total run time (3.229221 user, 0.046801 system)
  [ Run times consist of 0.141 seconds GC time, and 3.136 seconds non-GC time. ]
  98.50% CPU
  3,313,434,076 processor cycles
  27,513,208 bytes consed
(187421 461452 481307 493553 508395 768022 805924 859213 938392)

@helter · 28.10.2015, 13:14

По-моему, мистика — что у вас нехвостовая рекурсия глубины 10^6 в принципе заработала на CLISPе. Это ещё удивительнее, чем что она за два прохода обогнала однопроходный алгоритм с циклом.

Я хотел уточнить: на момент замера времени у вас функции были скомпилированные?

@_sg · 28.10.2015, 13:23

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 helter (test) 
  (let ((longest)
        (long-len 0)
        (long-pos)
        (temp)
        (temp-len 0)
        (temp-pos)
        (pos 0))
    (lambda (el)
      (cond ((or (null temp) (funcall test (car temp) el))
             (push el temp)
             (incf temp-len))
            ((setf temp (list el))
             (setf temp-len 1)
             (setf temp-pos pos)))
      (when (> temp-len long-len)
        (setf longest temp)
        (setf long-len temp-len)
        (setf long-pos temp-pos))
      (incf pos)
      (values longest long-len long-pos))))
 
> (time
  (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el)))))
Evaluation took:
  0.406 seconds of real time
  0.405602 seconds of total run time (0.280802 user, 0.124800 system)
  [ Run times consist of 0.218 seconds GC time, and 0.188 seconds non-GC time. ]
  100.00% CPU
  400,528,516 processor cycles
  8,000,288 bytes consed
  
(187421 461452 481307 493553 508395 768022 805924 859213 938392)
9
975706

Добавлено через 59 секунд
SBCL

Добавлено через 4 минуты
Да, скомпилированые. Возможно, СLISP тормозит вызов helter из REPL.

Добавлено через 1 минуту
а SBCL компилирует из REPL.

@helter · 28.10.2015, 13:27

SBCL в принципе компилирует всё, у него других опций нет. В общем случае, если функция helter скомпилирована, она должна возвращать скомпилированные замыкания, так что проблем от REPLа не должно быть.

@_sg · 28.10.2015, 13:52

или max-length-seq работает некорректно?

Добавлено через 23 минуты
у меня max-length-seq в обеих реализациях отрабатывает за 3 с., helter в CLISP -30 c., в SBCL - 0,4 c., возможно CLISP тормозит в отличие от SBCL вызов из REPL конструкции:

Lisp
1
2
3
4
CL-USER> (time
  (let ((f (helter #'<=)) longest long-len long-pos)
    (dolist (el *w* (values (nreverse longest) long-len long-pos))
      (setf (values longest long-len long-pos) (funcall f el)))))

@Catstail · 29.10.2015, 11:47

До кучи:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun list-len (lst &optional (n (length lst)))
  (apply 'append (mapcar #'(lambda (k) 
                           (let ((tmp (subseq lst 0 k)))
                             (if (or (apply '> tmp) (apply '< tmp)) (list k tmp) nil))) (range 1 n))))
 
(defun list-lens (lst)
  (cond ((null lst) nil)
        (t (append (list-len lst) (list-lens (cdr lst))))))
 
 
(defun max-len-seq (lens &optional (m (car lens)) (mm (cadr lens)))
  (cond ((null (cddr lens)) mm)
        (t (if (> (car lens) m) (max-len-seq (cddr lens) (car lens) (cadr lens))
                                (max-len-seq (cddr lens) m mm)))))
 
(defun task (lst)
  (max-len-seq (list-lens lst)))
 
(task '(1 2 3 0 -1 -2 -3 -4 6 7 8 0))
 
==> (3 0 -1 -2 -3 -4)

@_sg · 29.10.2015, 18:09

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
38
(defparameter *w* (loop repeat 1000000 collect (random 1000000)))
 
(defun helter (test) 
  (let ((longest)
        (long-len 0)
        (long-pos)
        (temp)
        (temp-len 0)
        (temp-pos)
        (pos 0))
    (lambda (el)
      (cond ((or (null temp) (funcall test (car temp) el))
             (push el temp)
             (incf temp-len))
            ((setf temp (list el))
             (setf temp-len 1)
             (setf temp-pos pos)))
      (when (> temp-len long-len)
        (setf longest temp)
        (setf long-len temp-len)
        (setf long-pos temp-pos))
      (incf pos)
      (values longest long-len long-pos))))
 
(defun test ()
  (time
   (let ((f (helter #'<=)) longest long-len long-pos)
     (dolist (el *w* (values (nreverse longest) long-len long-pos))
       (setf (values longest long-len long-pos) (funcall f el))))))
 
> (test)
Real time: 1.3582025 sec.
Run time: 1.3416086 sec.
Space: 8000080 Bytes
GC: 4, GC time: 0.156001 sec.
(106353 469767 657552 688270 735720 754289 762887 890442 972765)
9
280755

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

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(defparameter *w* (loop repeat 1000000 collect (random 1000000)))
 
(defun max-length-seq (w &aux (a (m w '<=)) (b (m w '>=)))
  (if (>= (length a) (length b)) a b))
 
(defun s (w p &optional (b (car w)) &aux (a (car w)))
  (when w (when (funcall p b a) (cons a (s (cdr w) p a)))))
 
(defun m (w p &optional a &aux (v (s w p)))
  (if w (m (cdr w) p (if (> (length v) (length a)) v a)) a))
 
> (time (max-length-seq *w*))
Real time: 3.388206 sec.
Run time: 3.3072212 sec.
Space: 27489568 Bytes
GC: 6, GC time: 0.1716011 sec.
(834341 778338 759739 542349 453988 258028 130867 109354 105127 85714)

Добавлено через 6 минут
helter, на одном *w*:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
CL-USER> (time (max-length-seq *w*))
Real time: 3.4546194 sec.
Run time: 3.4008217 sec.
Space: 27480896 Bytes
GC: 11, GC time: 0.2808018 sec.
(855983 696642 679385 553457 500899 457772 392158 244249 189649)
CL-USER> (test)
Real time: 1.1740152 sec.
Run time: 1.1700075 sec.
Space: 8000080 Bytes
GC: 4, GC time: 0.0468003 sec.
(5721 46180 119569 150291 194739 601563 885325 904071)
8
44720

Добавлено через 1 час 1 минуту
Catstail, (range 1 n) > (loop for m from 1 to n collect m) ?

Новые блоги и статьи Все статьи Все блоги /
Про "Windows must die!" kumehtar 04.11.2026 Знаете, чет накатило. . . . Когда-то это было почти боевым кличем: мол, нормальный человек сидит на DOS, OS/ 2 или Linux, а вот это вот - Must Die. А теперь человек произносит «мастдай» с усмешкой - и. . .	Красочные поля с номером страницы svg+background-image russiannick 04.11.2026 Красочные поля с номером страницы не менее важны чем в эпоху бумажных книг. Посему спешу представить почтеннейшей публике этот важный инструмент который эти поля и формирует. В процессе разработки. . .	Вступаем в новую фазу генерации favicons, векторную. russiannick 02.11.2026 Теперь нет нужды скрывать что используется простой svg. Исходный код изображения помещаем в поле и жмем кнопку. Исходник преобразуется в вид корректный для помещения в favicon или в url(). Нажатие. . .	Генератор паролей (вариант №4) Maks 01.11.2026 После публикации 3-го варианта генератора паролей, разослал его своим коллегам (с целью оценки), в итоге были получены следующие рекомендации: 1. Вернуть возможность использования знаков \| 1 l I;. . .
Генератор паролей (вариант №3) Maks 30.10.2026 Финальная версия генератора паролей 1С. Доработка решения в этот раз коснулась только визуальной части, а именно, добавлен реквизит ДопПараметры (тип Булево), который скрывает/ отображает реквизиты:. . .	Магическое мышление и магия, современная наука не отличима от магии (говорит ИИ Джемени) zorxor 30.10.2026 Джемени, расскажи, пожалуйста, что такое магическое мышление, что такое магия, почему современная наука чем-то напоминает магию? Фраза «Любая достаточно развитая технология неотличима от магии». . .	За какое время ИИ может подобрать пароль по хешу (рассказывает Джемени ИИ) zorxor 30.10.2026 Расскажи, Джемени, если известен хэш МД5, например, за сколько ИИ сможет подобрать соответствующий пароль? Искусственный интеллект (ИИ) может подобрать простой или средний по сложности пароль по. . .	Кто убил Suno? Почему наше солнышко погасло? (диалог с ИИ Джемени) zorxor 30.10.2026 Как убивали Suno. Хронология. «Убийство» музыкальной нейросети Suno — это затяжной процесс, в котором технологический хайп стартапа разбился о жесткую реальность судебных исков от гигантов. . .

@Vaderkos 84 / 83 / 8 Регистрация: 31.03.2015 Сообщений: 447

	Clojure Найти наибольшую последовательность чисел в списке 26.10.2015, 20:31. Показов 6346. Ответов 84 Метки нет (Все метки) Нужно найти в списке самую длинную убывающую или растущую последовательность чисел Например Вводим список 8 4 2 3 2 Получаем две последовательности 8 4 2 и 3 2, нам нужен 8 4 2 так как он длиннее. 0

@Vaderkos 84 / 83 / 8 Регистрация: 31.03.2015 Сообщений: 447
	27.10.2015, 02:01 [ТС]
	_Ivana, Если бы я понимал, да и этой реализации лиспа не знаю 0

@Vaderkos 84 / 83 / 8 Регистрация: 31.03.2015 Сообщений: 447
	27.10.2015, 12:16 [ТС]
	helter, Еще вопрос, допустим по убыванию нашли список равный найденному списку по возрастанию, по заданию нам нужно вернуть тот список который стоит раньше, нужно ввести переменную счетчик для такого случая? Добавлено через 17 минут Не список а последовательность Добавлено через 1 час 24 минуты helter, да я хотел на ходу считать поэтому я и считывать и решать пытался одновременно в самом начале так как чисел от 0 до 10в7 а ращмер каждого от 0до 10 в 9. Даже сейчас я из-за этого получаю ошибку в части тестов. 0

@helter 4528 / 3522 / 358 Регистрация: 12.03.2013 Сообщений: 6,038
	28.10.2015, 13:14
	По-моему, мистика — что у вас нехвостовая рекурсия глубины 10^6 в принципе заработала на CLISPе. Это ещё удивительнее, чем что она за два прохода обогнала однопроходный алгоритм с циклом. Я хотел уточнить: на момент замера времени у вас функции были скомпилированные? 0

@helter 4528 / 3522 / 358 Регистрация: 12.03.2013 Сообщений: 6,038
	28.10.2015, 13:27
	SBCL в принципе компилирует всё, у него других опций нет. В общем случае, если функция helter скомпилирована, она должна возвращать скомпилированные замыкания, так что проблем от REPLа не должно быть. 0