## Self-Organizing Lists

### November 6, 2015

The hardest part of this problem is plumbing: since the list may change each time it is touched, all of the functions must return the list as well as their result. We use a box, as defined in the Standard Prelude, to pass arguments by reference instead of by value:

```(define (box v) (vector v))
(define (unbox box) (vector-ref box 0))
(define (box! box v) (vector-set! box 0 v))```

Our first function creates an empty set:

`(define (set-create) (box (list)))`

Searching runs through the set front to back, moving the sought item to the front if it exists in the set; it returns #t if the item is in the set and #f otherwise:

```(define (set-member? x xs)
(let loop ((front (list)) (back (unbox xs)))
(cond ((null? back) #f)
((equal? x (car back))
(box! xs (append (list (car back))
(reverse front)
(cdr back)))
#t)
(else (loop (cons (car back) front)
(cdr back))))))```

Insertion adds an element to the front of a set if it isn’t already in the set, or moves the element to the front of the set if it is already in the set, returning the set in either case:

```(define (set-insert! x xs)
(if (not (set-member? x xs))
(box! xs (cons x (unbox xs))))
xs)```

The last requirement is a delete function, which removes the item from the set if it is present, then returns the set:

```(define (set-delete! x xs)
(if (set-member? x xs)
(box! xs (cdr (unbox xs))))
xs)```

Here are some examples. Note that the order of the items in the set changes after the search:

```> (define xs (set-create))
> (set-insert! 1 xs)
#((1))
> (set-insert! 2 xs)
#((2 1))
> (set-insert! 3 xs)
#((3 2 1))
> (set-member? 1 xs)
#t
> xs
#((1 3 2))
> (set-delete! 2 xs)
#((1 3))
> (set-delete! 1 xs)
#((3))
> (set-delete! 3 xs)
#(())
> (set-member? 1 xs)
#f```

You can run the program at http://ideone.com/Frl4eF.

Pages: 1 2

### 5 Responses to “Self-Organizing Lists”

1. Informatimago said
```

#|

There is no list ADT in lisp, so it's not possible to mutate a list in
general (it's not possible to transform the symbol NIL which
represents the empty list into a CONS cell, or vice-versa,  a CONS
cell into the NIL symbol!).  We have two solutions to deal with
the mutation of list arguments:

1- introduce an ADT (eg. wrap the list in a structure),

2- use macros for the operations that can "mutate" a list into an
empty list or vice-versa.

Since the option 1 is exemplified in the scheme solution, I'll
implement option 2.

INSERTF element list                                                Macro

Inserts the ELEMENT into the place LIST, at the head.
(This expands merely to a PUSH macro call).

DELETEF element list &key test key ...                              Macro

Deletes the ELEMENT from the place LIST.
(We use the obvious definition with all the &key arguments to the
DELETE function)

SOL-FIND element list &key test key                                 Function

Finds the designated ELEMENT in the LIST and returns it, while
moving it into the first position of the LIST.  The LIST is
mutated.  If the ELEMENT is found, a second value T is returned,
otherwise two NIL values are returned.

Since this operation doesn't change the NULL status of the LIST
argument, it can be implemented as a function mutating the LIST.
The trick  is to keep the first CONS cell of the LIST in place,
and to swap its CAR with the element found.

list                 prev
|                   |
v                   v
[a|*]-->[b|*]--> …  [p|*]-->[x|*]-->[s|*]-->

+-----------+
|           |
|           v
[a|*]-+ [b|*]--> …  [p|*]-+ [x|*]-+ [s|*]-->
|   ^                  ^    |
|   |                  |    |
+---|------------------+    |
+-----------------------+

|#

(defun sol-find (element list &key (test 'eql) (key 'identity))
(if list
(values (loop
:for prev :on (cons nil list)
:when (and (cdr prev) (funcall test element (funcall key (cadr prev))))
:do (unless (eq (cdr prev) list)
(rotatef (cddr prev) (cdr list) (cdr prev))
(return (car list))
:finally (return nil))
t)
(values nil nil)))

(defmacro insertf (list element)
`(push ,element ,list))

