Recursion through nested lists in LISP - recursion

I am trying to find the other element in the nested list when querying the first one. Something like this. (findOther 'a '((a b) (b c) (a d)))--> b and d. I have done this so far: The problem is I only get b.
(defun findOther (elem L)
(cond (NIL (null L))
((eq elem (caar L)) (cdar L))
((findOther elem (cdr L)))))

First some comments on the original code:
(defun findOther (elem L)
(cond
;; NIL is always false, so you *never* end up using this
;; case. You probably want something like ((null l) '()),
;; NULL is still pretty common for this, but since you're
;; expecting a list, you could use the slighly more
;; descriptive ENDP.
(NIL (null L))
;; When you find an element, you immediately return its
;; counterpart, and don't collect it and continue on to
;; the rest of the list. It's also easier to read if
;; you use more descriptive names like FIRST and SECOND,
;; as in ((eq elem (first (first l))) (second (first l))).
;; It's worth noting that unless you have a specific reason
;; to use EQ, you might want to use EQL, which is the
;; default comparison in most CL functions.
((eq elem (caar L)) (cdar L))
;; Else, you continue to the rest of the list. In my
;; opinion, REST would be more decriptive than CDR here,
;; but recursing and returning the value *is* what you
;; want to do here.
((findOther elem (cdr L)))))
Taking some of those into consideration, we could do something like this:
(defun others (element list)
(cond
((endp list) '())
((eql element (first (first list)))
(list* (second (first list))
(others element (rest list))))
((others element (rest list)))))
All that said, the functions in the standard library
would make this much easier. E.g. using mapcan:
(defun others (element list)
(mapcan (lambda (sublist)
(when (eql (first sublist) element)
(rest sublist)))
list))
(others 'a '((a b) (b c) (a d)))
;=> (B D)

I am not sure if you are looking for pair of two elements or may be more elements in list as well. Just in case you have more elements and you want all of them as well and also of some of them are not really pairs,
(defun pair-of (elem lis)
(let ((temp nil))
(cond
((and (listp lis) (not (null lis)))
(mapcar
#'(lambda (x)
(cond
((and (listp x) (not (null x)) (eql elem (car x)))
(push (cdr x) temp))))
lis)))
(nreverse temp)))
USAGE:(pair-of 'a '((a b) (b c) (a d w) 1))
OUTPUT: ((B) (D W))
But in case you want them combined in one list,
(reduce #'append (pair-of 'a '((a s) (a 3 8) (2 5 1))):initial-value '())
=> (S 3 8)

Related

Palindrome check with recursion in Lisp

I have developed code to check through input to see if it is a palindrome or not but I am having difficulty figuring out how to print the output. I want the output to return "t" if the input is a palindrome and "nil" if not. Also a challenge that I wanted to give myself was to not use the reverse function so thats why my code is not as simple as it could be. Thanks in advance.
(defun palindromep(l)
(cond ((null l) nil (write nil))
(t (append (list (car l)) (palindromep (cdr l)) (list (car l) )))))
(palindromep '(a b b a))
(terpri)
(palindromep '(a b c b a))
(terpri)
(palindromep '(a b c))
(terpri)
(palindromep '(a (d e) (d e) a))
(terpri)
(palindromep '(a (d e) (e d) a))
Firstly, an empty list is a palindrome! If we reverse it, we get the same empty list.
Secondly, Lisp functions don't print their result values; they return these values.
In an interactive session, it is the listener which prints the resulting value(s) that emerge from the expression being evaluated. That expression itself doesn't have to print anything.
Therefore, we begin like this:
(defun palindromep (l)
(cond
((null l) t) ;; the empty list is a palindrome: yield true.
Note, by the way, that if we write this:
((null l) nil t) ;; the empty list is a palindrome: yield true.
that doesn't do anything. The extra nil expression is evaluated, producing nil, which is thrown away. The Lisp compiler will completely eliminate that.
What if the list is not a list at all, but an atom other than nil? Let's just go with that being a palindrome. A clarification of requirements is needed, though:
((atom l) t)
Now we know we are dealing with a non-empty list. If it has exactly one item, then it is a palindrome:
((null (cdr l)) t)
Now we know we are dealing with a list of two or more items. That is a palindrome if the first and last items are the same, and if the items in between them form a palindrome.
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
The whole thing:
(defun palindromep (l)
(cond
((null l) t)
((atom l) t)
((null (cdr l)) t)
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Code golfing: in the cond construct described by ANSI CL, a clause is permitted to have just one form. If that forms yields a true value, then that value is returned. Thus we can remove the t's:
(defun palindromep (l)
(cond
((null l)) ;; t removed
((atom l)) ;; likewise
((null (cdr l))) ;; likewise
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Documentation about the functions ldiff and last can be found here.
Further golfing: if we have this pattern (cond (A) (B) ... (t Z)) we can just replace it by (or A B ... Z):
(defun palindromep (l)
(or (null l)
(atom l)
(let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior)))))
cond is like a generalization of or that can specify an alternative result value for the each terminating true case.
To go on with code-golfing, since t or nil is expected, you can use only or and nil to express conditionals (and using short-circuitry of or and nil expressions).
Also it is good to be able to determine a :test keyword - since you want to control the crucial testing behavior.
To be able to use also inner lists, one could e.g. use equalp or even a custom comparison function.
(defun palindromep (l &key (test #'equalp))
(or (null l) (and (funcall test (car l) (car (last l)))
(palindromep (butlast (cdr l)) :test test))))
This evaluates
(palindromep '(a (d e) (d e) a))
as t but
(palindromep '(a (d e) (e d) a))
as nil.
Well, it is maybe a philosophical question, whether the latter should be t and the former nil.
To revert that behavior, we could write a custom testing function.
Like this:
(defun reverse* (l &optional (acc '()))
(cond ((null l) acc)
((atom (car l)) (reverse* (cdr l) (cons (car l) acc)))
(t (reverse* (cdr l) (cons (reverse* (car l) '()) acc)))))
(defun to-each-other-symmetric-p (a b)
(cond ((and (atom a) (atom b)) (equalp a b))
(t (equalp a (reverse* b)))))
Well, I use here some kind of a reverse*.
Then if one does:
(palindromep '(a (d e) (d e) a) :test #'to-each-other-symmetric-p) ;; NIL
;; and
(palindromep '(a (d e) (e d) a) :test #'to-each-other-symmetric-p) ;; T
Just to complete the other answers, I would like to point out that not using reverse will not only complicate your code enormously, but also make it far more inefficient. Just compare the above answers with the classic one:
(defun palindromep (l)
(equal l (reverse l)))
reverse is o(l), i.e. it takes time proportional to the length of the list l, and so does equal. So this function will run in o(l). You can't get faster than this.

Searching for an element within lists of lists without MAPCAR

I attempted a question of making a program that replaces all instances of an element A within a list L with T and unlike elements with NIL. The bet is to not use mapcar.
Here is what I did earlier. I am storing all T and NIL in a new list POS then returning POS.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Current behaviour:
The program is working nicely, except when searching for NIL itself, but that special case is not of concern here.
Few example runs of my code:-
(SRC 'g '(a g g o t g))
> (nil t t nil nil t)
When searching for NIL in a list:-
(SRC nil '(t a t nil nil))
> (nil nil nil t)
In this singular case our program ends on finding the first NIL in the list, for other searches, the program works fine. So I tried adding the ability of searching within lists of lists.
My updated code for searching within lists of lists without mapcar:
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((LISTP (CAR L))
(APPEND POS (LIST (SRC A (CAR L)))))
((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Now, the output that I expect from this code is as follows:
(SRC 'e '(a b e c (e g e) h t e))
> (nil nil t nil (t nil t) nil nil t)
Instead my code runs forever, causing stack overflow, and I could not figure out anything with callstacks or backtracking.
Unreadable code due to lack of indentation.
Your code is unreadable, because your code is not indented.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL)) (_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL) (APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Let's indent your code.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Style and basic mistakes
Basic mistakes or programming style problems:
defun should not be nested. defun is not for defining local functions. defun should only be used for global functions. Use flet or labels for local functions.
use first and rest instead of car and cdr
use speaking variables
use lowercase
Don't start with nested functions
I would start without nested functions.
(defun _src (element list pos)
(cond ((not (equal (first list) nil))
(_src a (rest list) (append pos (list (equal element (car list))))))
((equal (first list) nil)
(append pos (list (equal element nil))))
(t pos)))
(defun src (element list)
(cdr (_src element list (list nil))))
Simplify recursion
But then you can greatly simplify it using the usual recursive pattern:
(defun mark% (element list result)
(if (null list)
result ; empty list -> return result
(mark% element ; mark the rest of the list
(rest list)
(cons (equal element (first list)) ; equal for the first element?
result))))
(defun mark (element list)
"return a list with boolean values if element is found in the list"
(reverse (mark% element list nil))) : needs to reverse the result
Note
Generally don't program recursive functions like that, since Lisp actually already offers MAP and MAPCAR - those provide the mapping functionality in one place and it is not needed to bake the recursive mapping into each function of your own.
Preferably use higher level iteration facilities like LOOP:
CL-USER 13 > (loop for e in '(a b a b)
collect (equal 'a e))
(T NIL T NIL)
Nested lists
You can adapt the above function to nested lists by adding a case testing for the first element being a list and then doing something in that case...
(defun mark% (element list result)
(cond ((null list)
result)
((consp (first list))
(mark% element
(rest list)
(cons (mark element (first list))
result)))
(t
(mark% element
(rest list)
(cons (equal element (first list))
result)))))
Debugging
Use trace and/or step to see what your code is doing.

Recursive function to calculate the powerset of a set [duplicate]

I'm using the beginning language with list abbreviations for DrRacket and want to make a powerset recursively but cannot figure out how to do it. I currently have this much
(define
(powerset aL)
(cond
[(empty? aL) (list)]
any help would be good.
What's in a powerset? A set's subsets!
An empty set is any set's subset,
so powerset of empty set's not empty.
Its (only) element it is an empty set:
(define
(powerset aL)
(cond
[(empty? aL) (list empty)]
[else
As for non-empty sets, there is a choice,
for each set's element, whether to be
or not to be included in subset
which is a member of a powerset.
We thus include both choices when combining
first element with smaller powerset,
that, which we get recursively applying
the same procedure to the rest of input:
(combine (first aL)
(powerset (rest aL)))]))
(define
(combine a r) ; `r` for Recursive Result
(cond
[(empty? r) empty] ; nothing to combine `a` with
[else
(cons (cons a (first r)) ; Both add `a` and
(cons (first r) ; don't add, to first subset in `r`
(combine ; and do the same
a ; with
(rest r))))])) ; the rest of `r`
"There are no answers, only choices". Rather,
the choices made, are what the answer's made of.
In Racket,
#lang racket
(define (power-set xs)
(cond
[(empty? xs) (list empty)] ; the empty set has only empty as subset
[(cons? xs) (define x (first xs)) ; a constructed list has a first element
(define ys (rest xs)) ; and a list of the remaining elements
;; There are two types of subsets of xs, thouse that
;; contain x and those without x.
(define with-out-x ; the power sets without x
(power-set ys))
(define with-x ; to get the power sets with x we
(cons-all x with-out-x)) ; we add x to the power sets without x
(append with-out-x with-x)])) ; Now both kind of subsets are returned.
(define (cons-all x xss)
; xss is a list of lists
; cons x onto all the lists in xss
(cond
[(empty? xss) empty]
[(cons? xss) (cons (cons x (first xss)) ; cons x to the first sublist
(cons-all x (rest xss)))])) ; and to the rest of the sublists
To test:
(power-set '(a b c))
Here's yet another implementation, after a couple of tests it appears to be faster than Chris' answer for larger lists. It was tested using standard Racket:
(define (powerset aL)
(if (empty? aL)
'(())
(let ((rst (powerset (rest aL))))
(append (map (lambda (x) (cons (first aL) x))
rst)
rst))))
Here's my implementation of power set (though I only tested it using standard Racket language, not Beginning Student):
(define (powerset lst)
(if (null? lst)
'(())
(append-map (lambda (x)
(list x (cons (car lst) x)))
(powerset (cdr lst)))))
(Thanks to samth for reminding me that flatmap is called append-map in Racket!)
You can just use side effect:
(define res '())
(define
(pow raw leaf)
(cond
[(empty? raw) (set! res (cons leaf res))
res]
[else (pow (cdr raw) leaf)
(pow (cdr raw) (cons (car raw) leaf))]))
(pow '(1 2 3) '())

Recursively splitting a list into two using LISP

Using LISP, i need to create a function that splits a list into two lists. The first list consists of 1st, 3rd, 5th, 7th, etc elements and the second list consists of 2nd, 4th, 6th, etc elements.
Output Examples:
(SPLIT-LIST ( )) => (NIL NIL)
(SPLIT-LIST '(A B C D 1 2 3 4 5)) => ((A C 1 3 5) (B D 2 4))
(SPLIT-LIST '(B C D 1 2 3 4 5)) => ((B D 2 4) (C 1 3 5))
(SPLIT-LIST '(A)) => ((A) NIL)
The function need to be recursive.
This is my code so far.
(defun SPLIT-LIST (L)
(cond
((null L) NIL)
((= 1 (length L)) (list (car L)))
(t (cons (cons (car L) (SPLIT-LIST (cddr L))) (cadr L)))))
);cond
);defun
i'm going to try to use flatten later on so that i end up w/ two lists, but for now, i just can't seem to get the sequence correctly.
MY CODE:
> (SPLIT-LIST '(1 2 3 4))
((1 (3) . 4) . 2)
I just can't seem to make the code print 1 3 2 4 instead of 1 3 4 2.
> (SPLIT-LIST '(1 2 3 4 5 6))
((1 (3 (5) . 6) . 4) . 2)
I can't make the second half of the expected output to print in the correct sequence.
Your code
We typically read Lisp code by indentation, and don't write in all-caps. Since we read by indentation, we don't need to put closing parens (or any parens, really) on their own line. Your code, properly formatted, then, is:
(defun split-list (l)
(cond
((null l) '())
((= 1 (length l)) (list (car l)))
(t (cons (cons (car l)
(split-list (cddr l)))
(cadr l)))))
Getting the base cases right
Split-list is always supposed to return a list of two lists. We should cover those base cases first. When l is empty, then there's nothing in the left list or the right, so we can simply return '(() ()). Then first condition then becomes:
((null l) '(() ())) ; or ((endp l) '(() ()))
Judging by your second case, I gather that you want the second and third cases to be: (i) if there's only one element left, it must be an odd-numbered one, and belongs in the left result; (ii) otherwise, there are at least two elements left, and we can add one to each. Then the second condition should be
((= 1 (length l)) (list (car l) '()))
It's actually kind of expensive to check the length of l at each step. You only care whether there is only one element left. You already know that l isn't empty (from the first case), so you can just check whether the rest oflis the empty list. I find it more readable to usefirstandrest` when working with cons cells as lists, so I'd write the second clause as:
((endp (rest l)) (list (list (first l)) '()))
Handling the recursive case
Now, your final case is where there are at least two elements. That means that l looks like (x y . zs). What you need to do is call split-list on zs to get some result of the form (odd-zs even-zs), and then take it apart and construct ((x . odd-zs) (y . even-zs)). That would look something like this:
(t (let ((split-rest (split-list (rest (rest l)))))
(list (list* (first l) (first split-rest))
(list* (second l) (second split-rest)))))
There are actually some ways you can clean that up. We can use destructuring-bind to pull odd-zs and even-zs out at the same time. Since this is the last clause of the cond, and a clause returns the value of the test if there are no body forms, we don't need the initial t. The last clause can be:
((destructuring-bind (odd-zs even-zs) ; *
(split-list (rest (rest l)))
(list (list* (first l) odd-zs)
(list* (second l) even-zs))))))
*I omitted the t test because if a cond clause has no body forms, then the value of the test is returned. That works just fine here.
Putting that all together, we've reworked your code into
(defun split-list (l)
(cond
((endp l) '(() ()))
((endp (rest l)) (list (list (first l)) '()))
((destructuring-bind (odd-zs even-zs)
(split-list (rest (rest l)))
(list (list* (first l) odd-zs)
(list* (second l) even-zs))))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
Other approaches
I think it's worth exploring some approaches that are tail recursive, as an implementation that supports tail call optimization can convert them to loops. Tail recursive functions in Common Lisp are also typically easy to translate into do loops, which are much more likely to be implemented as iteration. In these solutions, we'll build up the result lists in reverse, and then reverse them when it's time to return them.
Recursing one element at a time
If the left and right slices are interchangeable
If it doesn't matter which of the two lists is first, you can use something like this:
(defun split-list (list &optional (odds '()) (evens '()))
(if (endp list)
(list (nreverse odds)
(nreverse evens))
(split-list (rest list)
evens
(list* (first list) odds))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((B D 2) (A C 1 3))
This can actually be written very concisely using a do loop, but that's typically seen as iterative, not recursive:
(defun split-list (list)
(do ((list list (rest list))
(odds '() evens)
(evens '() (list* (first list) odds)))
((endp list) (list (nreverse odds) (nreverse evens)))))
If they're not interchangable
If you always need the list containing the first element of the original list to be first, you'll need a little bit more logic. One possibility is:
(defun split-list (list &optional (odds '()) (evens '()) (swap nil))
(if (endp list)
(if swap
(list (nreverse evens)
(nreverse odds))
(list (nreverse odds)
(nreverse evens)))
(split-list (rest list)
evens
(list* (first list) odds)
(not swap))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
I think that (if swap … …) is actually a bit ugly. We can use cond so that we can get multiple forms (or if and progn), and swap the values of odds and evens before returning. I think this is actually a bit easier to read, but if you're aiming for a pure recursive solution (academic assignment?), then you might be avoiding mutation, too, so rotatef wouldn't be available, and using a when just to get some side effects would probably be frowned upon.
(defun split-list (list &optional (odds '()) (evens '()) (swap nil))
(cond
((endp list)
(when swap (rotatef odds evens))
(list (nreverse odds) (nreverse evens)))
((split-list (rest list)
evens
(list* (first list) odds)
(not swap)))))
This lends itself to do as well:
(defun split-list (list)
(do ((list list (rest list))
(odds '() evens)
(evens '() (list* (first list) odds))
(swap nil (not swap)))
((endp list)
(when swap (rotatef odds evens))
(list (nreverse odds) (nreverse evens)))))
Recursing two elements at a time
Another more direct approach would recurse down the list by cddr (i.e., (rest (rest …))) and add elements to the left and right sublists on each recursion. We need to be a little careful that we don't accidentally add an extra nil to the right list when there are an odd number of elements in the input, though.
(defun split-list (list &optional (left '()) (right '()))
(if (endp list)
(list (nreverse left)
(nreverse right))
(split-list (rest (rest list))
(list* (first list) left)
(if (endp (rest list))
right
(list* (second list) right)))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
And again, a do version:
(defun split-list (list)
(do ((list list (rest (rest list)))
(left '() (list* (first list) left))
(right '() (if (endp (rest list)) right (list* (second list) right))))
((endp list) (list (nreverse left) (nreverse right)))))
Here's what I've got:
(defun split-list (lst)
(if lst
(if (cddr lst)
(let ((l (split-list (cddr lst))))
(list
(cons (car lst) (car l))
(cons (cadr lst) (cadr l))))
`((,(car lst)) ,(cdr lst)))
'(nil nil)))
After reading SICP I'm rarely confused about recursion.
I highly recommend it.
Here's my take, using an inner function:
(defun split-list (lst)
(labels ((sub (lst lst1 lst2 flip)
(if lst
(if flip
(sub (cdr lst) (cons (car lst) lst1) lst2 (not flip))
(sub (cdr lst) lst1 (cons (car lst) lst2) (not flip)))
(list (reverse lst1) (reverse lst2)))))
(sub lst nil nil t)))
As a Common Lisp LOOP:
(defun split-list (list)
"splits a list into ((0th, 2nd, ...) (1st, 3rd, ...))"
(loop for l = list then (rest (rest l))
until (null l) ; nothing to split
collect (first l) into l1 ; first split result
unless (null (rest l))
collect (second l) into l2 ; second split result
finally (return (list l1 l2))))
With internal tail-recursive function building the lists in top-down manner (no reverses, loop code probably compiles to something equivalent), with a head-sentinel trick (for simplicity).
(defun split-list (lst &aux (lst1 (list 1)) (lst2 (list 2)))
(labels ((sub (lst p1 p2)
(if lst
(progn (rplacd p1 (list (car lst)))
(sub (cdr lst) p2 (cdr p1)))
(list (cdr lst1) (cdr lst2)))))
(sub lst lst1 lst2)))
Flatten is fun to define in Lisp. But I've never had a use for it.
So if you think "I could use flatten to solve this problem" it's probably because you're trying to solve the wrong problem.
(defun split-list (L)
(if (endp L)
'(nil nil)
(let ((X (split-list (cdr L))))
(list (cons (car L) (cadr X)) (car X))
)))

Recursion on list of pairs in Scheme

I have tried many times but I still stuck in this problem, here is my input:
(define *graph*
'((a . 2) (b . 2) (c . 1) (e . 1) (f . 1)))
and I want the output to be like this: ((2 a b) (1 c e f))
Here is my code:
(define group-by-degree
(lambda (out-degree)
(if (null? (car (cdr out-degree)))
'done
(if (equal? (cdr (car out-degree)) (cdr (car (cdr out-degree))))
(list (cdr (car out-degree)) (append (car (car out-degree))))
(group-by-degree (cdr out-degree))))))
Can you please show me what I have done wrong cos the output of my code is (2 a). Then I think the idea of my code is correct.
Please help!!!
A very nice and elegant way to solve this problem, would be to use hash tables to keep track of the pairs found in the list. In this way we only need a single pass over the input list:
(define (group-by-degree lst)
(hash->list
(foldl (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst)))
The result will appear in a different order than the one shown in the question, but nevertheless it's correct:
(group-by-degree *graph*)
=> '((1 f e c) (2 b a))
If the order in the output list is a problem try this instead, it's less efficient than the previous answer, but the output will be identical to the one in the question:
(define (group-by-degree lst)
(reverse
(hash->list
(foldr (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst))))
(group-by-degree *graph*)
=> '((2 a b) (1 c e f))
I don't know why the lambda is necessary; you can directly define a function with (define (function arg1 arg2 ...) ...)
That aside, however, to put it briefly, the problen is that the cars and cdrs are messed up. I couldn't find a way to tweak your solution to work, but here is a working implementation:
; appends first element of pair into a sublist whose first element
; matches the second of the pair
(define (my-append new lst) ; new is a pair
(if (null? lst)
(list (list (cdr new) (car new)))
(if (equal? (car (car lst)) (cdr new))
(list (append (car lst) (list (car new))))
(append (list (car lst)) (my-append new (cdr lst)))
)
)
)
; parses through a list of pairs and appends them into the list
; according to my-append
(define (my-combine ind)
(if (null? ind)
'()
(my-append (car ind) (my-combine (cdr ind))))
)
; just a wrapper for my-combine, which evaluates the list backwards
; this sets the order right
(define (group-by-degree out-degree)
(my-combine (reverse out-degree)))

Resources