Scheme, recursion with list of lists - recursion

I have a little problem with my procedure. This procedure take a list of lists and while his length is bigger then 1 apply a procedure minus that take 2 lists and do difference.its my result to a problem with subsets of sets.
Example what I need:
args=('(1)'(1)'(3))
length != 1 -> procedure (if(null? (minus '(1) '(1))))
-> recursion (sub (cdr args))
args=('(1) '(3))
length !=1 -> procedure (if(null? (minus '(1) '(3)))) -
#f end.
but my program do I dont know what and then return #t...
(define sub
(lambda args
(if(= (length args) 1) #t
(if(null? ( minus (list-ref args 0) (list-ref args 1)))
(sub (cdr args))
#f))))
Fixed :)
(define subsethood
(lambda args
(sub args)
))
(define (sub args)
(if(= (length args) 1) #t
(if(null? ( minus (list-ref args 0) (list-ref args 1)))
(sub (cdr args))
#f)))

From #OndrPem edit, just to be on right place.
(define subsethood
(lambda args
(sub args)
))
(define (sub args)
(if(= (length args) 1) #t
(if(null? ( minus (list-ref args 0) (list-ref args 1)))
(sub (cdr args))
#f)))

Related

Replaces occurrences in a list - Racket

I am writing a function called ptyper that takes a nested list, nl. This function replaces all occurrences of a number with n and all occurrences of a symbol with s. This is what I have now:
(define (ptyper nl) (cond
((null? nl) '())
((list? nl)
(let ((ls (car nl)))
(list (ptyper ls))))
((number? (car nl))
(cons "n" (cdr nl)))
((symbol? (car nl))
(cons "s" (cdr nl)))
(else
(cons (car nl) (cdr nl)))))
I ran this test (ptyper '(2 (abc () "abc"))) but received an error that their was a contract violation. I'm not exactly sure what I'm doing wrong so if could use some help. Thanks!
Here is a possible solution with one function:
(define (ptyper nl)
(cond
((null? nl) '()) ; if the argument is an empty list, return the empty list
((list? nl) ; if the argument is a list, then
(let* ((c (car nl)) ; get its first element
(nc (cond ((number? c) "n") ; transform it for numbers
((symbol? c) "s") ; and symbols
((list? c) (ptyper c)) ; if a list recur over it
(else c)))) ; otherwise (e.g. a string) return as it is
(cons nc (ptyper (cdr nl))))) ; recursive call on the rest of the list
(else nl))) ; this should never happen for the specification,
; return the parameter or cause an error
Note that the error in your case is caused by the recursive call. When the function is called on an atom, for instance 2, first it checks for null and list?, and those checks returns false. Then it checks for (number (car nl)), but nl is equal to 2 and so car fails.
Here is a data definition for an S-expression, this models your data.
; An S-expr is one of:
; – Atom
; – SL
; An SL is one of:
; – '()
; – (cons S-expr SL)
; An Atom is one of:
; – Number
; – String
; – Symbol
We have predicates for every kind of data except Atom, so we make atom?:
;; Any -> Boolean
;; is the x an atom?
(define (atom? x)
(not (list? x)))
We follow the structure of the data to build "templates" for our functions:
(define (func sexp)
(cond
[(atom? sexp) (func-atom sexp)]
[else (func-sl sexp)]))
(define (func-sl sl)
(cond
[(empty? sl) ...]
[else (... (func (first sl)) ... (func-sl (rest sl)) ...)]))
(define (func-atom at)
(cond
[(number? at) ...]
[(string? at) ...]
[(symbol? at) ...]))
We fill in the gaps:
; Atom -> String
(define (subs-atom at)
(cond
[(number? at) "n"]
[(string? at) at]
[(symbol? at) "s"]))
; SL -> SL
(define (subs-sl sl)
(cond
[(empty? sl) sl]
[else (cons (subs-sexp (first sl))
(subs-sexp (rest sl)))]))
; S-exp -> S-exp
(define (subs-sexp sexp)
(cond
[(atom? sexp) (subs-atom sexp)]
[else (subs-sl sexp)]))
Using the interface for ptyper:
(define (ptyper nl)
(subs-sexp nl))
(ptyper '(2 (abc () "abc")))
; => '("n" ("s" () "abc"))

Deadlock in Racket co-routine implementation

As a project to help me understand continuations in Racket, I decided to try and write a co-routine implementation without using mutable or global variables. Here is what I have so far, but it seems to end up in a deadlock of some kind. Am I missing something obvious?
#!/usr/bin/env racket
#lang racket
(define (make-proc-args args)
(let/cc cc
(cons cc args)))
(define (fork proc)
(let ([current (make-proc-args '())])
(proc current)))
(define (yield to args)
(let ([current (make-proc-args args)])
((car to) current)))
(define c
(fork
(lambda (p)
(let loop ([i 0]
[parent p])
(unless (> i 10)
(loop (+ i 1) (yield parent (list i))))))))
(let loop ([child c])
(println (car child))
(loop (yield child '())))
(define (make-proc-args args)
(let/cc cc
(cons cc args)))
This when called returns it's continuation as a object. If you look at this code:
(define (fork proc)
(let ([current (make-proc-args '())])
(proc current)))
The continuation of (make-proc-args '()) is the application of the let with current bound and proc called. In the context of:
(fork
(lambda (p)
(let loop ([i 0]
[parent p])
(unless (> i 10)
(loop (+ i 1) (yield parent (list i)))))))
It means (yield parent (list i)) will time travel back and call and (proc current) will be called again.. The let with start with i and 0.. But one would expect the continuation of the yield to be stored, right? Wrong!
(define (yield to args)
(let ([current (make-proc-args args)])
((car to) current)))
The continuation that is captured is ((car to) current) which happen to be the same again and again and again.
The easiest way to solve this is to make the continuation have not the calling of your stored continuation as it's own continuation. Thus you need to do something like this:
(define (fork proc)
(let/cc cc
(let ([current (cons cc '())])
(proc current))))
(define (yield to args)
(let/cc cc
(let ([current (cons cc args)])
((car to) current))))
Notice that in both of these the continuation is what happens when yield and fork returns naturally and not when the body of a let is finished.
Also know that continuations are delimited at top level so you should perhaps test with all code in a let block to catch bugs you might have since continuations behave differently at top level. The define is not allowed top level, but if you put it in a let you get #<void> as the last value as child because that is the value define forms make, not the pairs you expect.
(define (worker p)
(let loop ([i 0]
[parent p])
(unless (> i 10)
(loop (+ i 1) (yield parent i)))))
(let ((c (fork worker)))
(let loop ([child c])
(when (pair? child)
(println child)
(loop (yield child '())))))
This prints:
(#<continuation> . 0)
(#<continuation> . 1)
(#<continuation> . 2)
(#<continuation> . 3)
(#<continuation> . 4)
(#<continuation> . 5)
(#<continuation> . 6)
(#<continuation> . 7)
(#<continuation> . 8)
(#<continuation> . 9)
(#<continuation> . 10)
As a last tip. Perhaps you should make a struct for your continuation object or at least abstract?

Option type encoding / robustness in Lisp

(define (nth n lst)
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) )))
is an unsafe partial function, n may go out of range. An error can be helpful,
(define (nth n lst)
(if (null? lst)
(error "`nth` out of range")
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) ))))
But what would a robust Scheme analogue to Haskell's Maybe data type look like?
data Maybe a = Nothing | Just a
nth :: Int -> [a] -> Maybe a
nth _ [] = Nothing
nth 1 (x : _) = Just x
nth n (_ : xs) = nth (n - 1) xs
Is just returning '() adequate?
(define (nth n lst)
(if (null? lst) '()
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) ))))
It's easy to break your attempt. Just create a list that contains an empty list:
(define lst '((1 2) () (3 4)))
(nth 2 lst)
-> ()
(nth 100 lst)
-> ()
The key point that you're missing is that Haskell's Maybe doesn't simply return a bare value when it exists, it wraps that value. As you said, Haskell defines Maybe like so:
data Maybe a = Nothing | Just a
NOT like this:
data Maybe a = Nothing | a
The latter is the equivalent of what you're doing.
To get most of the way to a proper Maybe, you can return an empty list if the element does not exist, as you were, but also wrap the return value in another list if the element does exist:
(define (nth n lst)
(if (null? lst) '()
(if (= n 1)
(list (car lst)) ; This is the element, wrap it before returning.
(nth (- n 1)
(cdr lst) ))))
This way, your result will be either an empty list, meaning the element did not exist, or a list with only one element: the element you asked for. Reusing that same list from above, we can distinguish between the empty list and a non-existant element:
(define lst '((1 2) () (3 4)))
(nth 2 lst)
-> (())
(nth 100 lst)
-> ()
Another way to signal, that no matching element was found, would be to use multiple return values:
(define (nth n ls)
(cond
((null? ls) (values #f #f))
((= n 1) (values (car ls) #t))
(else (nth (- n 1) ls))))
This comes at the expense of being a little bit cumbersome for the users of this function, since they now have to do a
(call-with-values (lambda () (nth some-n some-list))
(lambda (element found?)
... whatever ...))
but that can be alleviated by using some careful macrology. R7RS specifies the let-values syntax.
(let-values (((element found?) (nth some-n some-list)))
... whatever ...)
There are several ways to do this.
The direct equivalent would be to mimic the Miranda version:
#!r6rs
(library (sylwester maybe)
(export maybe nothing maybe? nothing?)
(import (rnrs base))
;; private tag
(define tag-maybe (list 'maybe))
;; exported tag and features
(define nothing (list 'nothing))
(define (maybe? v)
(and (pair? v)
(eq? tag-maybe (car v))))
(define (nothing? v)
(and (maybe? v)
(eq? nothing (cdr v))))
(define (maybe v)
(cons tag-maybe v)))
How to use it:
#!r6rs
(import (rnrs) (sylwester maybe))
(define (nth n lst)
(cond ((null? lst) (maybe nothing))
((zero? n) (maybe (car lst)))
(else (nth (- n 1) (cdr lst)))))
(nothing? (nth 2 '()))
; ==> #t
Exceptions
(define (nth n lst)
(cond ((null? lst) (raise 'nth-nothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(guard (ex
((eq? ex 'nth-nothing)
"nothing-value"))
(nth 1 '())) ; ==> "nothing-value"
Default value:
(define (nth n lst nothing)
(cond ((null? lst) nothing)
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() '())
; ==> '()
Deault value derived from procedure
(define (nth index lst pnothing)
(cond ((null? lst) (pnothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() (lambda _ "list too short"))
; ==> "list too short"
Combination of exception and default procedure
Racket, a Scheme decent, often has a default value option that defaults to an exception or a procedure thunk. It's possible to mimic that behavior:
(define (handle signal rest)
(if (and (not (null? rest))
(procedure? (car rest)))
((car rest))
(raise signal)))
(define (nth n lst . nothing)
(cond ((null? lst) (handle 'nth-nothing nothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() (lambda () 5)) ; ==> 5
(nth 1 '()) ; exception signalled
As a non-lisper I really can't say how idiomatic this is, but you could return the Church encoding of an option type:
(define (nth n ls)
(cond
((null? ls) (lambda (default f) default))
((= n 1) (lambda (default f) (f (car ls))))
(else (nth (- n 1) ls))))
But that's about as complicated to use as #Dirk's proposal. I'd personally prefer to just add a default argument to nth itself.

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)))

How can I use recursion to visually stack a basic block in Scheme?

I am trying to use recursion to stack a basic block I created (y), x amount of times high.
(define stack-copies-of
(lambda (x y)
(cond
((= x 0) 0)
((> x 0) (stack y y)
I didn't go any further because well... I'm stumped. I want the stack of blocks to appear on the screen. Thank you!
First of all, you are not using recursion. stack-copies-of is not stack.
You need to look at basic list operations. Heres some that makes a list:
;; easiest version, looks most like the one you started with
(define (make-list num-elements)
(if (zero? num-elements)
'() ; the tail of the list is the empty list
(cons '* (make-list (- num-elements 1)))))
;; tail recursive version using auxillary procedure
(define (make-list num-elements)
;; we define a local auxillary procedure to do the work
(define (make-list-aux num-elements acc)
(if (zero? n)
acc ; return the produced list
(make-list-aux (- n 1)
(cons '* acc))))
;; fire it off
(make-list-aux num-elements '()))
;; exactly the same as the previous, but with a named let
(define (make-list num-elements)
;; a named let can be called by name as a procedure, creating a loop
(let make-list-aux ((num-elements num-elements)
(acc '()))
(if (zero? n)
acc
(make-list-aux (- n 1)
(cons '* acc)))))
(display (make-list 10)) ; print the result
I expect what you're after could be based on one of these except instead of '* you use your extra argument.
If your data structure is a stack you can define it and the related operations push, pop and one to display the stack.
(define stack '())
(define (push e)
(set! stack (cons e stack)))
(define (pop)
(let ((e (car stack)))
(set! stack (cdr stack))
e))
(define (display-stack)
(for-each
(lambda (e) (display e) (newline))
stack))
the following is the recursive function to stack n times an element
(define (stack-ntimes n e)
(when (> n 0)
(push e)
(stack-ntimes (- n 1) e)))

Resources