[haskell, pure fp] Doubly linked circular lists они же Rings

Попробуй его сделать как TypeClass, что-то вроде:

class Ring a where
  zero :: a -> Bool
  ...

Ну а для хранения элементов юзай List:

instance Ring [a] where
  ...

List

Моя задумка в том, чтобы реализовать АТД альтернативный к List - его объекты в целом более жирные (по памяти), но для них операции вроде last и length имеют константную по времени сложность (O(1)). Плюс foldr и foldl никак не отличаются.

> АТД альтернативный к List - его объекты в целом более жирные (по памяти), но для них операции вроде last и length имеют константную по времени сложность (O(1))

Data.Sequence ?

Data.Sequence ?

Интересно. Может там найду чего-нибудь наводящего.

Но я хочу Data.Ring, в качестве упражнения.

Кстати да, видел где-то мнение о том что замкнутые списки нереализуемы и вместо них используют zipper и finger-tree (как раз в эти Data.Sequence на них).

> Как правильно сделать subj? Читал Tying the Knot

Точно читал? Например, там есть такие строки:

Here's an example. Say you want to build a circular, doubly-linked list, given a standard Haskell list as input.

Оно?

Допустим у нас есть кольцо из 5 элементов, я так понимаю, что если мы по нему пройдёмся 50 раз то в памяти помимо этих 5 элементов создаться ещё 45?

Нет, если применять технику из Tying the knot. В памяти будет именно кольцо, а не список с двумя санками по бокам.

И ещё - если мы возьмём кольцо и «изменим» (не в смысле присваивания, а в смысле создания нового кольца) в нём элемент перед первым (который суть последний) то другой последний не изменится. Вообще - «изменение» одного элемента не меняет взаимно периодичных с ним. Как вообще проделывать эту операцию?

Как ты себе это представляешь? Формально кольцо — бесконечный список, и склонировать его не получится (как определить границу?). Как workaround, можно хранить не сами данные, а указатели (IORef). Периодичный указатели будут указывать на один и тот же адрес, и изменение данных по адресу отразится везде. Само кольцо при этом менять не нужно. Но чистота теряется, да.

Если нет, то - нет ли у GHC дружественного к пользователю способа введения примитивов? ;)

Это как?

Ну и последний вопрос - можно ли ввести какой-нибудь такой синтаксис для своих типов:
<1, 2, 3>
?

В пределах стандартного хаскеля — нет.

Что, не выходит морфизм?

А в это время конкуренты уже давно воспользовались GList / std::list / java.util.LinkedList / whatever, решили задачу, получили денежку и пропивают ее. ;)

> Формально кольцо — бесконечный список, и склонировать его не получится (как определить границу?).

Невозможность определить границу - это хаскельная проблема?

Вообще, я удивляюсь, как у кого-то поворачивается язык говорить о серьезном применении ФЯП, в то время как эффективная реализация двухсвязных списков (задача для второго курса тех. ВУЗа) вызывает фундаментальные проблемы.

> Невозможность определить границу - это хаскельная проблема?

Видимо, да, потому что, например, в Java никаких проблем с deep copy / shallow copy листов не наблюдается :)

> Вообще, я удивляюсь, как у кого-то поворачивается язык говорить о серьезном применении ФЯП, в то время как эффективная реализация двухсвязных списков (задача для второго курса тех. ВУЗа) вызывает фундаментальные проблемы.

Вообще, я удивляюсь, как ты можешь что-то писать, если даже прочитать (задача для первого класса общеобразовательной школы), что речь идёт не о двусвязном списке, а о двусвязном кольце, ты не можешь.

А в это время конкуренты уже давно воспользовались GList / std::list / java.util.LinkedList / whatever, решили задачу, получили денежку и пропивают ее. ;)

Вообще, я удивляюсь, как у кого-то поворачивается язык говорить о серьезном применении ФЯП, в то время как эффективная реализация двухсвязных списков (задача для второго курса тех. ВУЗа) вызывает фундаментальные проблемы.

Вообще, я удивляюсь, как ты можешь что-то писать, если даже прочитать (задача для первого класса общеобразовательной школы), что речь идёт не о двусвязном списке, а о двусвязном кольце, ты не можешь.

Всё ништяк, ты ничего в современном software development не понимаешь. Конкуренты быстро сплавили полурабочую версию заказчику, получили денег. Фуршет, пошив костюмов к фуршету. Как только заказчик обнаружит, что кольцевой буфер чегой-то кончается, то конкуренты залепят вторую версию и получат ещё денег. Фуршет, пошив костюмов к фуршету.

> речь идёт не о двусвязном списке, а о двусвязном кольце...

