Does Lisp have something like Haskell's takeWhile function? - haskell

I'm new to Common Lisp. In Haskell, you can do a little something like this:
Prelude> takeWhile (<= 10) [k | k <- [1..]]
[1,2,3,4,5,6,7,8,9,10]
Is this possible in Lisp? Not necessarily with an infinite list, but with any list.

You could use LOOP:
(setq *l1* (loop for x from 1 to 100 collect x))
(loop for x in *l1* while (<= x 10) collect x)
If you really need it as a separate function:
(defun take-while (pred list)
(loop for x in list
while (funcall pred x)
collect x))
And here we are:
T1> (take-while (lambda (x) (<= x 10)) *l1*)
(1 2 3 4 5 6 7 8 9 10)
But if we compare:
(loop for x in *l1* while (<= x 10) collect x)
(take-while (lambda (x) (<= x 10)) *l1*)
I think I would just stick with loop.
For infinite sequences, you could take a look at Series:
T1> (setq *print-length* 20)
20
T1> (setq *l1* (scan-range :from 1))
#Z(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ...)
T1> (until-if (lambda (x) (> x 10)) *l1*)
#Z(1 2 3 4 5 6 7 8 9 10)

This should do...
(defun take-while (list test)
(and list (funcall test (car list))
(cons (car list) (take-while (cdr list) test))))
(take-while '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) (lambda (x) (< x 10)))
--> (1 2 3 4 5 6 7 8 9)
However this "natural" implementation is not tail-recursive and could crash for big lists.
An explicit push-nreverse approach (a common pattern) could be
(defun take-while (list test)
(do ((res nil))
((or (null list) (not (funcall test (car list))))
(nreverse res))
(push (car list) res)
(setf list (cdr list))))
A recursive (but tail-recursive, therefore probably ok with most CL implementations) could IMO be the following:
(defun take-while (list test)
(labels ((rec (res x)
(if (and x (funcall test (car x)))
(rec (cons (car x) res) (cdr x))
(nreverse res))))
(rec nil list)))
Note that however it's not guaranteed that a common lisp implementation will handle tail-call optimizations.

The CL-LAZY library implements lazy calling for Common Lisp and provides a take-while function that is laziness aware. You can install it with Quicklisp and try it out.

Some languages provide a Haskell-style list API as 3rd party libraries, with or without support for infinite streams.
Some examples:
Clojure's sequences: take-while
Scala has something
Remember that takeWhile is relatively easy to implement over a sequence, and is given in Haskell as:
takeWhile _ [] = []
takeWhile p (x:xs)
| p x = x : takeWhile p xs
| otherwise = []

You can have a lazy evaluation in common lisp using closures (from Paul Graham's On Lisp):
(defun lazy-right-fold (comb &optional base)
"Lazy right fold on lists."
(labels ((rec (lst)
(if (null lst)
base
(funcall comb
(car lst)
#'(lambda () (rec (cdr lst)))))))
#'rec))
Then, take-while becomes:
(defun take-while (pred lst)
(lazy-right-fold #'(lambda (x f) (
(if (test x)
(cons x (funcall f))
(funcall f)))
nil))

Related

NLP with Racket

I am studying NLP with Racket and Dr. Racket.
I am working with this code:
#lang racket
(define english-1
'((Initial (1))
(Final (9))
(From 1 to 3 by NP)
(From 1 to 2 by DET)
(From 2 to 3 by N)
(From 3 to 4 by BV)
(From 4 to 5 by ADV)
(From 4 to 5 by |#|)
(From 5 to 6 by DET)
(From 5 to 7 by DET)
(From 5 to 8 by |#|)
(From 6 to 7 by ADJ)
(From 6 to 6 by MOD)
(From 7 to 9 by N)
(From 8 to 8 by MOD)
(From 8 to 9 by ADJ)
(From 9 to 4 by CNJ)
(From 9 to 1 by CNJ)))
(define (getf x y)
(if (eq? (car x) y)
(cadr x)
(getf (cdr x) y)))
(define (initial-nodes network)
(list-ref (assoc 'Initial network) 1))
(define (final-nodes network)
(list-ref (assoc 'Final network) 1))
(define (transitions network)
(filter (lambda (x) (eq? (car x) 'From)) network))
(define (trans-node transition)
(getf transition 'From))
(define(trans-newnode transition)
(getf transition 'to))
(define (trans-label transition)
(getf transition 'by))
(define abbreviations
'((NP kim sandy lee)
(DET a the her)
(N consumer man woman)
(BV is was)
(CNJ and or)
(ADJ happy stupid)
(MOD very)
(ADV often always sometimes)))
(define (recognize network tape)
;; returns t if sucessfully recognizes tape - nil otherwise
(call/cc (lambda (return)
(define (recognize-next node tape network)
(if (and (null? tape) (member node (final-nodes network)))
(return #t) ; success
(for ([transition (transitions network)])
;; try each transition of the network
(when (equal? node (trans-node transition)) ; if it starts at the right node
(for ([newtape (recognize-move (trans-label transition) tape)])
;; try each possible new value of tape
(recognize-next (trans-newnode transition) newtape network))))))
(for ([initialnode (initial-nodes network)])
(recognize-next initialnode tape network))
null))) ; failed to recognize
(define (recognize-move label tape)
(if (or (eq? label (car tape))
(member (car tape) (assoc label abbreviations)))
(list (cdr tape))
(if (eq? label '|#|)
(list tape)
null)))
(require racket/trace)
(trace recognize-move)
(recognize-move english-1 '(hahaha))
The code seems to be mostly fine. However, I keep getting a error messaging related to the recognize-move function:
member: not a proper list: #f
And I thought I was dealing with lists... How can I solve this?
The problem is with this form:
(member (car tape) (assoc label abbreviations))
If assoc does not find anything the result is #f. (member 'anything #f) will not work. In Common Lisp false is the same as an empty list so member on false will work, but not in Scheme. You can perhaps make sure it's a list like this:
(member (car tape) (or (assoc label abbreviations) '()))
This is code translated from Common Lisp. In CL, nil is false and is also the empty list, (). In Racket, #f is false and is not the same as (). assoc wants to return false if it does not find a match: because of the way CL puns on false and the empty list, this means that (member ... (assoc ...)) will always work. In Racket it won't: you need to check to see if assoc failed to find a match.

A Replace Function in Lisp That Duplicates Mathematica Functionality

What is the easiest way to accomplish the following in a Mathematica clone or in any version of Lisp(any language is probably okay actually even Haskell)? It doesn't appear any lisps have a similar replace function.
Replace[{
f[{x, "[", y, "]"}],
f#f[{x, "[", y, y2, "]"}]
}
, f[{x_, "[", y__, "]"}] :> x[y],
Infinity]
and a return value of {x[y], f[x[y, y2]]}
It replaces all instances of f[{x_, "[", y__, "]"}] in args where x_ represents a single variable and y__ represents one or more variables.
In lisp the function and replacement would probably be the equivalent(forgive me I am not the best with Lisp). I'm looking for a function of the form (replace list search replace).
(replace
'(
(f (x "[" y "]"))
(f (f '(x "[" y y2 "]")))
)
'(f (x_ "[" y__ "]"))
'(x y)
)
and get a return value of ((x y) (f (x y y2))).
Let's give it another try.
First, install quicklisp and use it to fetch, install and load optima and alexandria.
(ql:quickload :optima)
(ql:quickload :alexandria)
(use-package :alexandria)
The functions from alexandria referenced below are ensure-list and last-elt. If you don't have them installed, you can use the following definitions:
(defun ensure-list (list) (if (listp list) list (list list)))
(defun last-elt (list) (car (last list)))
We define rules as functions from one form to another.
Below, the function tries to destructure the input as (f (<X> "[" <ARGS> "]"), where <ARGS> is zero or more form. If destructuring fails, we return NIL (we expect non-matching filters to return NIL hereafter).
(defun match-ugly-funcall (form)
(optima:match form
((list 'f (cons x args))
(unless (and (string= "[" (first args))
(string= "]" (last-elt args)))
(optima:fail))
`(,x ,#(cdr (butlast args))))))
(match-ugly-funcall '(f (g "[" 1 3 5 4 8 "]")))
; => (G 1 3 5 4 8)
Then, we mimic Mathematica's Replace with this function, which takes a form and a list of rules to be tried. It is possible to pass a single rule (thanks to ensure-list). If a list of list of rules is given, a list of matches should be returned (to be done).
(defun match-replace (form rules &optional (levelspec '(0)))
(setf rules (ensure-list rules))
(multiple-value-bind (match-levelspec-p recurse-levelspec-p)
(optima:ematch levelspec
((list n1 n2) (if (some #'minusp (list n1 n2))
(optima:fail)
(values (lambda (d) (<= n1 d n2))
(lambda (d) (< d n2)))))
((list n) (if (minusp n)
(optima:fail)
(values (lambda (d) (= d n))
(lambda (d) (< d n)))))
(:infinity (values (constantly t) (constantly t))))
(labels
((do-replace (form depth)
(let ((result
(and (funcall match-levelspec-p depth)
(some (lambda (r) (funcall r form)) rules))))
(cond
(result (values result t))
((and (listp form)
(funcall recurse-levelspec-p depth))
(incf depth)
(do (newlist
(e (pop form) (pop form)))
((endp form) (values form nil))
(multiple-value-bind (result matchedp) (do-replace e depth)
(if matchedp
(return (values (nconc (nreverse newlist)
(list* result form)) t))
(push e newlist)))))
(t (values form nil))))))
(do-replace form 0))))
And a test:
(match-replace '(a b (f (x "[" 1 2 3 "]")) c d)
#'match-ugly-funcall
:infinity)
; => (A B (X 1 2 3) C D)
; T
In order to replace all expressions instead of the first matching one, use this instead:
(defun match-replace-all (form rules &optional (levelspec '(0)))
(setf rules (ensure-list rules))
(multiple-value-bind (match-levelspec-p recurse-levelspec-p)
(optima:ematch levelspec
((list n1 n2) (if (some #'minusp (list n1 n2))
(optima:fail)
(values (lambda (d) (<= n1 d n2))
(lambda (d) (< d n2)))))
((list n) (if (minusp n)
(optima:fail)
(values (lambda (d) (= d n))
(lambda (d) (< d n)))))
(:infinity (values (constantly t) (constantly t))))
(labels
((do-replace (form depth)
(let ((result
(and (funcall match-levelspec-p depth)
(some (lambda (r) (funcall r form)) rules))))
(cond
(result result)
((and (listp form)
(funcall recurse-levelspec-p depth))
(incf depth)
(mapcar (lambda (e) (do-replace e depth)) form))
(t form)))))
(do-replace form 0))))
Oh boy, how Mathematica manages to obfuscate everything by applying its renown NIH approach.
Basically, you're looking for a function to perform string replacement according to some pattern. In most languages, this is accomplished with regular expressions.
For instance, in Common Lisp using the cl-ppcre library it will look something like this:
(cl-ppcre:regex-replace-all
;; regular expression you match against with groups
"f\\[{(x[^ ]*), \"\\[\", ((y[^ ]* ?)+), \"\\]\"}\\]"
;; your string
"{f[{x, \"[\", y, \"]\"}], f#f[{x, \"[\", y, y2, \"]\"}]}"
;; substitution expression using groups 1 & 2
"\\1[\\2]")
Surely, you can write a specialized 20-line function for this problem of matching and substituting subtrees using subst and recursion, but if all that you want is cases similar to the presented one you can get away with a simple regex-based approach.

"set! not an identifier" in Scheme

I am trying to modify the cdr of the car of an element of a list using set!, but I am getting an error: "set! not an identifier". Can anyone explain to me why this is happening? I am starting to work with objects by the way.
#lang racket
(define (multiset)
(let ((main-list '()))
(define (empty)
(eq? main-list '()))
(define (insert x)
(cond ((empty)
(set! main-list (cons (cons x 1) main-list)))
((= (car (car main-list)) x)
(begin (set! (cdr (car main-list))
(+ 1 (cdr (car main-list))))))
(else (cdr main-list))))
A multiset is represented as a list of pairs. For example, if I had a list '(1 1 1 2 2 2), the multiset representation would be '((1.3)(2.3))
The syntax of set! is
(set! <identifier> <expression>)
which is to say that the first form must be a symbol. In your code you are using:
(cdr (car main-list))
as the 'identifier' - hence the error.
Perhaps your background is CommonLisp and you are expecting set! to behave like setf? In Scheme there are separate functions for setting the 'car' and 'cdr' of a pair. Use set-car! and set-cdr!
> (define pair (cons 'car 'cdr))
> pair
(car . cdr)
> (set-car! pair 'foo)
> pair
(foo . cdr)
> (set-cdr! pair 'bar)
> pair
(foo . bar)
In R6RS (and probably R7RS) set-car! and set-cdr! can be found in the (rnrs mutable-pairs) library
GoZoner has given you the right explanation, but it is perfectly possible (and desirable) do avoid set! procedures. Here's an example of a procedure having the same result:
(define (rle lst)
(define (newpair c l res)
(if (> l 0) (cons (cons c l) res) res))
(let loop ((lst lst) (c #f) (l 0) (res '()))
(if (null? lst)
(reverse (newpair c l res))
(let ((n (car lst)))
(if (equal? c n)
(loop (cdr lst) c (add1 l) res)
(loop (cdr lst) n 1 (newpair c l res)))))))
such as
(rle '(1 1 1 2 2 2))
=> '((1 . 3) (2 . 3))

What's wrong with this code? (scheme)

I've set up a procedure in scheme that will analyze a list and return the middle index when the list is odd, and the average of the middle 2 values when the list is even. Here's what I have (these ones run perfectly fine by themselves):
(define (median-index-odd lst)
(define (median-index-iter1 lst times_carred)
(if (null? lst)
'()
(if (= times_carred (/ (+ (length lst) 1) 2))
(list (car lst))
(median-index-iter1 (cdr lst) (+ 1 times_carred)))))
(median-index-iter1 lst 0))
(define (median-index-even lst)
(define (median-index-iter2 lst times_carred)
(if (null? lst)
'()
(if (= times_carred (/ (length lst) 2))
(list (/ (+ (car lst) (cadr lst)) 2))
(median-index-iter2 (cdr lst) (+ 1 times_carred)))))
(median-index-iter2 lst 0))
Here's the actual procedure, without all the clutter from those helpers.
(define (median lst)
(if (null? lst)
'()
(if (even? lst)
(median-index-even lst)
(median-index-odd lst))))
However, when I try and run test cases, I get an error:
(display (median '(1 2 2 3 3 3 4 5))) (newline)
The object (1 2 2 3 3 3 4 5), passed as the first argument to integer-remainder, is not the correct type.
EDIT: Okay, yes, I completely overlooked the (even? (length lst)) part. I am currently debugging the helpers right now.
For starters this line is wrong, a list can not be even:
(if (even? lst)
A list's length, however, is a different matter:
(if (even? (length lst))
Also, in both procedures the comparison for determining if the list's mid point has been reached is wrong, you'll have to tweak this line in both helper procedures, because currently is not working:
(if (= times_carred ...
It'll be simpler if you start times_carred in 1 and change the condition to (>= times_carred (/ (length lst) 2)), the same comparison works for both cases.

Destructure a list two elements at a time (Clojure)

This problem takes many forms. For example, given the input '(1 2 3 4 5 6), we might want to swap the values between even and odd pairs. The output would be '(2 1 4 3 6 5).
In Haskell, this is rather easy:
helper [] = []
helper [x] = [x]
helper (x : y : ys) = y : x : helper ys
I wrote some Clojure code to accomplish the same task, but I feel that there is probably a cleaner way. Any suggestions on how to improve this?
(defn helper [[x y & ys]]
(cond
(nil? x) (list)
(nil? y) (list x)
:else (lazy-seq (cons y (cons x (helper ys))))))
Ideally the list would be consumed and produced lazily. Thanks.
(for [[a b] (partition 2 '(1 2 3 4 5 6))
i [b a]]
i)
OR something resembling the haskell version:
(defn helper
([] (list))
([x] (list x))
([x y & r] (concat [y x] (apply helper r))))
(apply helper '(1 2 3 4 5 6))
Avoiding intermediate object creation (vectors / seqs to be concatenated) and in direct correspondence to the Haskell original while handling nil items in the input (which the approach from the question text doesn't):
(defn helper [[x & [y & zs :as ys] :as xs]]
(if xs
(lazy-seq
(if ys
(cons y (cons x (helper zs)))
(list x)))))
Normally I'd use something like tom's answer though, only with mapcat rather than flatten:
(defn helper [xs]
(mapcat reverse (partition-all 2 xs)))
You need to use partition-all rather than partition to avoid dropping the final element from lists of odd length.
This is one lazy way to do it:
user=> (mapcat reverse (partition 2 '(1 2 3 4 5 6)))
(2 1 4 3 6 5)

Resources