Given a propositional formula, i. e. ((a and (b implies c) or (d and (e implies f)))),
I need to write a Scheme function to remove the connectives, and, implies, or.
The the return of the function contains all variables in the formula. For instance,
(a b c d e f).
I am not sure how to even get started on this, because I am unsure how to get inside the nested lists and remove and cons certain variables and connectives.
I would start up with something like the following:
(define somelist
(list 'a 'and (list 'b 'implies 'c)
'or (list 'd 'and (list 'e 'implies 'f))))
(define (remove-vars xs ys)
(let ((xs-f (flatten xs)))
(filter-two xs-f ys)))
(define (filter-two xs ys)
(foldr (lambda(y acc)
(filter (lambda(x) (not (eq? x y))) acc))
xs
ys))
Test:
> (remove-vars somelist (list 'and 'or 'implies))
(a b c d e f)
> (remove-vars somelist (list 'and 'or))
(a b implies c d e implies f)
UPDATE: OK, #karategeek6 reported, that he doesn't have flatten and filter in his Scheme interpreter, and I'm not sure you do, so let's implement them manually, because there are no filter and flatten in R^6RS either:
(define (my-flatten xs)
(foldr
(lambda(x acc)
(if (list? x)
(append (my-flatten x) acc)
(cons x acc)))
(list)
xs))
(define (my-filter pred xs)
(let recur ((xs xs)
(acc (list)))
(if (empty? xs)
(reverse acc)
(if (pred (car xs))
(recur (cdr xs) (cons (car xs) acc))
(recur (cdr xs) acc)))))
Modify remove-vars and filter-two appropriately:
(define (remove-vars xs ys)
(let ((xs-f (my-flatten xs)))
(filter-two xs-f ys)))
(define (filter-two xs ys)
(foldr (lambda(y acc)
(my-filter (lambda(x) (not (eq? x y))) acc))
xs
ys))
You should get the same output as with previous versions of the above procedures.
Related
I have following task:
Define a function replace-element that searches a given list for a given element x and replaces each element x with a given element y.
I am a super beginner and have no idea how to do this.
Maybe there is someone who can help me. Thanks a lot!!
For example:
(replace-element ‘a ‘b ‘(a b c a b c))
(B B C B B C)
Here is a way of doing this which, again, you probably cannot submit as homework, but it shows you an approach.
First of all, tconc and friends to accumulate lists:
(defun empty-tconc ()
;; make an empty accumulator for TCONC
(cons nil nil))
(defun tconc (v into)
;; destructively add V to the end of the accumulator INTO, return
;; INTO
(if (null (car into))
(setf (car into) (list v)
(cdr into) (car into))
(setf (cdr (cdr into)) (list v)
(cdr into) (cdr (cdr into))))
into)
(defun tconc-value (into)
;; Retrieve the value of an accumulator
(car into))
Next the answer:
(defun replace-element (x y l)
(replace-element-loop x y l (empty-tconc)))
(defun replace-element-loop (x y l accumulator)
(if (null l)
(tconc-value accumulator)
(replace-element-loop
x y (rest l)
(tconc (if (eql (first l) x) y (first l)) accumulator))))
Or you do the tail call recursion in one function using optional arguments or key arguments:
(defun replace-element (element replacer l &key (acc '()) (test #'eql))
(cond ((null l) (nreverse acc))
((funcall test (car l) element) (replace-element element replacer (cdr l) :acc (cons replacer acc) :test test))
(t (replace-element element replacer (cdr l) :acc (cons (car l) acc) :test test))))
It is also possible to use reduce for this:
(defun replace-element (element replacer l &key (test #'eql))
(nreverse
(reduce (lambda (res el)
(if (funcall test el element)
(cons replacer res)
(cons el res)))
l
:initial-value '())))
I've just started to learn Racket.
I have this code:
#lang racket
(define l1 '(1 2 3 4))
(car l1)
(cdr l1)
(car l1) returns 1.
(cdr l1) returns '(2 3 4)
Is there a function that returns '(1 2 3)?
I've tried this:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l '()))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 ())
And I have also tried:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(cond ((not (= i (sub1 (length l1)))) l )))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 #<void>)
The map function always returns a list the same length as its input. You want an output list that is shorter than its input. The function you are looking for is traditionally called but-last:
(define (but-last xs) (reverse (cdr (reverse xs))))
What about something like this ?
(define (myCdr l)
(if (not (pair? (cdr l)))
'()
(cons (car l) (myCdr (cdr l)))
)
)
length is generally an anti-pattern in Scheme because the entire list needs to be read in order to get the result. W. Ness remarks that map does not alter the structure of the list, and the behavior of filter is based on the list's values, neither of which suit your needs.
Instead of making potentially expensive computations first or awkwardly applying the library functions, you can compute the init of a list using direct recursion -
(define (init l)
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
null)
(else
(cons (car l)
(init (cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Or a tail-recursive form that only uses one reverse -
(define (init l)
(let loop ((acc null)
(l l))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(reverse acc))
(else
(loop (cons (car l) acc)
(cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
And lastly a tail-recursive form that does not use length or reverse. For more intuition on how this works, see "How do collector functions work in Scheme?" -
(define (init l (return identity))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(return null))
(else
(init (cdr l)
(lambda (r)
(return (cons (car l) r)))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Here's one more, via zipping:
#lang racket
(require srfi/1)
(define (but-last-zip xs)
(if (null xs)
xs ; or error, you choose
(map (lambda (x y) x)
xs
(cdr xs))))
Here's another, emulating filtering via lists with appending, where empty lists disappear by themselves:
(define (but-last-app xs)
(if (null? xs)
xs
(let ((n (length xs)))
(apply append ; the magic
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n))))))
Or we could use the decorate--filter--undecorate directly, it's even more code!
(define (but-last-fil xs)
(if (null? xs)
xs
(let ((n (length xs)))
(map car
(filter (lambda (x) (not (null? x)))
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n)))))))
Here's yet another alternative, assuming that the list is non-empty. It's efficient (it performs a single pass over the list), and it doesn't get any simpler than this!
(define (delete-last lst)
(drop-right lst 1))
(delete-last '(1 2 3 4))
=> '(1 2 3)
Here is an equivalent of Will Ness's beautiful but-last-zip which does not rely on srfi/1 in Racket: without srfi/1 Racket's map insists that all its arguments are the same length (as does the R5RS version in fact) but it is common in other Lisps to have the function terminate at the end of the shortest list.
This function uses Racket's for/list and also wires in the assumption that the result for the empty list is the empty list.
#lang racket
(define (but-last-zip xs)
(for/list ([x xs] [y (if (null? xs) xs (rest xs))])
x))
I think Will's version is purer: mapping functions over things is a very Lisp thing to do I think, while for/list feels less Lispy to me. This version's only advantage is that it does not require a module.
My own solution using recursion:
#lang racket
(define but-last
(lambda (l)
(cond ((null? (cdr l)) '())
(else (cons (car l) (but-last (cdr l)))))))
And another solution using filter-not and map:
#lang racket
(define l1 '(1 2 3 4))
(filter-not empty? (map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l empty))
l1 (range 0 (length l1))))
How do I recursively merge jumping pairs of elements of a list of lists? I need to have
'((a b c) (e d f) (g h i))
from
'((a b) c (e d) f (g h) i)
My attempt
(define (f lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (append (car lst) (list (cadr lst)))
(list (append (caddr lst) (cdddr lst))))))
works if I define
(define listi '((a b) c (d e) f))
from which I obtain
((a b c) (d e f))
by doing simply
(f listi)
but it does not work for longer lists. I know I need recursion but I don't know where to insert f again in the last sentence of my code.
A simpler case that your algorithm fails: (f '((1 2) 3)) should result in '((1 2 3)), but yours results in an error.
We will define some terms first:
An "element" is a regular element, like 1 or 'a.
A "plain list" is simply a list of "element"s with no nested list.
E.g., '(1 2 3) is a plain list. '((1 2) 3) is not a plain list.
A "plain list" is either:
an empty list
a cons of an "element" and the next "plain list"
A "list of jumping pairs" is a list of even length where the odd index has a "plain list", and the even index has an element. E.g., '((1) 2 (a) 4) is a "list of jumping pairs". A "list of jumping pairs" is either:
an empty list
a cons of
a "plain list"
a cons of an "element" and the next "list of jumping pairs"
We are done with terminology. Before writing the function, let's start with some examples:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
(f '((1 2) 3 (4) a)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
(cons (cons 4 empty)
(cons 'a
empty)))))
should output '((1 2 3) (4 a))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
(cons (cons 4 (cons 'a empty))
empty))
So, f is a function that consumes a "list of jumping pairs" and returns a list of "plain list".
Now we will write the function f:
(define (f lst)
???)
Note that the type of lst is a "list of jumping pairs", so we will perform a case analysis on it straightforwardly:
(define (f lst)
(cond
[(empty? lst) ???] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
we know that the empty case should return an empty list, so let's fill in the hole accordingly:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
we know that we definitely want to put the "element" into the back of the "plain list" to obtain the resulting "plain list" that we want:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the next "list of jumping pairs"
(rest (rest lst))
;; that are available for us to use
???]))
There's still the next "list of jumping pairs" left that we need to deal with, but we have a way to deal with it already: f!
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the list of "plain list"
(f (rest (rest lst)))
;; that are available for us to use
???]))
And then we can return the answer:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case returns
;; the resulting list of "plain list" that we want
(cons (append (first lst) (cons (first (rest lst)) empty))
(f (rest (rest lst))))]))
Pattern matching (using match below) is insanely useful for this kind of problem -
(define (f xs)
(match xs
;; '((a b) c . rest)
[(list (list a b) c rest ...)
(cons (list a b c)
(f rest))]
;; otherwise
[_
empty]))
define/match offers some syntax sugar for this common procedure style making things even nicer -
(define/match (f xs)
[((list (list a b) c rest ...))
(cons (list a b c)
(f rest))]
[(_)
empty])
And a tail-recursive revision -
(define (f xs)
(define/match (loop acc xs)
[(acc (list (list a b) c rest ...))
(loop (cons (list a b c) acc)
rest)]
[(acc _)
acc])
(reverse (loop empty xs)))
Output for each program is the same -
(f '((a b) c (e d) f (g h) i))
;; '((a b c) (e d f) (g h i))
(f '((a b) c))
;; '((a b c))
(f '((a b) c x y z))
;; '((a b c))
(f '(x y z))
;; '()
(f '())
;; '()
As an added bonus, this answer does not use the costly append operation
There is no recursive case in your code so it will just work statically for a 4 element list. You need to support the following:
(f '()) ; ==> ()
(f '((a b c) d (e f g) h)) ; ==> (cons (append '(a b c) (list 'd)) (f '((e f g) h)))
Now this requires exactly even number of elements and that every odd element is a proper list. There is nothing wrong with that, but onw might want to ensure this by type checking or by adding code for what should happen when it isn't.
I implemented a function (combine f n l1 l2) that combines two lists pairwise with f and returns a list:
(check-expect (combine string-append "" '("1" "2" "3") '("4" "5" "6")) '("14" "25" "36"))
(check-expect (combine + 0 '(1 2 3) '(4 5 6)) '(5 7 9))
(define (combine f n l1 l2)
(if (empty? l1) '()
(cons (foldr f n (first (zip l1 l2)))
(combine f n (rest l1) (rest l2)))))
It uses the (zip l1 l2) function I implemented previously:
(check-expect (zip '(1 2 3 0) '(4 5 6))'((1 4) (2 5) (3 6)))
(define (zip l1 l2)
(local
[(define (take lst n)
(if (zero? n)
'()
(cons (first lst)
(take (rest lst)(- n 1)))))
(define min-lsts
(min (length l1) (length l2)))]
(foldr (lambda (e1 e2 acc) (cons (list e1 e2) acc)) '() (take l1 min-lsts) (take l2 min-lsts))))
(combine f n l1 l2) works as expected, but is there a way to change it to (combine f l1 l2) that does not expect n but still uses foldr?
Thanks in advance!
As long as you always have two arguments you can replace the recursion with foldr and just use the two arguments directly:
(define (combine f l1 l2)
(foldr (lambda (a1 a2 acc)
(cons (f a1 a2)
acc))
'()
l1
l2))
Also zip is implemented overly complicated. It can be done far simpler:
(define (zip l1 l2)
(map list l1 l2))
I was wondering how to reverse a list using only basic operations such as cons, first, rest, empty?, etc.
No helper functions or accumulators allowed, and the function only takes one input - a list.
I was told it was possible, though I can't wrap my head around it.
This is what I have conceptualized so far. I don't know how to form the recursion for the rest of the list.
(defunc rev-list (x)
(if (or (equal (len x) 0) (equal (len x) 1))
x
(cons (first (rev-list (rest x)))
???)))
Apparently it is possible to do something similar with a function that swaps the first and last of a list, though I don't fully understand it either. Here is the code for it:
(define swap-ends (x)
(if (or (equal (len x) 0) (equal (len x) 1))
x
(cons (first (swap-ends (rest x)))
(swap-ends (cons (first x)
(rest (swap-ends (rest x))))))))
(note: the answer is at the bottom of this post) The 2nd function,
(define (swap-ends x) ; swap [] = []
(if (or (equal (length x) 0) (equal (length x) 1)) ; swap [x] = [x]
x ; swap (x:xs)
(cons (first (swap-ends (rest x))) ; | (a:b) <- swap xs
(swap-ends (cons (first x) ; = a : swap (x : b)
(rest (swap-ends (rest x))))))))
(with Haskell translation in the comments) what does it do, you ask? The data flow diagram for if's alternative clause is
/-> first ----------------------> cons
x --> first ------/-------------> cons --> swap --/
\-> rest -> swap ---> rest ---/
(follow the arrows from left to right). So,
[] -> []
[1] -> [1]
/-> 2 -----------------------> [2,1]
[1,2] --> 1 --------/------------> [1] --> [1] --/
\-> [2] -> [2] ---> [] ---/
/-> 3 -------------------------> [3,2,1]
[1,2,3] --> 1 ------------/----------> [1,2] --> [2,1] --/
\-> [2,3] -> [3,2] -> [2] --/
/-----> 4 ----------------------------> [4,2,3,1]
[1,2,3,4] --> 1 ------------/---------------> [1,3,2] -> [2,3,1] -/
\-> [2,3,4] -> [4,3,2] -> [3,2] -/
So far it indeed does swap the end elements of a list. Let's prove it by the natural induction,
true(N-1) => true(N):
/-> N --------------------------------------> [N,2..N-1,1]
[1..N] --> 1 ---------/-----------> [1,3..N-1,2] -> [2,3..N-1,1] -/
\-> [2..N] -> [N,3..N-1,2] /
-> [3..N-1,2] -/
So it is proven. Thus, we need to devise a data flow diagram which, under the supposition of reversing an (N-1)-length list, will reverse an N-length list:
[1..N] --> 1 ------------------------------------\
\-> [2..N] -> [N,N-1..2] -> N -------------\------------------\
\-> [N-1,N-2..2] -> [2..N-1] -> [1..N-1] -> rev -> cons
Which gives us the implementation
(define (rev ls) ; rev [] = []
(cond ; rev [x] = [x]
((null? ls) ls) ; rev (x:xs)
((null? (rest ls)) ls) ; | (a:b) <- rev xs
(else ; = a : rev (x : rev b)
(cons (first (rev (rest ls)))
(rev (cons (first ls)
(rev (rest (rev (rest ls))))))))))
(rev '(1 2 3 4 5)) ; testing
;Value 13: (5 4 3 2 1)
The Haskell translation in the comments follows the diagram quite naturally. It is actually readable: a is the last element, b is the reversed "core" (i.e. the input list without its first and last element), so we reverse the reversed core, prepend the first element to get the butlast part of the input list, then reverse it and prepend the last element. Simple. :)
2020 update: here's a Scheme version based on the code by #Rörd from the comments, such that it is similarly readable, with arguments destructuring in place of Haskell's pattern matching:
(define (bind lst fun)
(apply fun lst))
(define (rev lst)
(if (or (null? lst)
(null? (cdr lst)))
lst
(bind lst
(lambda (first . rest)
(bind (rev rest)
(lambda (last . revd-core)
(cons last (rev (cons first (rev revd-core))))))))))
(define (reverse x)
(let loop ((x x) (y '()))
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x))))))
Really one of the few ways to do it efficiently. But still sort of a helper procedure.
Other way, but not tail-recursive, and if the append doesn't use a set-cdr! it's really unusable for large lists.
(define (reverse L)
(if (null? l)
'()
(append (reverse (cdr L)) (list (car L)))))
Do you have last and butlast in your environment? If so, the procedure can be defined like this (though as Oscar notes this isn't how you'd normally want to approach the problem):
(define (rev lst)
(if (null? lst)
'()
(cons (car (last lst))
(rev (butlast lst)))))
Here are definitions of last and butlast. It sounds like they won't do you any good for this assignment if they're not part of your default environment, but when you're starting out it's good to read through and think about lots of recursive procedures.
(define (butlast lst)
(if (or (null? lst) (null? (cdr lst)))
'()
(cons (car lst) (butlast (cdr lst)))))
(define (last lst)
(if (or (null? lst) (null? (cdr lst)))
lst
(last (cdr lst))))