I am trying to write a functional program in Lisp that requires any two elements of a list to be shaped and return the new list. So far I have:
(defun swap (lst x y)
(let ((temp (nth y lst)))
(substitute (nth x lst) (nth y lst))
(substitute temp (nth x lst)))
When I run: (swap '(1 2 3 4 5 e 6 7 8) 5 4)
I get:
*** - EVAL/APPLY: too many arguments given to SWAP
You should decide whether your swap will modify old list or not.
Destructive swap can be done with already mentioned rotatef or with pair of setf:
(defun swap1 (lst i j)
(let ((temp (nth i lst)))
(setf (nth i lst) (nth j lst))
(setf (nth j lst) temp)
lst))
Non-destructive swap has to work with copy of argument:
(defun swap2 (lst i j)
(let* ((newlist (copy-tree lst))
(temp (nth i newlist)))
(setf (nth i newlist) (nth j newlist))
(setf (nth j newlist) temp)
newlist))
remarks
Your code looks a bit like it was inspired by Scheme: you named the variable lst and introduced a local variable as-if with define but in a way that does not work in Common Lisp, where let is scoped.
Moreover, you do not use the return value of SUBSTITUTE, which means that any intermediate result is discarded.
The substitute function is purely functional and do not change its inputs with side-effects.
(defun swap (lst x y)
(let (temp (nth y lst))) ;; temp is only visible inside the let
(substitute (nth x lst) (nth y lst)) ;; result is discarded
(substitute temp (nth x lst))) ;; <- the only thing actually used in swap
implementing swap
There are two possible versions for this function, one that mutates the input list, one that doesn't. You also have to decide what is or isn't a valid input and what happens when an invalid input is given.
In both cases below, I assume that x is strictly lower than y, you can make the function more robust by swapping x and y in case this is not the case, or simply returning lst when x and y are equal.
Note also that in case x and/or y are beyond the limit of the list, the result is going to contain NIL values or signal an error, you could add more checks in the below functions to avoid those problems.
destructive version
Here, nswap is the destructive version, it descends into the list x times using nthcdr, to the sublist that starts at position x.
From this sublist, it descends the remaining amount of cells to reach position y. The two lists xlist and ylist are lists that start at respectively position x and y.
Then, I exchange their car using ROTATEF.
(defun nswap (list x y)
(assert (< x y))
(let* ((xlist (nthcdr x list))
(ylist (nthcdr (- y x) xlist)))
(prog1 list
(rotatef (car xlist)
(car ylist)))))
functional version
The purely functional swap could just call nswap on (copy-list lst).
It is however also possible to share some cells with lst, since everything that follows the rest of ylist is left unmodified.
That's how the function works, it computes xlist and ylist as before, but uses LDIFF to produce fresh lists (regions of the initial list).
The different slices of the initial lists are concatenated with nconc (they are fresh lists, so the code has local side-effects but externally, the input list is unmodified). The (rest ylist) is the last argument to nconc and is not a copy.
(defun swap (list x y)
(assert (< x y))
(let* ((xlist (nthcdr x list))
(ylist (nthcdr (- y x) xlist)))
(nconc (ldiff list xlist)
(list (first ylist))
(ldiff (rest xlist) ylist)
(list (first xlist))
(rest ylist))))
For example, using :circle t for write let us see the shared end of list:
(let ((list '(a b c d e f g h i)))
(write (list :original list
:swapped (swap list 1 3))
:circle t))
The following is printed, with #1= marking the tail and #1# showing that the identical same tail is used in the result:
(:ORIGINAL (A B C D . #1=(E F G H I))
:SWAPPED (A D C B . #1#))
Related
Working on this program that's supposed to take a vector of integers as input and return the one with the longest integer. Example (vector 20 738 5942 125) and would return 4 as its the longest one. I'm pretty sure I have most of this done the only issue I have is in the conditional as I have to call an outside function (count-integers), this is what I have so far:
(require while)
(define (empty-VINT? low high) (> low high))
(define (count-integers n)
(cond [(< n 10) 1]
(else(+ 1 (count-integers [/ n 10])))))
(define (count-digits V)
(local [
(define x (void))
(define accum (void))
(define largest 0)]
(begin
(set! x (vector-length V))
(set! accum 0)
(while (< accum (vector-length V))
(cond [(empty-VINT? x accum) accum]
[(> (count-integers (vector-ref V accum) largest)
(add1 x) accum(vector-ref V accum))]
[else add1 accum])))))
Right now when its run, I get this message: cond: expected a clause with a question and an answer, but found a clause with only one part. Any suggestions would be great, thanks
First of all, it's not clear what do you want to return. 4 isn't the longest integer (that's 5942), 4 is a maximal digit count among integers in given vector.
Secondly, your code isn't idiomatic and without your comment, it's very hard to say what's going on. Programming in functional languages requies functional way of thinking. Forget about while, set!, void, local and nested define and instead spend some time learning about apply, map, filter and foldl.
I would solve this problem like this:
(define (digits number)
(string-length (number->string number)))
(define (max-digit-count vec)
(apply max (map digits (vector->list vec))))
(max-digit-count (vector 20 738 5942 125))
=> 4
From comments:
Design and implement a function to find the number of digits in the longest integer in a (vectorof integer) ...
use ... while loops
So a plan (design) might be:
count-digits: integer -> natural
max-digit-count: (vectorof integer) -> natural
..something while something max count-digits something ???
Implementing count-digits seems straightforward (but
integers can be negative, and in Racket (integer? 123.000) is true).
#lang racket
(define (count-digits int) ;; Integer -> Natural
;; produce count of digits in int
(string-length (number->string (abs (exact-truncate int)))))
As #Gwang-Jin Kim mentions, while could be defined:
(define-syntax-rule (while condition body ...)
;; From: https://stackoverflow.com/questions/10968212/while-loop-macro-in-drracket
(let loop ()
(when condition
body ...
(loop))))
and then one could use it:
(define (max-digit-count vec) ;; VectorOfInteger -> Natural
;; produce maximum of digit counts of vec elements
(define vx 0)
(define acc 0)
(while (< vx (vector-length vec))
(set! acc (max accum (count-digits (vector-ref vec vx))))
(set! vx (add1 vx)))
acc)
(max-digit-count (vector 20 -738.00 5942 125)) ;=> 4
One of the problems with while is that it can't produce a value (where would it come
from if the condition is false on entry?)
If one "enhanced" while a bit:
(define-syntax-rule (while< x-id limit a-id a-init update)
;; "while loop" incrementing x-id from 0 to limit-1, updating a-id
(let loop ([x-id 0] [a-id a-init])
(if (< x-id limit)
(loop (add1 x-id) update)
a-id)))
max-digit-count could be neater:
(define (max-digit-count vec) ;; VectorOfInteger -> Natural
;; produce maximum of digit counts of vec elements
(while< vx (vector-length vec)
acc 0 (max acc (count-digits (vector-ref vec vx)))))
#MartinPuda's answer is quite good.
I would have defined:
(define (digits n (acc 0))
(if (< n 1)
acc
(digits (/ n 10) (+ acc 1))))
(define (max-digits lst)
(digits (car (sort lst >))))
To apply it:
(max-digits (vector->list (vector 20 738 5942 125)))
Why you should not use while
Using while would force you to mutate variable values. It is much more "natural" for lisp languages to follow the functional style (recursive functions instead of while loops or other loops) rather than the imperative style with mutation of variables.
That is why while is not in the lisp languages.
But if you want to use it:
(define-syntax-rule (while condition body ...)
;; From: https://stackoverflow.com/questions/10968212/while-loop-macro-in-drracket
(let loop ()
(when condition
body ...
(loop))))
(define (digits n (acc 0))
(cond ((< n 1) acc)
(else (digits (/ n 10) (+ acc 1)))))
(define (max-digits lst)
(let ((max-digit 0))
(while (not (null? lst))
(let ((digit (digits (car lst))))
(when (< max-digit digit)
(set! max-digit digit))
(set! lst (cdr lst))))
max-digit))
Then you can try:
> (max-digits (vector->list v))
4
> (max-digits '(1111 123456 2345 34))
6
Prefer let over define
Why? Because if you use let, you can control the scope of the to-be-mutated variable very precisely. You can define in your definition, from where on your variable canNOT have any effect on your code (since its scope ended at some point). While with define you don't have this fine-grained control. (Or this control is implicit not explicite like with let). You could delete/unbind the variable explicitely but that is rarely done in real life.
Therefore, in Lisp, for variable declarations use whenever possible let, especially whenever you deal with mutated variables.
All imperative = declarations should be in Lisp languages let expressions!
You can use function arguments instead of let-definitions, because they are anyway implemented using lets
Just you save syntactically some lines - and the fewer lines you occupy the cleaner the code.
#lang racket
(define (digits n)
(string-length (number->string n)))
(define (max-digit a b)
(if (< (digits a) (digits b)) b a))
(define (max-digits lst (res ""))
(while (not (null? lst))
(set! res (max-digit res (car lst)))
(set! lst (cdr lst)))
(digits res))
I have a circular list, eg: #0=(1 2 3 4 . #0#).
What I want to do is to insert a new element (x) into this list so that the outcome is #0=(x 1 2 3 4 . #0#). I have been trying using this code (x is the circular list):
(define (insert! elm)
(let ((temp x))
(set-car! x elm)
(set-cdr! x temp)))
However, I think that set-cdr! is not working like I want it to. What am I missing here? Maybe I am way off?
The easiest way to prepend an element to a list is to modify the car of the list, and set the cdr of the list to a new cons whose car is the original first element of the list and whose cdr is the original tail of the list:
(define (prepend! x list) ; list = (a . (b ...))
(set-cdr! list (cons (car list) (cdr list))) ; list = (a . (a . (b ...)))
(set-car! list x)) ; list = (x . (a . (b ...)))
(let ((l (list 1 2 3)))
(prepend! 'x l)
(display l))
;=> (x 1 2 3)
Now, that will still work with circular lists, because the cons cell (i.e., pair) that is the beginning of the list remains the same, so the "final" cdr will still point back to object that is the beginning. To test this, though, we need some functions to create and sample from circular lists, since they're not included in the language (as far as I know).
(define (make-circular list)
(let loop ((tail list))
(cond
((null? (cdr tail))
(set-cdr! tail list)
list)
(else
(loop (cdr tail))))))
(define (take n list)
(if (= n 0)
'()
(cons (car list)
(take (- n 1)
(cdr list)))))
(display (take 10 (make-circular (list 1 2 3))))
;=> (1 2 3 1 2 3 1 2 3 1)
Now we can check what happens if we prepend to a circular list:
(let ((l (make-circular (list 1 2 3))))
(prepend! 'x l)
(display (take 15 l)))
;=> (x 1 2 3 x 1 2 3 x 1 2 3 x 1 2)
Since you're trying to prepend an element to a circular list, you need to do two things:
Insert a new cons cell at the front of the list containing the additional element. This is easy because you can just perform a simple (cons elm x).
You also need to modify the recursive portion of the circular list to point at the newly created cons cell, otherwise the circular portion will only include the old parts of the list.
To perform the latter, you need a way to figure out where the "end" of the circular list is. This doesn't actually exist, since the list is, of course, circular, but it can be determined by performing an eq? check on each element of the list until it finds an element equal to the head of the list.
Creating a helper function to do this, a simple implementation of insert! would look like this:
(define (find-cdr v lst)
(if (eq? v (cdr lst)) lst
(find-cdr v (cdr lst))))
(define (insert! elm)
(set! x (cons elm x))
(set-cdr! (find-cdr (cdr x) (cdr x)) x))
So I'm currently stuck on a "simple?" function in Racket. It's using the Intermediate Student with lambda language.
Some restrictions on this are that NO recursion is allowed, neither are local functions. It's plain and simple abstract list functions.
What this function is supposed to do is to take in a list of numbers, and output a list of pairs in which each pair has the first element as the number with the second element being the number it has occurred in the list.
Examples:
(1 1 2 3) => ((1 2) (2 1) (3 1))
(2 3 4 3) => ((2 1) (3 2) (4 1))
I have a function that produces the number of occurrences by inputting a list of numbers and a number which is:
(define (occurrences lon n)
(length (filter (lambda (x) (= x n)) lon)))
My approach, which was clearly wrong was:
(define (num-pairs-occurrences lon)
(list (lambda (x) (map (occurrences lon x) (remove x lon)) x))
I thought the above would work, but apparently my lambda isn't placed properly. Any ideas?
It's a bit trickier than you imagine. As you've probably noticed, we must remove duplicate elements in the output list. For this, is better that we define a remove-duplicates helper function (also using abstract list functions) - in fact, this is so common that is a built-in function in Racket, but not available in your current language settings:
(define (remove-duplicates lst)
(foldr (lambda (e acc)
(if (member e acc)
acc
(cons e acc)))
'()
lst))
Now it's easy to compose the solution using abstract list functions:
(define (num-pairs-occurrences lon)
(map (lambda (e) (list e (occurrences lon e)))
(remove-duplicates lon)))
The above might return and output list in a different order, but that's all right. And before you ask: yes, we do need that helper function. Please don't ask for a solution without it...
An easy, self-contained solution would be:
(define (num-pairs-occurences lst)
(foldl (lambda (e r)
(if (or (null? r) (not (= (caar r) e)))
(cons (list e 1) r)
(cons (list e (add1 (cadar r))) (cdr r))))
null
(sort lst >)))
Basically, you sort the list first, and then you fold over it. If the element (e) you get is the same as the first element of the result list (r), you increment the count, otherwise you add a new sublist to r.
If you sort by > (descending), you can actually use foldl which is more memory-efficient. If you sort by < (ascending), you need to use foldr which is less efficient.
(define-struct position (name numshares share-price))
(define p1
(cons (make-position "INT" 10 192) (cons (make-position "SSS" 4 42)
empty)))
mult is my helper function
(define (mult n)
( * (position-numshares n)
(position-share-price n)))
const takes the position-numshares and the position-share-price in a list and multiplies them together.
(define (const n)
(cond
[(empty? n) empty]
[(cons? n)
(+ (mult (first n))
)]))
What I would like to do is take the first of the list and add the rest of the list together. Instead, I only get the first of the list. So if I do (const p1) I only get 1920, but I would like to get 2088 (10*192 + 4*42). I've tried recurring for the rest, but get an error. I am probably missing something simple. Help would be appreciated.
First, note that in general, you can do
(list a b)
instead of
(cons a (cons b empty))
so you define p1 with
(define p1
(list (make-position "INT" 10 192)
(make-position "SSS" 4 42)))
which is easier to read, and makes your intent clearer. Now, to get 1920 from a structure created by (make-position "INT" 10 192), you've defined your helper procedure mult. You can map mult over your list p1 to get a new list of the products, i.e., (1920 168). Then you can use foldl with + and 0 on that list to compute its sum.
(define (const lst)
(foldl + 0 (map mult lst)))
(const p1)
;=> 2088
If you don't want to use fold and map (which might be reasonable, since map means that a new list is getting allocated), you can write this out manually:
(define (const lst)
(let const ((sum 0) (lst lst)) ; pretty much an implementation of fold, but
(if (null? lst) ; with the function + built in, and mult applied
sum ; to each element before passing to +
(const (+ sum (mult (car lst)))
(cdr lst)))))
(const p1)
;=> 2088
Another alternative would be to use foldl, but instead of passing +, pass in a function that combines + and mult:
(define (const3 lst)
(foldl (lambda (struct sum)
(+ (mult struct) sum))
0
lst))
(const3 p1)
As a Common Lisper, it's a bit disappointing to me that Scheme's foldl procedure doesn't take a key argument that gets applied to each element of the list before the function is applied to it. In Common Lisp, we'd write (foldl/foldr are reduce in Common Lisp):
(reduce '+ p1 :key 'mult)
I like creating functions which take an unlimited number of arguments, and being able to deal with them as a list. It's been useful to me when creating binary trees & I'm using it for a variation on the nearest-neighbor algorithm right now. My method, however, is really horrible: since I can't think of a way to iterate over an improper list (which may well be improper & degenerate), I tried using various list functions to force the improper list into list form.
This is my best attempt in a simple function to determine difference between map-nodes (works, just not sure why it works):
(define distance-between
(lambda xs
(let ([input-list (list* xs null)])
(letrec
([f (lambda (xs acc)
(if (null? (cdr xs))
acc
(f (cdr xs)
(+ (abs (- (map-node-x (car xs))
(map-node-x (cadr xs))))
(abs (- (map-node-y (car xs))
(map-node-y (cadr xs))))
acc))))])
(f (car input-list) 0)))))
As you can see, it's an ugly solution and involves some of what seems like magic to me - why is the improper list coerced into list form when I include it in a list*? (note: this sentence is misleading, this does not occur).
I'd rather have a pretty solution and no magic. Can anyone help?
For example a typical input would be:
(distance-between (map-node 1 2) (map-node 2 3) (map-node 3 4))
with the expected result:
4
(a distance of 2 between map-node (a) and m-n (b), plus a distance of 2 between map-node (b) and map-node (c)).
Alternatively one might simply input:
(distance-between (map-node 1 2) (map-node 2 2))
and get an answer of:
1
If I attempted this on the raw input, without my (let ([input-list...])...) statement, it would cause an error as (? not actually sure why given response to this question).
The function works as expected.
There's nothing improper about the list received as a variadic argument list (meaning: variable number of arguments). For example:
(define test-list
(lambda xs
(length xs))) ; xs is a normal list, use it like any other list
(test-list 1 2 3 4)
=> 4
In the above example, the xs parameter is a normal, plain, vanilla list, there's nothing improper about it. You can iterate over it as you would over any other list. There's no need to car it, it's already a list! Also, notice that the same function can be written like this:
(define (test-list . xs)
(length xs)) ; xs is a normal list, use it like any other list
Just for reference: an improper list is one that does not end with the null list. For example: '(1 2 3 . 4). Again, that's not how a variadic argument list looks.
I also don't understand how your variadic argument list could be improper.
But to answer your original question (how to iterate over a possibly improper list, somewhat more elegantly), here is one way using match:
#lang racket
(define (properly-sum-improper-list xs)
(let loop ([acc 0]
[xs xs])
(match xs
[(list) acc]
[(cons x more) (loop (+ acc x) more)]
[x (+ acc x)]))) ;last item of improper list
(require rackunit)
(check-equal? (properly-sum-improper-list '(1 2 3 4)) 10)
(check-equal? (properly-sum-improper-list '(1 2 3 . 4)) 10)
However needing to do this, at all, is probably an indication you want to fix or change something else.
Your list is not improper. When your argument is not a pair, like (lambda xs body ...) or (define (fun . xs) body ...) all your arguments gets slurped into a list. Eg.. (fun 1 2 3) would make xs '(1 2 3). Doing (list* '(1 2 3) '()) makes '((1 2 3) which you undo right away by calling your loop with car which makes it '(1 2 3) again.
Other than that your procedure works as intended. You might clean up your procedure a little, but since there is no list comprehensions that glides over a list folding over the two next elements it won't become much smaller. Below is basically the same code, but abstracting out the procedure that does the work (which if existed a foldl-pair you could have used) and with a named let as a iterator loop (which is syntactic sugar for a letrec+call).
(define (distance-between e1 . lst)
(define (add-diff-acc e1 e2 acc)
(+ (abs (- (map-node-x e1) (map-node-x e2)))
(abs (- (map-node-y e1) (map-node-y e2)))
acc))
(let iterate ((e1 e1) (lst lst) (acc 0))
(if (pair? lst)
(let ((e2 (car lst)))
(iterate e2 (cdr lst) (add-diff-acc e1 e2 acc)))
acc)))
EDIT: About syntax sugar, named let and letrec.
(let ((x 10) (y 19))
body)
is syntactic sugar for a anonymous procedure call
((lambda (x y)
body)
10 19)
A named let is just giving that procedure a name, though as if by letrec, making a recursive binding. you call it with the name you give and the arguments will be what you supply instead of the initial value in the let. I'm used to them and prefer them today. It might take some time to get used to though.
Most of the code we write is syntactic sugar for some lower level stuff. The macros are nested so that your letrec form could get reduced down lambdas eventually. The whole procedure without syntactic sugar would look like this:
(define distance-between
(lambda (e1 . lst)
((lambda (add-diff-acc)
((lambda (iterate e1 lst acc) ; emulate Y to substitute `letrec`
(iterate iterate e1 lst acc))
(lambda (iterate e1 lst acc)
(if (pair? lst)
((lambda (e2)
(iterate iterate e2 (cdr lst) (add-diff-acc e1 e2 acc)))
(car lst))
acc))
e1 lst 0))
(lambda (e1 e2 acc)
(+ (abs (- (map-node-x e1) (map-node-x e2)))
(abs (- (map-node-y e1) (map-node-y e2)))
acc)))))