А знаешь, почему я их не дифференцирую в данном контексте (как и любой другой пользователь нормальных ЯП)?

Потому что для пользователей нормальных ЯП doubly-linked list превращается в doubly-linked circular list абсолютно тривиальным образом. С сохранением эффективности реализации, по сложности операций доступа и расходу памяти. Мы просто не отличаем два этих понятия, они тривиально переходят друг в друга.

И только упертым упоротым упорным ФЯП-фаперам приходится исполнять хитрые танцы с бубном, чтобы заполучить подобную элементарщину. «Но морфизм есть!» (С) quasimoto

Начал петросянить и подменять понятия (doubly-linked circular list ≠ ring buffer, вообще говоря)?

Хороший знак, значит, задело за живое :)

И только упертым упоротым упорным ФЯП-фаперам приходится исполнять хитрые танцы с бубном, чтобы заполучить подобную элементарщину.

Кстати, зря ты так. Если напишешь реализацию двусвязного кольцевого списка на сях, то проделаешь ровно то же самое, что и проделано в статье по ссылке из корня топика. Описанная техника проста и элегантна.

Начал петросянить и подменять понятия (doubly-linked circular list ≠ ring buffer, вообще говоря)?

Вообще, для ринг буффера, заполняемого в одном направлении, как это обычно и бывает, достаточно одной связи.

Мы просто не отличаем два этих понятия, они тривиально переходят друг в друга.

Раз отметил std::list, давай, наваяй на нём контейнер ringbuffer, чтобы показать эту тривиальность.

И только упертым упоротым упорным ФЯП-фаперам приходится исполнять хитрые танцы с бубном, чтобы заполучить подобную элементарщину. «Но морфизм есть!» (С) quasimoto

У упёртых, упоротых, упорных лисперов циркулярность есть из коробки. Им даже акт самосодомии не надо совершать, чтобы из нециркулярной структуры сделать циркулярную.

>> Формально кольцо — бесконечный список, и склонировать его не получится (как определить границу?).

Невозможность определить границу - это хаскельная проблема?

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

>>> Формально кольцо — бесконечный список, и склонировать его не получится (как определить границу?).

Невозможность определить границу - это хаскельная проблема?

Проблема в использовании мутабельной структуры данных в чистом языке.

Это понятно (непонятно, конечно, зачем создавать себе такие проблемы). Но я спрашивал именно о поиске границы (в Си это делается элементарно - начинаем копировать с любого элемента start, и заканчиваем на элементе, где elt->next == start).

А в это время конкуренты уже давно воспользовались GList / std::list / java.util.LinkedList / whatever, решили задачу, получили денежку и пропивают ее. ;)

Куличики я тоже умею лепить ;)

Точно читал?

Дык читал :) Там, кстати, нет намёка на то что Ring, в общем-то, более глобальный тип чем List. Сначала написал так и мне не понравилось - поэтому и спрашиваю всё это. Теперь сделал так:

-- Doubly Linked Circular Lists, a.k.a. Rings
--
--    (a, 0) <-> (b, 0)
--     /            \
--  (f, 6)        (c, 0)
--    \             /
--    (e, 0) <-> (d, 0)
module Data.Ring where