;; We use define-modify-macro to define the DELETEF macro.
;; However, define-modify-macro expects that the modified place be the
;; first argument, so we have to swap the two first arguments of the
;; DELETE function:
(declaim (inline delete/swapped-arguments))
(defun delete/swapped-arguments (sequence item &rest keyword-arguments)
(apply #'delete item sequence keyword-arguments))
(define-modify-macro deletef (item &rest remove-keywords)
delete/swapped-arguments
"Modify-macro for DELETE. Sets place designated by the first argument to
the result of calling DELETE with ITEM, place, and the REMOVE-KEYWORDS.")

#|

(let ((list (list 1 2 3 4 5 6)))
(values (sol-find 16 list :test (function =) :key (lambda (x) (* x x)))
list))
--> 4
(4 1 2 3 5 6)

(let ((list (list 1 2 3 4 5 6)))
(values (sol-find 6 list)
list))
--> 6
(6 1 2 3 4 5)

(let ((list (list 1 2 3 4 5 6)))
(values (sol-find 1 list)
list))
--> 1
(1 2 3 4 5 6)

(let ((list nil))
(insertf list 5)
(insertf list 4)
(insertf list 3)
(insertf list 2)
(insertf list 1)
(print list)
(sol-find 3 list)
(print list)
(deletef list 2)
(print list)
(sol-find 5 list)
(print list))

prints:
(1 2 3 4 5)
(3 1 2 4 5)
(3 1 4 5)
(5 3 1 4)

--> (5 3 1 4)

|#

```
2. mcmillhj said

Standard ML implementation that returns a new set for every operation, so it is not very efficient but it was interesting to write with the supplied properties.

```datatype 'a set = Nil | Cons of 'a * 'a set
exception EmptySet

fun merge s1 s2 = let
fun merge' Nil s = s
| merge' s Nil = s
| merge' (Cons(h,Nil)) s = Cons(h, s)
| merge' (Cons(h,t))   s = merge' t (Cons(h, s))
in
merge' s1 s2
end

fun reverse s = let
fun reverse' Nil acc = acc
| reverse' (Cons(h,t)) acc = reverse' t (Cons(h,acc))
in
reverse' s Nil
end

fun add s e = let
fun add' Nil e = Cons(e, Nil)
| add' (Cons(h,Nil)) e = if h = e then s else merge (reverse s) (Cons(e,Nil))
| add' (Cons(h,t))   e = if h = e then s else add' t e
in
end

fun remove s e = let
fun remove' Nil e acc = raise EmptySet
| remove' (Cons(h,Nil)) e acc = if h = e then reverse acc else s
| remove' (Cons(h,t))   e acc = if h = e then merge acc t else remove' t e (Cons(h,acc))
in
remove' s e Nil
end

fun search s e = let
fun search' Nil e acc = raise EmptySet
| search' (Cons(h,Nil)) e acc = if h = e then Cons(h, (reverse acc)) else s
| search' (Cons(h,t))   e acc = if h = e then Cons(h, (merge acc t)) else search' t e (Cons(h,acc))
in
search' s e Nil
end

val int_set = Cons (5, Cons (6, Cons (7, Cons (8, Cons (9, Nil)))))
(* adds to back of set:
val it = Cons (5, Cons (6, Cons (7, Cons (8, Cons (9, Cons (10, Nil)))))) : int set

operations can be chained:
> remove (add int_set 10) 10;
val it = Cons (5, Cons (6, Cons (7, Cons (8, Cons (9, Nil))))) : int set

searching moves elements to the front of the set:
> search (search int_set 9) 8;
val it = Cons (8, Cons (9, Cons (5, Cons (6, Cons (7, Nil))))) : int set

removing does not modify positions of set elements:
> remove int_set 7;
val it = Cons (5, Cons (6, Cons (8, Cons (9, Nil)))) : int set
```
3. matthew said

Here’s a cute solution using C++ references to ensure in-place updates – since we can’t assign to reference variables it’s nice to use recursion & rely on modern compilers to turn the tail calls into a loop. It’s easier to think about if we have separate operations to remove a node from a list, and to put one in. There is something appealing about code like this, that looks functional but is, in fact, deeply imperative.

```#include <iostream>

typedef int T;
struct List {
List(T v) : value(v), next(NULL) {}
T value;
List *next;
};

List *insert(List *&p, List *q) {
q->next = p; p = q;
return p;
}

List *remove(List *&p) {
List *t = p; p = p->next;
return t;
}

List *lookup(List *&head, List *&p, T value) {
if (p == NULL) return NULL;
else if (p->value == value) return insert(head,remove(p));
}

List *lookup(List *&head, T value) {
if (head == NULL) return NULL;
}

List *insert(List *&head, int n) {
}

void print(List *p) {
while(p) {
std::cout << p->value << " ";
p = p->next;
}
std::cout << "\n";
}

int main() {
}
```
4. fisherro said

My first attempt was an exercise in creating my own linked list using std::unique_ptr to handle the memory allocations/deallocations.

```#include <memory>
#include <iostream>

template<typename T>
class List {
public:
{
auto node = std::make_unique<Node>();
node->t = t;
}

bool contains(T t)
{
Node* parent = nullptr;
while (node) {
if (t == node->t) {
if (parent) {
//Move node to front.
//If List->n1->n2->n3->0; n2 is node; n1 is the parent.
std::unique_ptr<Node> node_ = std::move(parent->next);
//Now: List->n1->0; n2->n3->0
parent->next = std::move(node->next);
//Now: List->n1->n3->0; n2->0
//Now: List->0; n2->n1->n3->0
//Now: List->n2->n1->n3->0
}
return true;
}
parent = node;
node = node->next.get();
}
return false;
}

void dump(std::ostream& out = std::cout) const
{
out << "List->";
while (node) {
out << node->t << "->";
node = node->next.get();
}
out << "null\n";
}

private:
struct Node {
T t;
std::unique_ptr<Node> next;
};

};

int main()
{
List<int> list;
for (int n = 5; n > 0; --n) list.add(n);
list.dump();
list.contains(4);
list.dump();
}
```
5. fisherro said

My second attempt uses std::forward_list. At first, I thought no standard algorithms would help with List::contains. (At least not without being less efficient.) Then I noticed std::adjacent_find could do the job. I don’t think I’m abusing it here.

```#include <memory>
#include <iostream>
#include <forward_list>

template<typename T>
class List {
public:
void add(T t) { list.push_front(t); }

bool contains(T t)
{
if (list.front() == t) return true;
[t](auto a, auto b) {
return b == t;
});
if (list.end() == i) return false;
list.erase_after(i);
list.push_front(t);
return true;
}

void dump(std::ostream& out = std::cout) const
{
out << "List->";
std::copy(list.begin(), list.end(),
std::ostream_iterator<T>(std::cout, "->"));
out << "null\n";
}

private:
std::forward_list<T> list;
};

int main()
{
List<int> list;
for (int n = 5; n > 0; --n) list.add(n);
list.dump();
list.contains(4);
list.dump();
}
```