This is my homework but we are only allowed to use filter, map, foldr, sort, build-list, and lambda instead of the explicit recursion
How can I rewrite these use those high order functions above to not let the function call itself.
What I have now are these:
(define (worthless loc name)
(cond
[(empty? loc) loc]
[(equal? name (coin-name (first loc))) (cons (make-coin (coin-name (first loc)) 0) (worthless (rest loc) name))]
[else (cons (first loc) (worthless (rest loc) name))]))
(define (working-group locations group-tz)
(cond
[(empty? locations) empty]
[(and (equal? (utc-hours group-tz) (utc-hours (location-timezone (first locations)))) (equal? (utc-sign group-tz) (utc-sign (location-timezone (first locations)))))
(cons (location-city (first locations)) (working-group (rest locations) group-tz))]
[(and (equal? (add1 (utc-hours group-tz)) (utc-hours (location-timezone (first locations))))
(equal? (utc-sign group-tz) (utc-sign (location-timezone (first locations))))
(equal? (utc-mins group-tz) (utc-mins (location-timezone (first locations)))))
(cons (location-city (first locations)) (working-group (rest locations) group-tz))]
[(and (equal? (sub1 (utc-hours group-tz)) (utc-hours (location-timezone (first locations))))
(equal? (utc-sign group-tz) (utc-sign (location-timezone (first locations))))
(equal? (utc-mins group-tz) (utc-mins (location-timezone (first locations)))))
(cons (location-city (first locations)) (working-group (rest locations) group-tz))]
[else (working-group (rest locations) group-tz)])) ```
Yes. worthless can be rewritten with map. Imagine we have this function that adds 3 to each element in a list:
(define (add3 lst)
(if (null? lst)
'()
(cons (+ (car lst) 3)
(add3 (cdr lst)))))
Map for one list looks like this:
(define (map f lst)
(if (null? lst)
'()
(cons (f (car lst))
(map f (cdr lst))))
Looking at these you can see that an add3 with map only needs to focus on adding 3. Basically you need to pass a function with one argument that adds 3 to that argument:
(define (add3-wm lst)
(map (lambda (v) (+ v 3)) lst))
Now foldr for one list looks like this:
(define (foldr f init lst)
(if (null? lst)
init
(f (car lst)
(foldr f init (cdr lst)))))
Here you see that cons isn't done so rewriting add3 using foldr takes a combiner and it needs to add 3 to the first argument and combine the two arguments where the second argument is the result fo the same process with the later elements.
(define (add3-fr lst)
(define (combiner v acc)
(cons (+ v 3) acc))
(foldr combiner '() lst))
In reality using foldr here is overkill, but it would be interesting if you sometimes needed to skip an element like working-group does. In that case the combiner just returns the second argument. You can make filter with foldr:
(define (filter f lst)
(foldr (lambda (v acc)
(if (f v)
(cons v acc)
acc))
'()
lst))
Good luck
I stayed up all night writing this function that takes a list of strings and turns it into a recursively nested set of alists. I tried using pushnew so that existing strings would not be duplicated but had to create my own test for repetition because I could not get pushnew to do it.
Obviously there is a way to use recursion but I couldn't get that to work because I could not get the destination part of pushnew to call right.
I finally did it a stupid way, but what is the smart way?
(defvar vocab '())
(defun place-down ( a b &optional c d e f g)
(unless (assoc a vocab :test #'equal)
(pushnew (cons a '()) vocab :test #'equal))
(unless (assoc b (cdr(assoc a vocab :test #'equal)):test #'equal)
(pushnew (cons b '()) (cdr(assoc a vocab :test #'equal :test #'equal))))
(when c
(unless (assoc c (cdr(assoc b (cdr(assoc a vocab :test #'equal :test #'equal
)):test #'equal)):test #'equal)
(pushnew (cons c '()) (cdr(assoc b (cdr(assoc a vocab :test #'equal
:test #'equal)):test #'equal)))))
(when d
(unless (assoc d (cdr(assoc c (cdr(assoc b (cdr(assoc a vocab :test #'equal
:test #'equal)):test #'equal)):test #'equal)):test #'equal)
(pushnew (cons d '()) (cdr(assoc c (cdr(assoc b (cdr(assoc a vocab :test
#'equal :test #'equal)):test #'equal)):test #'equal)))))
(when e
(unless (assoc e (cdr(assoc d (cdr(assoc c (cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal)
(pushnew (cons e '()) (cdr(assoc d (cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)))))
(when f
(unless (assoc f (cdr(assoc e (cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal))
:test #'equal)
(pushnew (cons f '()) (cdr(assoc e (cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal)))))
(when g
(unless (assoc g (cdr(assoc f (cdr(assoc e(cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal))
:test #'equal)):test #'equal)
(pushnew (cons g '()) (cdr(assoc f (cdr(assoc e(cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal)):test #'equal))))))
In the reple I put:
*(place-down "this" "is" "it" "the" "life" "we" "live")
* vocab
=> (("this" ("is" ("it" ("the" ("life" ("we" ("live"))))))))
The example looks like something REDUCE can solve.
(defun place-down (&rest strings)
(reduce (lambda (string accumulator)
(if accumulator
(list string accumulator)
(list string)))
strings
:initial-value nil
:from-end t))
REDUCE with an explicit :initial-value argument is the case where the given reducing function is called in the most uniform way; otherwise, that function can be called with zero or two arguments, and can even not be called at all if the list has a single element (thank you #jkiiski). If the accumulator is NIL, we discard it. Tests:
(place-down "this" "is" "it" "the" "life" "we" "live")
=> ("this" ("is" ("it" ("the" ("life" ("we" ("live")))))))
(place-down "this" "is" "it")
=> ("this" ("is" ("it")))
(place-down "this")
=> ("this")
(place-down)
=> NIL
The :from-end t arguments makes the operation right-associative.
CL-USER 8 > (loop with result = nil
for l in (reverse '("this" "is" "it" "the" "life" "we" "live"))
do (setf result (list (cons l result)))
finally (return result))
(("this" ("is" ("it" ("the" ("life" ("we" ("live"))))))))
or
CL-USER 9 > (let ((result nil)
(list '("this" "is" "it" "the" "life" "we" "live")))
(dolist (l (reverse list) result)
(setf result (list (cons l result)))))
(("this" ("is" ("it" ("the" ("life" ("we" ("live"))))))))
This question is related to the Chapter 6 code of Conrad Barski's Book, Land of Lisp.
The code is the following
(defun tweak-text (lst caps lit)
(when lst
(let ((item (car lst))
(rest (cdr lst)))
(cond ((eq item #\space) (cons item (tweak-text rest caps lit)))
((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
((eq item #\") (tweak-text rest caps (not lit)))
(lit (cons item (tweak-text rest nil lit)))
((or caps lit) (cons (char-upcase item) (tweak-text rest nil lit)))
(t (cons (char-downcase item) (tweak-text rest nil nil)))))))
Now look at the (lit ..) part and the stuff below it .. ((or caps nil) ..), so my question is the following
if lit is ever true, it will be will be evaluated in the former expression stated
if it is not true, the latter expression will always evaluate to (or caps false) => (or caps false) which is pretty much useless?
So shouldn't the latter expression simply be (caps (cons (char ...)) ?
This book has been read by thousands so I must be wrong about something and I'm not John Bell.
Yes, the simpler expression is equivalent. It is mentioned in the page 97 errata http://landoflisp.com/errata.html
One of the problems is the use of recursion, which limits the length of lists the function is able to process.
(defun tweak-text (list &aux (caps t) (lit nil))
(mapcon (lambda (c)
(case c
(#\space (list c))
((#\! #\? #\.)
(setf caps t)
(list c))
(#\"
(setf lit (not lit))
())
(otherwise
(cond (lit (setf caps nil) (list c))
(caps (setf caps nil) (list (char-upcase c)))
(t (setf caps nil lit nil)
(list (char-downcase c)))))))
list))
In other words, is it possible to locally define a function in a way similar to how flet or labels does it? My final goal is to have a macro similar to labels which instead of regular functions uses instances of funcallable-standard-class and not having to use funcall. A use-case might look like the one below:
(funcallable-let ((foo func-class :initargs ...))
(foo ...))
symbol-macrolet seems to only expand when not in the head position. If I try (setf (symbol-function 'foo) (make-instance 'some-funcallable-class)) this sets it globally for this symbol an not for the scope of the enclosing let.
Here's what I could get so far (but it doesn't work because macrolet wouldn't expand in this scenario...)
(defclass func ()
((state :initarg :state :accessor state-of))
(:metaclass sb-mop:funcallable-standard-class))
(defmethod initialize-instance :after ((this func) &rest initargs)
(declare (ignore initargs))
(sb-mop:set-funcallable-instance-function
this (lambda ()
(format t "~&I am: ~s, my state is: ~s" this (state-of this)))))
(defmacro funcallable-let (bindings &body body)
(loop :for binding :in bindings
:for name := (car binding)
:for class := (cadr binding)
:for init-args := (cddr binding)
:collect `(,name (make-instance ',class ,.init-args)) :into classes
:collect `(,name (&rest args) (list 'apply '',name args)) :into macrolets
:collect name :into ignorables
:finally
(return
`(let ,classes
(declare (ignorable ,#ignorables))
(macrolet ,macrolets
,#body)))))
(defun test-funcallable-let ()
(funcallable-let ((f func :state :f-state)
(g func :state :g-state))
(f) (funcall 'g)))
This is somewhat modified Lars' Brinkoff macro:
(defmacro funcallable-let (bindings &body body)
(loop
:for binding :in bindings
:for symbol := (gensym)
:for name := (car binding)
:for class := (cadr binding)
:for init-args := (cddr binding)
:collect `(,symbol (make-instance ',class ,.init-args)) :into lets
:collect `(,name (&rest args) (apply ',symbol args)) :into flets
:collect symbol :into ignorables
:finally
(return
`(let ,lets
(declare (ignorable ,#ignorables))
(flet ,flets ,#body)))))
Which wouldn't work either.
So, we want the value of f to be the funcallable object, so that things like (setf (state-of f) new-state) work, but also a macro definition for f, so that (f 1 2 3) expands to (funcall f 1 2 3). Let's write some direct code first. First, your func definition, but with a slightly different funcallable instance function, so that we can pass some arguments in and see what they are:
(defclass func ()
((state :initarg :state :accessor state-of))
(:metaclass sb-mop:funcallable-standard-class))
(defmethod initialize-instance :after ((this func) &rest initargs)
(declare (ignore initargs))
(sb-mop:set-funcallable-instance-function
this (lambda (&rest args)
(format t "~&I am: ~s, my state is: ~s, my args were ~s" this (state-of this) args))))
Then, we can write the code that we'd want the funcallable-let to expand into. As the output shows, f in a head position ends up being a call to the funcallable instance, but f in a non head position is a variable that has the funcallable instance as a value, so you can, e.g., (setf (state-of f) new-state):
(let ((f (make-instance 'func :state 34)))
(macrolet ((f (&rest args)
`(funcall f ,#args)))
(f 1 2 3)
(setf (state-of f) 89)
(f 4 5 6)))
; I am: #<FUNC {1002A0B329}>, my state is: 34, my args were (1 2 3)
; I am: #<FUNC {1002A0B329}>, my state is: 89, my args were (4 5 6)
That seems good. Now we just need to macroify it:
(defmacro funcallable-let (bindings &body body)
`(let (,#(loop :for (name . initargs) :in bindings
:collect `(,name (make-instance 'func ,#initargs))))
(macrolet (,#(loop :for (name . initargs) :in bindings
:collect `(,name (&rest args)
`(funcall ,',name ,#args))))
,#body)))
The macroexpansion looks right:
CL-USER> (pprint (macroexpand '(funcallable-let ((f :state 34))
(f 1 2 3))))
(LET ((F (MAKE-INSTANCE 'FUNC :STATE 34)))
(MACROLET ((F (&REST ARGS)
`(FUNCALL F ,#ARGS)))
(F 1 2 3)))
And the behavior seems right (you can call with (f ...) or with (funcall f ...), and you can (setf (state-of f) ...):
CL-USER> (funcallable-let ((f :state 34))
(f 1 2 3)
(setf (state-of f) 89)
(f 4 5 6)
(setf (state-of f) 62)
(funcall f 7 8 9))
I am: #<FUNC {1002BEC389}>, my state is: 34, my args were (1 2 3)
I am: #<FUNC {1002BEC389}>, my state is: 89, my args were (4 5 6)
I am: #<FUNC {1002BEC389}>, my state is: 62, my args were (7 8 9)
NIL
I'm not sure what you are trying to do, but maybe this?
(defmacro funcallable-let (bindings &body body)
(let ((gensyms (loop repeat (length bindings) collect (gensym))))
`(let ,(loop for (name value) in bindings and g in gensyms
collect `(,g ,value))
(flet ,(loop for (name value) in bindings and g in gensyms
collect `(,name (&rest args) (apply ,g args)))
,#body))))
Sample usage:
(funcallable-let ((foo (make-instance 'some-funcallable-class :initargs ...)))
(foo ...))
For a similar problem see GENERIC-FLET and GENERIC-LABELS of CLtL2 and why it was removed in ANSI Common Lisp.
http://www.lispworks.com/documentation/HyperSpec/Issues/iss181_w.htm
I'm learning about the macro system in Scheme and I thought implementing curried functions would be a good start. This is what I cooked up:
(define-syntax function
(syntax-rules ()
((_ () body ...) (lambda () body ...))
((_ (param) body ...) (lambda (param) body ...))
((_ (param_1 param_2 params ...) body ...) (lambda (param_1 . rest)
(let ((k (function (param_2 params ...) body ...)))
(if (null? rest) k (apply k rest)))))
((_ name params body ...) (define name (function params body ...)))))
This code works as expected to. For example I can define an add function as follows:
(function add (x y) (+ x y))
Then I can call it normally:
(add 2 3) ; => 5
In addition I can easily partially apply it:
(map (add 10) '(2 3 5 7)) ; => (12 13 15 17)
Now I'm contemplating to allow functions with rest parameters to be curried. So I added a new syntax rule:
((_ (param . params) body ...) (lambda (param . params) body ...))
Unfortunately when I try to create a function using this rule it gives me an error:
(function add (x . y) (apply + `(,x ,#y)))
This is the error message:
Error: invalid syntax in macro form: (x . y)
Call history:
<eval> (##sys#= len7 0)
<eval> (loop11 (##sys#cdr l6) (##sys#+ len7 -1))
<eval> (##sys#cdr l6)
<eval> (##sys#+ len7 -1)
<eval> (##sys#= len7 0)
<eval> (loop11 (##sys#cdr l6) (##sys#+ len7 -1))
<eval> (##sys#cdr l6)
<eval> (##sys#+ len7 -1)
<eval> (##sys#= len7 0)
<eval> (##sys#eq? l6 (quote ()))
<eval> (##sys#car tail15)
<eval> (##sys#cdr tail15)
<eval> (##sys#cons (rename14 (##core#syntax lambda)) (##sys#cons param body))
<eval> (rename14 (##core#syntax lambda))
<eval> (##sys#cons param body)
<syntax> (##core#lambda add (x . y) (apply + (quasiquote ((unquote x) (unquote-splicing y))))) <-
What am I doing wrong?
[The comment is correct; this answer is not currying, it is partial evaluation.]
Just so you know, you don't need to use define-syntax to support currying. Generally using syntax when you don't need to is frowned upon because 1) syntax introduces different evaluation rules and 2) syntax can't be used as a value.
Here are two implementations, one for (left) curry and one for right curry:
(define (curry func . curry-args)
(lambda args
(apply func (append curry-args args))))
(define (rcurry func . curry-args)
(lambda args
(apply func (append args curry-args))))
Use this as for example:
> (define add-5 (curry + 5))
> (add-5 5)
10
You don't say what version of Scheme you're using. It appears that it doesn't support 'dot' patterns in macros.
In Racket, it looks like your code works:
#lang racket
(define-syntax function
(syntax-rules ()
((_ () body ...) (lambda () body ...))
((_ (param) body ...) (lambda (param) body ...))
((_ (param_1 param_2 params ...) body ...) (lambda (param_1 . rest)
(let ((k (function (param_2 params ...) body ...)))
(if (null? rest) k (apply k rest)))))
((_ (param . params) body ...) (lambda (param . params) body ...))
((_ name params body ...) (define name (function params body ...)))))
(function add (x . y) (apply + `(,x ,#y)))
(add 2 3)
running this produces the answer
5
.
BTW, I think I would have written this as two macros; the dual-purposing of the name 'function' is a bit sketchy... :)