-- We say that index of the non last element is 0,
-- and index of the last elements is ring's length.
-- It also makes `r_length' is O(1).
type Index = Int

-- Ring ADT
data Ring a = Ring (Ring a) (a, Index) (Ring a) deriving (Eq, Ord)

-- Ring L/R algebras
type RingRAlgebra a b = (b -> a -> b, b)
type RingLAlgebra a b = (a -> b -> b, b)

-- Simple accessors, all is O(1)

element :: Ring a -> a
element (Ring _ (a, _) _) = a

left :: Ring a -> Ring a
left (Ring l _ _) = l

rigth :: Ring a -> Ring a
rigth (Ring _ _ r) = r

index :: Ring a -> Index
index (Ring _ (_, i) _) = i

r_head   = element
r_tail   = rigth
r_second = element . rigth
r_last   = element . left
r_length = index   . left

-- Cata, O(N)

ringataR :: RingRAlgebra a b -> Ring a -> b
ringataR (f, b) ring = go b ring
                     where go b (Ring l (x, 0) r) = go (f b x) r
                           go b (Ring l (x, _) r) = b

ringataL :: RingLAlgebra a b -> Ring a -> b
ringataL (f, b) ring = go b ring
                     where go b (Ring l (x, 0) r) = go (f x b) l
                           go b (Ring l (x, _) r) = b

-- and init, map, ++, reverse, scan, and, or, sum, product, etc. throu ringata.

-- Ring -> List
-- Ringata?
takeL :: Integer -> Ring a -> [(a,Index)]
takeL 0     _               = []
takeL (n+1) (Ring _ (x, i) r) = (x,i) : (takeL n r)

takeR :: Show a => Integer -> Ring a -> [(a,Index)]
takeR 0     _               = []
takeR (n+1) (Ring l (x, i) _) = (x,i) : (takeR n l)

-- List -> Ring
-- Fold?
tag :: [a] -> [(a, Int)]
tag xs = tag' xs
       where tag' (x:[]) = [(x, length xs)]
             tag' (x:xs) = [(x, 0)] ++ (tag' xs)

rot :: Int -> [(a, Int)] -> [(a, Int)]
rot n xs | n < 0  = rot (n+1) ((last xs):(init xs))
         | n == 0 = xs
         | n > 0  = rot (n-1) (tail xs ++ [head xs])

ring :: [a] -> Ring a
ring [] = error "Must have at least one element."
ring xs = _ring (tag xs)
        where _ring :: [(a, Int)] -> Ring a
              _ring xs' = Ring (_ring $ rot (-1) xs') (fst (head xs'), snd (head xs')) (_ring $ rot 1 xs')

-- test (1)

l = Ring r (0,0) r
r = Ring l (1,2) l

{-
  takeL 4 l
  => [(0,0),(1,2),(0,0),(1,2)]

  r_length l
  => 2
-}

-- test (2)

a = Ring c (0,0) b
b = Ring a (1,0) c
c = Ring b (2,3) a

{-
  takeL 10 a
  => [(0,0),(1,0),(2,3),(0,0),(1,0),(2,3),(0,0),(1,0),(2,3),(0,0)]

  r_length a
  => 3

  r_last a
  => 2
-}

-- test (3)

{-
  takeL 10 (ring [1,2,3])
  => [(1,0),(2,0),(3,3),(1,0),(2,0),(3,3),(1,0),(2,0),(3,3),(1,0)]

  takeR 10 (ring [1,2,3])
  => [(1,0),(3,3),(2,0),(1,0),(3,3),(2,0),(1,0),(3,3),(2,0),(1,0)]

  r_last (ring [1,2,3,4,5])
  => 5
-}

И тут даже всё вполне соответствует ожиданиям :) Правда, можно придраться - почему take не через ringata, а ring не через fold, но это уже мелочи.

А, ну ещё остался доступ к n-ому элементу за O(n) (можно ведь сделать константным). И прочие штуки нужно добавить по образу тех что в List (zipper хотя бы).

З.Ы. «он» явно мучает пользователя типами :) Пока поймешь - а что ему надо... (конкуренты уже во всю обскачут)).

Ужыс, ужыс... Всё-таки LISt Processing в этом плане проще ;)

(let ((a '#1=(1 2 3 . #1#)))
  (loop for i in a
     repeat 10
     collect i))

=> (1 2 3 1 2 3 1 2 3 1)

Но это ведь односвязный!

Но это ведь односвязный!

Да, «родные» списки в Коммон Лиспе - одоносвязные.

Вроде как хаскель никогда не назывался DLLISP.

Ужыс, ужыс... Всё-таки LISt Processing в этом плане проще ;)

Ничего ужасного.

Prelude> let a = cycle [1, 2, 3]
Prelude> take 10 a
[1,2,3,1,2,3,1,2,3,1]

Ничего ужасного.

Тоже круто. Только циркулярный список - это частный случай применения #n= и #n#.

Ждём Куку с кратким и элегантным решением на крестах.

Ужыс, ужыс...

Ну это как посмотреть :) Версию на CL я не закончил, но там тоже тот ещё ужас:

;;;
;;; Doubly Linked Circular Lists, a.k.a Rings
;;;
;;;    (a, 0) <-> (b, 0)
;;;     /            \
;;;  (f, 6)        (c, 0)
;;;    \             /
;;;    (e, 0) <-> (d, 0)
;;;

(defpackage #:rings
  (:use     #:common-lisp
            #+sbcl #:sb-alien
            #+sbcl #:sb-c)
  (:shadow  #:second
            #:last
            #:length)
  (:export  #:index
            #:dlist
            #:dcons
            #:element
            #:left
            #:rigth
            #:index
            #:head
            #:tail
            #:second
            #:last
            #:length
            #:fold-rigth
            #:fold-left
            #:take-left
            #:take-rigth
            #:ring))

(in-package #:rings)

;;; For debug circular structures

;#+debug
(setf *print-circle* t)

;;; DCONS structure and types

(deftype index () `(integer 0 ,(expt 2 32)))
(deftype dlist () '(or null dcons))

;; We say that index of the non last element is 0, 
;; and index of the last elements is ring's length. 
;; It also makes `length' is O(1). 

(declaim (inline dcons-element dcons-left dcons-rigth))
(defstruct (dcons
            (:constructor dcons (element left rigth &optional (index 0)))
            (:print-function print-dcons))
  element
  (index 0  :type  index)
  (left  nil :type dlist)
  (rigth nil :type dlist))

;;; Accessors, O(1)

(declaim (ftype (function (dlist) (or t null))     element head second last)
         (ftype (function (dlist) index) index length)
         (ftype (function (dlist) dlist) left rigth tail))

(defun element (dlist) (when dlist (dcons-element dlist)))
(defun left    (dlist) (when dlist (dcons-left    dlist)))
(defun rigth   (dlist) (when dlist (dcons-rigth   dlist)))
(defun index   (dlist) (if dlist (dcons-index dlist) 0))

(defun head    (dlist) (when dlist (element dlist)))
(defun tail    (dlist) (when dlist (rigth   dlist)))
(defun second  (dlist) (when dlist (head (tail dlist))))
(defun last    (dlist) (when dlist (head (left dlist))))
(defun length  (dlist) (if dlist (index (left dlist)) 0))

;;; Folders, O(N)

(declaim (ftype (function (function t dlist) t) fold-rigth fold-left))

(defun fold-rigth (f b dlist)
  (when dlist
    (if (zerop (index dlist))
        (fold-rigth f (funcall f b (element dlist)) (rigth dlist))
        b)))

(defun fold-left (f b dlist)
  (when dlist
    (if (zerop (index dlist))
        (fold-rigth f (funcall f (element dlist) b) (rigth dlist))
        b)))

;;; dlist -> list

(declaim (ftype (function (index dlist) list) take-left take-rigth))

(defun take-left (n dlist)
  (when dlist
    (if (= n 0)
        nil
        (cons (dcons-element dlist) (take-left (1- n) (dcons-left dlist))))))

(defun take-rigth (n dlist)
  (when dlist
    (if (= n 0)
        nil
        (cons (dcons-element dlist) (take-left (1- n) (dcons-rigth dlist))))))

;;; printer

(defun print-dcons (dcons stream depth)
  (declare (ignore depth))
  (format stream "<~A>" (take-rigth (length dcons) dcons)))

;;; list -> dlist
;;; I don't finish this! Not work!

(declaim (ftype (function (list) dlist) ring))

(defun ring (list)
  (when list
    (let* ((initial-value (dcons (first list) nil nil))
           (result (reduce #'(lambda (rest e)
                               (let* ((n (dcons e nil nil)))
                                 (setf (dcons-rigth rest) n)
                                 (setf (dcons-left  n)    rest)
                                 n))
                           list
                           :initial-value initial-value)))
      (setf (dcons-rigth result) initial-value)
      (setf (dcons-index result) (cl:length list))
      result))

;;; or:

#+sbcl
(progn
  (define-alien-type nil
      (struct ring
              (element (* t))
              (rigth   (* t))
              (left    (* t))))

  (defun element (ring) (slot ring 'element))
  (defun rigth   (ring) (slot ring 'rigth))
  (defun left    (ring) (slot ring 'left))

  (defun (setf element) (ring value) (setf (slot ring 'element) value))
  (defun (setf rigth)   (ring value) (setf (slot ring 'rigth) value))
  (defun (setf left)    (ring value) (setf (slot ring 'left) value))

  (defun ring (left element rigth)
    (let ((ring (make-alien (struct ring))))
      (setf (slot ring 'rigth)   rigth
            (slot ring 'element) element
            (slot ring 'left)    left)
      ring))

  (defknown (element rigth left ring)
      (ring t)
      t
      (unsafe)
    :destroyed-constant-args (sb-c::nth-constant-args 1))

  (sb-vm::define-primitive-object (ring :lowtag list-pointer-lowtag :alloc-trans ring)
    (element :ref-trans element :set-trans element :init :arg)
    (rigth   :ref-trans rigth   :set-trans rigth   :init :arg)
    (left    :ref-trans left    :set-trans left    :init :arg))

  ;; now we can go to runtime/gencgc.c for improving Garbage Collector
  ;; and then try to rebuild SBCL. See also objdef.lisp.
)

;;; by the way

;; #1=(dcons 1 0 #2=(dcons 2 0 #3=(dcons 3 3 #1# #2#) #1#) #3#)
;; Welcome to LDB

'#1=(1 2 3 . #1#)

А на таких списках большинство списочных функций работать не будет (типа length и reverse) как и на хаскельных cycle.