Priority queue in Racket? - racket

I'm looking for a priority queue in Racket that satisfies the following definition, especially the bit in bold (from Wikipedia):
a priority queue is an abstract data type which is like a regular queue or stack data structure, but where additionally each element has a "priority" associated with it. In a priority queue, an element with high priority is served before an element with low priority. If two elements have the same priority, they are served according to their order in the queue.
What I understand (and indeed want) by this, is that they are served according to the order that they were added to the queue.
I've tried Racket's data/heap but this doesn't maintain the correct ordering if the priorities are the same.
Test code:
#lang racket
(require data/heap)
(define h (make-heap
(λ (p1 p2)
(<= (car p1) (car p2)))))
(define (add! p) (heap-add! h p))
(add! '(1 a))
(add! '(2 b))
(add! '(3 c))
(add! '(3 d))
(add! '(3 e))
(add! '(3 f))
(add! '(3 g))
(add! '(3 h))
(add! '(3 i))
(for ([p (in-heap h)])
(display p))
Output:
(1 a)(2 b)(3 h)(3 g)(3 f)(3 e)(3 d)(3 c)(3 i)
I need the following output:
(1 a)(2 b)(3 c)(3 d)(3 e)(3 f)(3 g)(3 h)(3 i)

Use the standard heap. Keep a counter i which is incremented for each insertion. To insert an element x into the priority queue insert (list i x) into the heap. Your order predicate can now break ties using i.

Related

Lisp: ordered union of two lists

I am trying to make a function that returns the union of two lists in an ordered manner.
Here is my code:
(defun setunion (lst1 lst2)
(cond
((null lst1) lst2)
((null lst2) lst1)
((member (car lst2) lst1)
(setunion lst1 (cdr lst2)))
(t (append (setunion lst1 (cdr lst2))
(list (car lst2))))))
(print (setunion '(a b c) '(a c d e f a)))
This returns (A B C F E D) but the output I am looking for is (A B C D E F). How can I change my code to return the right output?
Thanks!
EDIT: I figured it out I think. I made a helper function that removes the duplicates of list 2 and reverses it as well as remove the duplicates of list 1.
(defun help (lst1 lst2)
(setunion (remove-duplicates lst1 :from-end t) (reverse(remove-duplicates lst2 :from-end t))))
(print (help '(b c b d) '(a d e a)))
This gives me the output (B C D A E) which is what I'm looking for.
OK, so basically all you want to do is remove duplicates over all lists, and the elements should be in order of first appearance. You could append all lists, then remove duplicates from the end:
(defun set-union (&rest lists)
(remove-duplicates (reduce #'append lists)
:from-end t))
If what you want is the union of a bunch of lists such that elements in the lists occur in the order they occur in the lists, working from the left, then here is one fairly natural way of doing that. I'm not sure if this is what I'd write in real life. It has the advantage that:
it's easy to see what is happening;
it doesn't rely on hairy standard CL functions.
It has the disadvantage that it requires tail-call elimination to work with long lists (and some people regard code which works like this not to be idiomatic CL).
(defun union-preserving-order (&rest ls)
;; Union of a bunch of lists. The result will not contain
;; duplicates (under EQL) and elements will occur in the order they
;; occur in the lists, working from the left to the right. So
;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
;; (union-preserving-order '(a b) '(c b a)), while
;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
;; d).
(upo/loop (first ls) (rest ls) '()))
(defun upo/loop (lt more accum)
;; LT is the list we're working on, MORE is more lists for later,
;; ACCUM is the list we're building (backwards). In real life this
;; would be a local function in UNION-PRESERVING-ORDER.
(if (null lt)
;; Finished this list
(if (null more)
;; no more lists: we're done
(nreverse accum)
;; more lists, so pick the first of them and loop on that
(upo/loop (first more) (rest more) accum))
;; not finished this list, so loop on it
(upo/loop (rest lt) more
;; Either the next element of this list is already in
;; the accumulator, or it's not and we need to add it.
(if (member (first lt) accum)
accum
(cons (first lt) accum)))))
Here's a version which uses explicit iteration but otherwise does the same trick.
(defun union-preserving-order (&rest ls)
;; Union of a bunch of lists. The result will not contain
;; duplicates (under EQL) and elements will occur in the order they
;; occur in the lists, working from the left to the right. So
;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
;; (union-preserving-order '(a b) '(c b a)), while
;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
;; d).
(let ((accum '()))
(dolist (l ls (nreverse accum))
(dolist (e l)
(pushnew e accum)))))
Finally here's a dirty hack which builds the results forwards. Without proof I think this is as good as you can do in terms of performance without resorting to some clever lookup structure like a hash-table to check whether you've seen elements already.
(defun union-preserving-order (&rest ls)
;; Union of a bunch of lists. The result will not contain
;; duplicates (under EQL) and elements will occur in the order they
;; occur in the lists, working from the left to the right. So
;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
;; (union-preserving-order '(a b) '(c b a)), while
;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
;; d).
(let ((results '()) ;results we'll return
(rlc nil)) ;last cons of results
(dolist (l ls results)
(dolist (e l)
(unless (member e results)
(if (not (null rlc))
(setf (cdr rlc) (list e)
rlc (cdr rlc))
(setf rlc (list e)
results rlc)))))))

Racket: Make list of pairs from two lists

I'm trying to make a function that takes in two lists of atoms as a parameter and returns them as a list of pairs.
Example Input
(combine '(1 2 3 4 5) '(a b c d e))
Example Output
'((1 a) (2 b) (3 c) (4 d) (5 e))
However, I'm new to Racket and can't seem to figure out the specific syntax to do so. Here is the program that I have so far:
(define connect
(lambda (a b)
(cond [(> (length(list a)) (length(list b))) (error 'connect"first list too long")]
[(< (length(list a)) (length(list b))) (error 'connect"first list too short")]
[else (cons (cons (car a) (car b)) (connect(cdr a) (cdr b)))]
)))
When I run it, it gives me the error:
car: contract violation
expected: pair?
given: '()
Along with that, I don't believe the error checking here works either, because the program gives me the same error in the else statement when I use lists of different lengths.
Can someone please help? The syntax of cons doesn't make sense to me, and the documentation for Racket didn't help me solve this issue.
When you're new to Scheme, you have to learn to write code in the way recommended for the language. You'll learn this through books, tutorials, etc. In particular, most of the time you want to use built-in procedures; as mentioned in the comments this is how you'd solve the problem in "real life":
(define (zip a b)
(apply map list (list a b)))
Having said that, if you want to solve the problem by explicitly traversing the lists, there are a couple of things to have in mind when coding in Scheme:
We traverse lists using recursion. A recursive procedure needs at least one base case and one or more recursive cases.
A recursive step involves calling the procedure itself, something that's not happening in your solution.
If we needed them, we create new helper procedures.
We never use length to test if we have processed all the elements in the list.
We build new lists using cons, be sure to understand how it works, because we'll recursively call cons to build the output list in our solution.
The syntax of cons is very simple: (cons 'x 'y) just sticks together two things, for example the symbols 'x and 'y. By convention, a list is just a series of nested cons calls where the last element is the empty list. For example: (cons 'x (cons 'y '())) produces the two-element list '(x y)
Following the above recommendations, this is how to write the solution to the problem at hand:
(define (zip a b)
; do all the error checking here before calling the real procedure
(cond
[(> (length a) (length b)) (error 'zip "first list too long")]
[(< (length a) (length b)) (error 'zip "first list too short")]
[else (combine a b)])) ; both lists have the same length
(define (combine a b)
(cond
; base case: we've reached the end of the lists
[(null? a) '()]
; recursive case
[else (cons (list (car a) (car b)) ; zip together one element from each list
(combine (cdr a) (cdr b)))])) ; advance the recursion
It works as expected:
(zip '(1 2 3 4 5) '(a b c d e))
=> '((1 a) (2 b) (3 c) (4 d) (5 e))
The reason your error handling doesn't work is because you are converting your lists to a list with a single element. (list '(1 2 3 4 5)) gives '((1 2 3 4 5)) which length is 1. You need to remove the list.
This post is a good explanation of cons. You can use cons to build a list recursively in your case.
(define connect
(lambda (a b)
(cond [(> (length a) (length b)) (error 'zip "first list too long")]
[(< (length a) (length b)) (error 'zip "first list too short")]
[(empty? a) '()]
[else (cons (list (car a) (car b)) (connect (cdr a) (cdr b)))]
)))
However, I would prefer Sylwester's solution
(define (unzip . lists) (apply map list lists))
which uses Racket's useful apply function.
#lang racket
(define (combine lst1 lst2)
(map list lst1 lst2))
;;; TEST
(combine '() '())
(combine (range 10) (range 10))
(combine (range 9) (range 10))
map have buildin check mechanism. We don't need to write check again.
#lang racket
(define (combine lst1 lst2)
(local [(define L1 (length lst1))
(define L2 (length lst2))]
(cond
[(> L1 L2)
(error 'combine "first list too long")]
[(< L1 L2)
(error 'combine "second list too long")]
[else (map list lst1 lst2)])))

GCD of two numbers using Racket

When I use racket to define a function that find the gcd of two integers,
(define (gcd a b)
(cond
[(> a b) (gcd b a-b)]
[(< a b) (gcd a b-a)]
[else a]))
But,
a-b: unbound identifier in module in: a-b
I don't know what to do.
Why is that happen?
Since Racket doesn't recognize infix operation, changing the operation to a prefix expression works fine :)
(define (gcd a b)
(cond
[(> a b) (gcd b (- a b))]
[(< a b) (gcd a (- b a))]
[else a]))

How do I find the index of an element in a list in Racket?

This is trivial implement of course, but I feel there is certainly something built in to Racket that does this. Am I correct in that intuition, and if so, what is the function?
Strangely, there isn't a built-in procedure in Racket for finding the 0-based index of an element in a list (the opposite procedure does exist, it's called list-ref). However, it's not hard to implement efficiently:
(define (index-of lst ele)
(let loop ((lst lst)
(idx 0))
(cond ((empty? lst) #f)
((equal? (first lst) ele) idx)
(else (loop (rest lst) (add1 idx))))))
But there is a similar procedure in srfi/1, it's called list-index and you can get the desired effect by passing the right parameters:
(require srfi/1)
(list-index (curry equal? 3) '(1 2 3 4 5))
=> 2
(list-index (curry equal? 6) '(1 2 3 4 5))
=> #f
UPDATE
As of Racket 6.7, index-of is now part of the standard library. Enjoy!
Here's a very simple implementation:
(define (index-of l x)
(for/or ([y l] [i (in-naturals)] #:when (equal? x y)) i))
And yes, something like this should be added to the standard library, but it's just a little tricky to do so nobody got there yet.
Note, however, that it's a feature that is very rarely useful -- since lists are usually taken as a sequence that is deconstructed using only the first/rest idiom rather than directly accessing elements. More than that, if you have a use for it and you're a newbie, then my first guess will be that you're misusing lists. Given that, the addition of such a function is likely to trip such newbies by making it more accessible. (But it will still be added, eventually.)
One can also use a built-in function 'member' which gives a sublist starting with the required item or #f if item does not exist in the list. Following compares the lengths of original list and the sublist returned by member:
(define (indexof n l)
(define sl (member n l))
(if sl
(- (length l)
(length sl))
#f))
For many situations, one may want indexes of all occurrences of item in the list. One can get a list of all indexes as follows:
(define (indexes_of1 x l)
(let loop ((l l)
(ol '())
(idx 0))
(cond
[(empty? l) (reverse ol)]
[(equal? (first l) x)
(loop (rest l)
(cons idx ol)
(add1 idx))]
[else
(loop (rest l)
ol
(add1 idx))])))
For/list can also be used for this:
(define (indexes_of2 x l)
(for/list ((i l)
(n (in-naturals))
#:when (equal? i x))
n))
Testing:
(indexes_of1 'a '(a b c a d e a f g))
(indexes_of2 'a '(a b c a d e a f g))
Output:
'(0 3 6)
'(0 3 6)

Can set-car! and set-cdr! be implemented as macros?

Is it possible to implement set-car! and set-cdr! portably as macros using set! in Scheme? Or would this require special access to the underlying storage system?
I'm asking because I'm implementing my own Scheme interpreter, and I'd like to have as much as possible out in scheme code.
My first attempt on set-cdr! was:
(define-syntax set-cdr!
(syntax-rules ()
((set-cdr! location value)
(set! location (cons (car location) value)))))
This mostly works, but not for circular lists:
#; mickey> (define x (list 1 2))
#; mickey> x
(1 2)
#; mickey> (set-cdr! x x)
#; mickey> x
(1 1 2)
Wrapping the macro body in let did not help me either, because when I do (set! (cons (car location) value), then value has already been evaluated to be '(1 2).
In
(set! location (cons (car location) value))
the expression (cons (car location) value) allocates a new pair.
The purpose of set-cdr! is to mutate an existing pair.
So implementing set-cdr! does require "special" access to the underlying storage.
Here is an example of implementing Cons, Car, Cdr, Set-car! and Set-cdr! using closures.
(define (Cons x y)
(lambda (message . val)
(cond
[(eq? message 'car) x]
[(eq? message 'cdr) y]
[(eq? message 'set-car!)
(set! x (car val))]
[(eq? message 'set-cdr!)
(set! y (car val))]
[else 'unknown-message])))
(define (Car pair)
(pair 'car))
(define (Cdr pair)
(pair 'cdr))
(define (Set-cdr! pair val)
(pair 'set-cdr! val))
(define (Set-car! pair val)
(pair 'set-car! val))
(define p (Cons 1 2))
(Car p)
(Cdr p)
(Set-car! p 3)
(Car p)
(Set-cdr! p 4)
(Cdr p)
Basically you can implement set! without set!, but I don't think you can implement set-car!/set-cdr! without either mutating pairs or simulating pairs (like soegaard's example)
Since it seems you're making your Scheme implementation in Scheme I would have used set-car!/set-cdr! to implement it in the interpreter or just not implemented them at all. I would have started with define, if, quote, pair?, eq?, cons, car and cdr (similar to The roots of LISP, but more schemish) to have a base minimum implementation to start with and then enhanced it further.
Anyway.. Your implementation, if you do implement it should be able to do this:
(define odds (list 1 3 5 7 9 11))
(set-car! (cddr odds) #f)
odds
===> (1 3 #f 7 9 11)