What is the most elegant way to slightly tweak what the member function does in Common Lisp? - refactoring

The member function works like this with strings:
CL-USER> (member "a" '("a" "b" "c") :test #'equalp)
("a" "b" "c")
CL-USER> (member "a" '( "b" "c") :test #'equalp)
NIL
I would like to slightly change its behavior. When the element is not part of the list, I would like to have as a return the element itself and not nil. Moreover, if the element is indeed part of the list, I would like to have nil.
So, something like:
CL-USER> (tweaked-member "a" '("a" "b" "c") :test #'equalp)
NIL
CL-USER> (tweaked-member "a" '( "b" "c") :test #'equalp)
"a"
Thus, I did this naive approach:
(defun so-question (str str-list)
(if (member str str-list :test #'string=)
nil
str))
Is there a more elegant way of doing this?
Maybe using member-if-not and :key?

I don't know if this is more elegant; your "naive" solution might be more clear, but you could do this:
(defun tweaked-member (needle haystack)
(and (not (member needle haystack :test #'equalp)) needle))
CL-USER> (tweaked-member "a" '("a" "b" "c"))
NIL
CL-USER> (tweaked-member "a" '("b" "c"))
"a"
You could use find in place of member:
(defun tweaked-member (needle haystack)
(and (not (find needle haystack :test #'equalp)) needle))
I didn't notice until now that my version does not take a :test argument, as you asked. But:
(defun tweaked-member (needle haystack &rest args)
(and (not (apply #'member needle haystack args)) needle))
CL-USER> (tweaked-member "a" '("a" "b" "c") :test #'equalp)
NIL
CL-USER> (tweaked-member "a" '("b" "c") :test #'equalp)
"a"

(defun tweaked-member (&rest args)
(if (apply #'member args) nil (car args)))
It is not more elegant, but it takes all keywords which member takes.

Related

Combining words list to a para in Racket

I have to combine a list of words to produce a para. I managed following:
(define (wordlist2para wl)
(define str " ")
(for ((w wl))
(set! str (string-append str w " ")))
(string-trim str))
(wordlist2para '("this" "is" "a" "test"))
Output:
"this is a test"
It works but it is not functional. How can I write functional code for this?
If I wanted to do it explicitly and not use string-join, I would recurse and use three cases:
The empty list produces the empty string
A one-element list produces its sole element (this avoids having a trailing separator)
Otherwise, append the car and a space to the recursion on the cdr.
Like this:
(define (wordlist2para ws)
(cond ((null? ws) "")
((null? (cdr ws)) (car ws))
(else (string-append (car ws) " " (wordlist2para (cdr ws))))))
No need of recursion or loop, there is the primitive function string-join for this (see the manual):
(define (wordlist2para wl)
(string-join wl " "))
(wordlist2para '("this" "is" "a" "test"))
;; -> "this is a test"
We have standard procedures that does this:
;; racket library or srfi/13
(string-join '("this" "is" "it")) ; ==> "this is it"
There is a way to always rewrite these that are quite simple. I'd like to step away from rackets great feature set and just focus on simple scheme with recursive procedures. Notice that in your loop you are changing 2 things wl gets smaller, str gets longer, so lets make that:
; all things that change as arguments
(define (wordlist2para-loop wl str)
(if (null? wl)
str
(wordlist2para-loop (cdr wl)
(string-append str (car wl) " "))))
Now for we just replace the loop:
(define (wordlist2para wl)
(wordlist2para-loop wl ""))
From here on you can move the helper to become local or perhaps make it a named let or any other refactoring, but it doesn't really change the resulting compiled result in an implementation much, just how it looks.
Notice I haven't fixed the bug where there is only one word. (wordlist2para '("this")) ; ==> "this " The result is actually exactly the same as in your, only that it's tail recursive and functional.
I am not sure if following can be called functional but it does use some higher order functions:
(define (wordlist2para wl)
(string-trim
(apply string-append
(map (lambda(x) (string-append x " ")) wl))))
(wordlist2para '("this" "is" "a" "test"))
Output:
"this is a test"

How to remove sequential matches in vector in Clojure?

Let's say I have a vector ["a" "b" "c" "a" "a" "b"]. If given a sequence ["a" "b"], how can I remove all instances of that sequence (in order)? Here, the result would just be ["c" "a"].
If sequences that need to be removed are known in advance, core.match may be useful for your task:
(require '[clojure.core.match :refer [match]])
(defn remove-patterns [seq]
(match seq
["a" "b" & xs] (remove-patterns xs)
[x & xs] (cons x (remove-patterns xs))
[] ()))
(remove-patterns ["a" "b" "c" "a" "a" "b"]) ;; => ("c" "a")
The short answer is to treat it as a string and do a regex remove:
(defn remove-ab [v]
(mapv str (clojure.string/replace (apply str v) #"ab" "")))
(remove-ab ["a" "b" "c" "a" "a" "b"])
=> ["c" "a"]
The long answer is to implement your own regex state machine by iterating through the sequence, identifying matches, and returning a sequence without them.
Automat can help with making your own low level regex state machine:
https://github.com/ztellman/automat
Instaparse can be used to make rich grammas:
https://github.com/Engelberg/instaparse
You don't really need a library for such a small match, you can implement it as a loop:
(defn remove-ab [v]
(loop [[c & remaining] v
acc []
saw-a false]
(cond
(nil? c) (if saw-a (conj acc "a") acc) ;; terminate
(and (= "b" c) saw-a) (recur remaining acc false) ;; ignore ab
(= "a" c) (recur remaining (if saw-a (conj acc "a") acc) true) ;; got a
(and (not= "b" c) saw-a) (recur remaining (conj (conj acc "a") c) false) ;; keep ac
:else (recur remaining (conj acc c) false)))) ;; add c
But getting all the conditions right can be tricky... hence why a formal regex or state machine is advantageous.
Or a recursive definition:
(defn remove-ab [[x y & rest]]
(cond
(and (= x "a") (= y "b")) (recur rest)
(nil? x) ()
(nil? y) [x]
:else (cons x (remove-ab (cons y rest)))))
Recursive solution for a 2-element subsequence:
(defn f [sq [a b]]
(when (seq sq)
(if
(and
(= (first sq) a)
(= (second sq) b))
(f (rest (rest sq)) [a b])
(cons (first sq) (f (rest sq) [a b])))))
not exhaustively tested but seems to work.
A simple solution using lazy-seq, take and drop working for any finite subseq and any (including infinite) sequence that needs to be filtered:
(defn remove-subseq-at-start
[subseq xs]
(loop [xs xs]
(if (= (seq subseq) (take (count subseq) xs))
(recur (drop (count subseq) xs))
xs)))
(defn remove-subseq-all [subseq xs]
(if-let [xs (seq (remove-subseq-at-start subseq xs))]
(lazy-seq (cons (first xs) (remove-subseq subseq (rest xs))))
()))
(deftest remove-subseq-all-test
(is (= ["c" "a"] (remove-subseq-all ["a" "b"] ["a" "b" "a" "b" "c" "a" "a" "b"])))
(is (= ["a"] (remove-subseq-all ["a" "b"] ["a"])))
(is (= ["a" "b"] (remove-subseq-all [] ["a" "b"])))
(is (= [] (remove-subseq-all ["a" "b"] ["a" "b" "a" "b"])))
(is (= [] (remove-subseq-all ["a" "b"] nil)))
(is (= [] (remove-subseq-all [] [])))
(is (= ["a" "b" "a" "b"] (->> (remove-subseq-all ["c" "d"] (cycle ["a" "b" "c" "d"]))
(drop 2000000)
(take 4))))
(is (= (seq "ca") (remove-subseq-all "ab" "ababcaab"))))
If you can ensure that the input is a vector, we can use subvec to check on every element whether the following subvector of the same length matches the pattern. If so, we omit it, otherwise we move ahead to the next element in the vector:
(let [pattern ["a" "b"]
source ["a" "b" "c" "a" "a" "b"]]
(loop [source source
pattern-length (count pattern)
result []]
(if (< (count source) pattern-length)
(into [] (concat result source))
(if (= pattern (subvec source 0 pattern-length))
; skip matched part of source
(recur (subvec source pattern-length) pattern-length result)
; otherwise move ahead one element and save it as result
(recur (subvec source 1) pattern-length
(conj result (first source)))))))
With general sequences, you could use the same approach, substituting take and drop as appropriate.

Format over list: use arguments that aren't in list

Here's a code snippet that I wrote, but doesn't work:
(let ((separator "|")
(text '("Just" "do" "it" "!")))
(format t "~{~A~A~%~}" text separator))
The output should look like:
Just|
do|
it|
!|
However, it won't work like that - when I'm inside ~{~}, I don't know how I can add elements from outside the list. I could do this:
(format t "~{~A|~%~}" text)
but this does not allow me to use separator from variable, and that's what I'm after.
Now I know that I could merge text with separator, by adding separator in every even place, but that looks ugly to me. Is there other way to do it in format?
This is a hack:
CL-USER 49 > (let ((separator "|")
(text '("Just" "do" "it" "!")))
(format t
(concatenate 'string "~{~A" separator "~%~}")
text))
Just|
do|
it|
!|
Escaping tilde in the separator string:
CL-USER 56 > (flet ((fix-tilde (string)
(with-output-to-string (s)
(loop for c across string
when (char= c #\~)
do (write-string "~~" s)
else do (write-char c s)))))
(let ((separator (fix-tilde "~a~a"))
(text '("Just" "do" "it" "!")))
(format t
(concatenate 'string "~{~A" separator "~%~}")
text)))
Just~a~a
do~a~a
it~a~a
!~a~a
You could use a Tilde Slash format directive, that allows a user-defined function as format specifier. This is just to give you a possible example, many variations on this are possible:
CL-USER> (defvar *separator* " ")
*SEPARATOR*
CL-USER> (defun q(stream arg &rest args)
(declare (ignore args))
(format stream "~a~a" arg *separator*))
Q
CL-USER> (let ((*separator* "|")
(text '("Just" "do" "it" "!")))
(format t "~{~/q/~%~}" text))
Just|
do|
it|
!|
NIL
CL-USER> (let ((*separator* "+++")
(text '("Just" "do" "it" "!")))
(format t "~{~/q/~%~}" text))
Just+++
do+++
it+++
!+++
NIL
CL-USER>
Changing the answer from renzo a bit: if we use SPECIAL declarations, we don't need the global variable:
(defun %d1 (stream arg &rest args)
(declare (ignore args)
(special delim))
(princ arg stream)
(princ delim stream))
(defun my-print (list delim)
(declare (special delim))
(format nil "~{~/%d1/~%~}" list))

How to convert from var to string

I try to do something like that:
assume x=
(define foo 5)
I need to do:
(string-append "a" "b" (cadr x))
(when x no knowing..)
How can I convert the var (cadr x) to string or there is other sulotion?
Thanks
For converting a number to a string use the number->string procedure:
(number->string 5)
=> "5"
And for converting a symbol to a string use the symbol->string procedure:
(symbol->string 'x)
=> "x"
Some examples, pick the one that better reflects your needs - because it's not clear at all what you intended to ask in the question:
(define foo 5)
(string-append "a" "b" (number->string foo))
=> "ab5"
(define x '(1 5))
(string-append "a" "b" (number->string (cadr x)))
=> "ab5"
(define x '(define foo 5))
(string-append "a" "b" (number->string (caddr x)))
=> "ab5"
(define x '(define foo 5))
(string-append "a" "b" (symbol->string (cadr x)))
=> "abfoo"

Binding function name as argument inside of macro

So I'm playing around with a simple doc-string system as a warmup in scheme, the idea being you could do something like:
(def-with-doc (foo a b)
(desc "Takes two parameters and sums them")
(param 'a "First parameter")
(param 'b "Second parameter")
(return "Sum of arguments")
(+ a b)
Which would be turned into:
(begin
(begin
(desc 'foo "Takes two parameters and sums them")
(param 'foo 'a "First parameter")
(param 'foo 'b "Second parameter")
(return 'foo "Sum of arguments"))
(begin
(define (foo a b)
(+ a b))))
The macro I've written:
(define doc-symbol-list '(param desc return))
(define-macro (def-with-doc arg-list #!rest body)
;; Loop over body, splitting into doc calls and everything else
(let loop ((remaining body) (docs '()) (main '()))
(if (null? remaining)
; Reverse accumulation order of docs and main
; And build re-ordered begin tree
(let ((docs (cons 'begin (reverse docs)))
(main (cons 'begin (reverse main))))
(cons 'begin `(,docs ,`(define ,arg-list ,main))))
; Accumulate into docs list if expression is reserved
; Otherwise into the body list
(let ((sexp (car remaining)) (rest (cdr remaining)))
(if (member (car sexp) doc-symbol-list)
(loop rest (cons sexp docs) main)
(loop rest docs (cons sexp main)))))))
Takes the definition, moves the param/desc/return calls into the top level wrapped in begin statements and reconstructs the body of the function, that way the doc string calls are only executed once when the file is loaded rather than each time the function is called. I know I could manually put the doc-string stuff at the top level but I'm trying to emulate Python doc-strings.
Anyhow, the last think that I need to do is bind the function name (foo in above) into the doc-string calls, so that (param 'a "First parameter") becomes (param 'foo 'a "First parameter") so that the function each call is associated with is known. This is where I'm having trouble, every attempt I've made has failed to do what I want.
I would suggest using define-syntax as it is hygienic and its syntax-rules are pretty easy to understand. syntax-rules are in a pattern-to-result format; if you can understand cond, you can understand syntax-rules.
I think this does what you want, judging by the before and after snippets.
(define-syntax def-with-doc
(syntax-rules ()
;; this pattern
[(_ (func params ...)
(tag attributes ...)
...
code)
;; is converted into
(begin
(tag (quote func) attributes ...)
...
(define (func params ...)
code))]))
Forgive my terminology because I've never used doc-strings.
Basically, this matches against anything that follows that pattern of a function + params def, 0 or more tags with attributes, and a code statement.
Then, it just rearranges everything.

Resources