Sorting by two attributes in common lisp - sorting

I need assistance sorting by two attributes in common lisp.
Say I had a list:
(1 x)(2 y)(1 x)(2 x)(3 y)(2 y) I am trying to sort by both string and integer.
So the result would be (1 x)(1 x)(2 x)(2 y)(2 y)(3 y).
Currently I can sort by either variable or number but not both. If I enter (2 x)(1 x)(1 y)(2 x)(1 y) I get (1 Y)(1 Y)(2 X)(1 X)(2 X) returned not (1 Y)(1 Y)(1 X)(2 X)(2 X)
The code I am using is:
(defun get-number (term)
(destructuring-bind (number variable) term
(declare (ignore variable))
number))
(defun get-variable (term)
(destructuring-bind (number variable) term
(declare (ignore number))
variable))
(defun varsort (p1)
(sort (copy-list p1) 'string> :key 'get-variable))
My question is how could I sort by the term as a whole so (1 X) not just 1 or X.

You can do this by composing predicates. If you have a predicate that can compare variables, and a predicate that can compare coefficients, then you can easily create a new predicate that checks with one, returning a definite answer if the first predicate provides a definite answer, or deferring to the second predicate, in the case that it doesn't. This will be reusable for other applications, too:
(defun and-then (original-predicate next-predicate)
"Returns a new predicate constructed from ORIGINAL-PREDICATE and
NEXT-PREDICATE. The new predicate compares two elements, x and y, by
checking first with ORIGINAL-PREDICATE. If x is less than y under
ORIGINAL-PREDICATE, then the new predicate returns true. If y is less
than x under ORIGINAL-PREDICATE, then the new predicate returns false.
Otherwise, the new predicate compares x and y using NEXT-PREDICATE."
(lambda (x y)
(cond
((funcall original-predicate x y) t)
((funcall original-predicate y x) nil)
(t (funcall next-predicate x y)))))
Then it's easy enough to make a call to (and-then 'variable< 'coefficient<). First, some accessors and predicates:
(defun term-coefficient (term)
(first term))
(defun coefficient< (term1 term2)
(< (term-coefficient term1)
(term-coefficient term2)))
(defun term-variable (term)
(second term))
(defun variable< (term1 term2)
(string< (term-variable term1)
(term-variable term2)))
Now the test:
(defparameter *sample*
'((1 x)(2 y)(1 x)(2 x)(3 y)(2 y)))
CL-USER> (sort (copy-list *sample*) 'coefficient<)
((1 X) (1 X) (2 Y) (2 X) (2 Y) (3 Y))
CL-USER> (sort (copy-list *sample*) 'variable<)
((1 X) (1 X) (2 X) (2 Y) (3 Y) (2 Y))
CL-USER> (sort (copy-list *sample*) (and-then 'variable< 'coefficient<))
((1 X) (1 X) (2 X) (2 Y) (2 Y) (3 Y))
You could define a compare-by function to create some of these predicate functions, which could make their definitions a bit simpler, or possibly removable altogether.
(defun compare-by (predicate key)
"Returns a function that uses PREDICATE to compare values extracted
by KEY from the objects to compare."
(lambda (x y)
(funcall predicate
(funcall key x)
(funcall key y))))
You could simply the predicate definitions:
(defun coefficient< (term1 term2)
(funcall (compare-by '< 'term-coefficient) term1 term2))
(defun variable< (term1 term2)
(funcall (compare-by 'string< 'term-variable) term1 term2))
or get rid of them altogether:
(defun varsort (p1)
(sort (copy-list p1)
(and-then (compare-by '< 'term-coefficient)
(compare-by 'string< 'term-variable))))

Two options:
stable-sort the result of varsort according to the get-number
define a custom comparison function to use within sort :
;; choose a better name
(compare-by-string-and-number (x y)
(let ((vx (get-variable x))
(vy (get-variable y)))
(or (string> vx vy)
(and (string= vx vy)
(> (get-number x)
(get-number y))))))
Joshua's answer is good way to write a generic comparison functions. And since you are manipulating tuples, you can be a little more specific and write the following:
(defun tuple-compare (comparison-functions)
(lambda (left right)
(loop for fn in comparison-functions
for x in left
for y in right
thereis (funcall fn x y)
until (funcall fn y x))))
For example:
(sort (copy-seq #((1 2) (2 3) (1 3) (2 1)))
(tuple-compare (list #'< #'<)))
=> #((1 2) (1 3) (2 1) (2 3))
You can take advantage of having different lengths for the lists involved: for example, you could only sort according to the first argument by giving a single comparison function. You can also create a circular list if you want to compare all available pairs of elements with the same comparison function.
(stable-sort (copy-seq #((1 2 4) (1 3 6) (1 2 6) (2 3 4) (1 3) (2 1)))
(tuple-compare (list* #'> (circular-list #'<))))
=> #((2 1) (2 3 4) (1 2 4) (1 2 6) (1 3 6) (1 3))
(circular-list is available in alexandria)
A truyly lexicographic sort would ensure that shorter lists would be sorted before longer ones, provided they share a common prefix: for example, it would sort (1 3) before (1 3 6). A possible modification follows:
(defun tuple-compare (comparison-functions &optional lexicographic)
(lambda (left right)
(loop for fn in comparison-functions
for (x . xr) on left
for (y . yr) on right
do (cond
((funcall fn x y) (return t))
((funcall fn y x) (return nil))
((and lexicographic yr (null xr)) (return t))))))

Related

Returning the sum of positive squares

I'm trying to edit the current program I have
(define (sumofnumber n)
(if (= n 0)
1
(+ n (sumofnumber (modulo n 2 )))))
so that it returns the sum of an n number of positive squares. For example if you inputted in 3 the program would do 1+4+9 to get 14. I have tried using modulo and other methods but it always goes into an infinite loop.
The base case is incorrect (the square of zero is zero), and so is the recursive step (why are you taking the modulo?) and the actual operation (where are you squaring the value?). This is how the procedure should look like:
(define (sum-of-squares n)
(if (= n 0)
0
(+ (* n n)
(sum-of-squares (- n 1)))))
A definition using composition rather than recursion. Read the comments from bottom to top for the procedural logic:
(define (sum-of-squares n)
(foldl + ; sum the list
0
(map (lambda(x)(* x x)) ; square each number in list
(map (lambda(x)(+ x 1)) ; correct for range yielding 0...(n - 1)
(range n))))) ; get a list of numbers bounded by n
I provide this because you are well on your way to understanding the idiom of recursion. Composition is another of Racket's idioms worth exploring and often covered after recursion in educational contexts.
Sometimes I find composition easier to apply to a problem than recursion. Other times, I don't.
You're not squaring anything, so there's no reason to expect that to be a sum of squares.
Write down how you got 1 + 4 + 9 with n = 3 (^ is exponentiation):
1^2 + 2^2 + 3^2
This is
(sum-of-squares 2) + 3^2
or
(sum-of-squares (- 3 1)) + 3^2
that is,
(sum-of-squares (- n 1)) + n^2
Notice that modulo does not occur anywhere, nor do you add n to anything.
(And the square of 0 is 0 , not 1.)
You can break the problem into small chunks.
1. Create a list of numbers from 1 to n
2. Map a square function over list to square each number
3. Apply + to add all the numbers in squared list
(define (sum-of-number n)
(apply + (map (lambda (x) (* x x)) (sequence->list (in-range 1 (+ n 1))))))
> (sum-of-number 3)
14
This is the perfect opportunity for using the transducers technique.
Calculating the sum of a list is a fold. Map and filter are folds, too. Composing several folds together in a nested fashion, as in (sum...(filter...(map...sqr...))), leads to multiple (here, three) list traversals.
But when the nested folds are fused, their reducing functions combine in a nested fashion, giving us a one-traversal fold instead, with the one combined reducer function:
(define (((mapping f) kons) x acc) (kons (f x) acc)) ; the "mapping" transducer
(define (((filtering p) kons) x acc) (if (p x) (kons x acc) acc)) ; the "filtering" one
(define (sum-of-positive-squares n)
(foldl ((compose (mapping sqr) ; ((mapping sqr)
(filtering (lambda (x) (> x 0)))) ; ((filtering {> _ 0})
+) 0 (range (+ 1 n)))) ; +))
; > (sum-of-positive-squares 3)
; 14
Of course ((compose f g) x) is the same as (f (g x)). The combined / "composed" (pun intended) reducer function is created just by substituting the arguments into the definitions, as
((mapping sqr) ((filtering {> _ 0}) +))
=
( (lambda (kons)
(lambda (x acc) (kons (sqr x) acc)))
((filtering {> _ 0}) +))
=
(lambda (x acc)
( ((filtering {> _ 0}) +)
(sqr x) acc))
=
(lambda (x acc)
( ( (lambda (kons)
(lambda (x acc) (if ({> _ 0} x) (kons x acc) acc)))
+)
(sqr x) acc))
=
(lambda (x acc)
( (lambda (x acc) (if (> x 0) (+ x acc) acc))
(sqr x) acc))
=
(lambda (x acc)
(let ([x (sqr x)] [acc acc])
(if (> x 0) (+ x acc) acc)))
which looks almost as something a programmer would write. As an exercise,
((filtering {> _ 0}) ((mapping sqr) +))
=
( (lambda (kons)
(lambda (x acc) (if ({> _ 0} x) (kons x acc) acc)))
((mapping sqr) +))
=
(lambda (x acc)
(if (> x 0) (((mapping sqr) +) x acc) acc))
=
(lambda (x acc)
(if (> x 0) (+ (sqr x) acc) acc))
So instead of writing the fused reducer function definitions ourselves, which as every human activity is error-prone, we can compose these reducer functions from more atomic "transformations" nay transducers.
Works in DrRacket.

How can I map two lists in Scheme using fold right?

I am looking for a way of mapping two different lists items using only foldr
(map-Using-FoldR '( 1 2 3 4) '( w x y z))
should return
'((1 w) (2 x) (3 y) (4 z))
or in other words - "map" command implemetation using foldr
is it possible?
thanks!
Basically, you want to implement the zip procedure in terms of foldr:
(define (zip lst1 lst2)
(foldr (lambda (e1 e2 acc) (cons (list e1 e2) acc))
'()
lst1
lst2))
For example:
(zip '(1 2 3 4) '(w x y z))
=> '((1 w) (2 x) (3 y) (4 z))

Scheme, higher order functions, and curried functions

I need to write a Scheme higher-order function that takes a function of two parameters as its parameter and returns a curried version of the function. I understand this much so far in terms of curried functions:
(define curriedFunction (lambda (x)
(if (positive? x)
(lambda (y z) (+ x y z))
(lambda (y z) (- x y z)))))
(display ((curriedFunction -5) 4 7))
(display "\n")
(display ((curriedFunction 5) 4 7))
If x is negative, it subtracts x y and z. If x is positive, it adds x, y, and z.
In terms of higher order functions I understand this:
(display (map (lambda (x y) (* x y)) '(1 2 3) '(3 4 5)))
And thirdly I understand this much in terms of passing functions in as arguments:
(define (function0 func x y)
(func x y))
(define myFunction (lambda (x y)
(* x y)))
(display (function0 myFunction 10 4))
In the code directly above, I understand that the function "myFunction" could have also been written as this:
(define (myFunction x y)
(* x y))
So now you know where I am at in terms of Scheme programming and syntax.
Now back to answering the question of writing a Scheme higher-order function that takes a function of two parameters as its parameter and returns a curried version of the function. How do I connect these concepts together? Thank you in advance, I truly appreciate it.
Here is a possible solution:
(define (curry f)
(lambda (x)
(lambda (y)
(f x y))))
The function curry takes the function f and returns a function with a single argument x. That function, given a value for its argument, returns another function that takes an argument y and returns the result of applying the original function f to x and y. So, for instance, (curry +) returns a curried version of +:
(((curry +) 3) 4) ; produces 7

how assign values to variables in racket?

if I have this list
'((x 3) (y 4) (z 2))
how do I assign 3 to x and y to 4 and z to 2 to use it to do math like?
3 + x
or
y + z
Thanks
You can use let to declare local variables in Scheme. For example, to create bindings with the given values in the list:
(let ((x 3) (y 4) (z 2))
(+ y z)) ; body
=> 6
Now you can evaluate any expression involving the declared variables in the <body> part. You can even create a let from a list of bindings, for instance using macros:
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(define-syntax my-let
(syntax-rules ()
[(_ lst exp)
(eval `(let ,lst ,exp) ns)]))
(my-let '((x 3) (y 4) (z 2)) ; bindings as an association list
'(+ y z)) ; expression to be evaluated
=> 6
The above creates a macro called my-let which receives a list of bindings and an expression to be evaluated with those bindings, and returns the result of the evaluation.
A simple, straightforward and portable way would be to define an accessor (in this example, getval) using assq:
(define vars '((x 3) (y 4) (z 2)))
(define (getval sym) (cadr (assq sym vars)))
or any variation thereof. Then use as follows:
(+ 3 (getval 'x))
=> 6
(+ (getval 'y) (getval 'z))
=> 6

Filter a list into two parts by a predicate

I want to do
(filter-list-into-two-parts #'evenp '(1 2 3 4 5))
; => ((2 4) (1 3 5))
where a list is split into two sub-lists depending on whether a predicate evaluates to true. It is easy to define such a function:
(defun filter-list-into-two-parts (predicate list)
(list (remove-if-not predicate list) (remove-if predicate list)))
but I would like to know if there is a built-in function in Lisp that can do this, or perhaps a better way of writing this function?
I don't think there is a built-in and your version is sub-optimal because it traverses the list twice and calls the predicate on each list element twice.
(defun filter-list-into-two-parts (predicate list)
(loop for x in list
if (funcall predicate x) collect x into yes
else collect x into no
finally (return (values yes no))))
I return two values instead of the list thereof; this is more idiomatic (you will be using multiple-value-bind to extract yes and no from the multiple values returned, instead of using destructuring-bind to parse the list, it conses less and is faster, see also values function in Common Lisp).
A more general version would be
(defun split-list (key list &key (test 'eql))
(let ((ht (make-hash-table :test test)))
(dolist (x list ht)
(push x (gethash (funcall key x) ht '())))))
(split-list (lambda (x) (mod x 3)) (loop for i from 0 to 9 collect i))
==> #S(HASH-TABLE :TEST FASTHASH-EQL (2 . (8 5 2)) (1 . (7 4 1)) (0 . (9 6 3 0)))
Using REDUCE:
(reduce (lambda (a b)
(if (evenp a)
(push a (first b))
(push a (second b)))
b)
'(1 2 3 4 5)
:initial-value (list nil nil)
:from-end t)
In dash.el there is a function -separate that does exactly what you ask:
(-separate 'evenp '(1 2 3 4)) ; => '((2 4) (1 3))
You can ignore the rest of the post if you use -separate. I had to implement Haskell's partition function in Elisp. Elisp is similar1 in many respects to Common Lisp, so this answer will be useful for coders of both languages. My code was inspired by similar implementations for Python
(defun partition-push (p xs)
(let (trues falses) ; initialized to nil, nil = '()
(mapc (lambda (x) ; like mapcar but for side-effects only
(if (funcall p x)
(push x trues)
(push x falses)))
xs)
(list (reverse trues) (reverse falses))))
(defun partition-append (p xs)
(reduce (lambda (r x)
(if (funcall p x)
(list (append (car r) (list x))
(cadr r))
(list (car r)
(append (cadr r) (list x)))))
xs
:initial-value '(() ()) ; (list nil nil)
))
(defun partition-reduce-reverse (p xs)
(mapcar #'reverse ; reverse both lists
(reduce (lambda (r x)
(if (funcall p x)
(list (cons x (car r))
(cadr r))
(list (car r)
(cons x (cadr r)))))
xs
:initial-value '(() ())
)))
push is a destructive function that prepends an element to list. I didn't use Elisp's add-to-list, because it only adds the same element once. mapc is a map function2 that doesn't accumulate results. As Elisp, like Common Lisp, has separate namespaces for functions and variables3, you have to use funcall to call a function received as a parameter. reduce is a higher-order function4 that accepts :initial-value keyword, which allows for versatile usage. append concatenates variable amount of lists.
In the code partition-push is imperative Common Lisp that uses a widespread "push and reverse" idiom, you first generate lists by prepending to the list in O(1) and reversing in O(n). Appending once to a list would be O(n) due to lists implemented as cons cells, so appending n items would be O(n²). partition-append illustrates adding to the end. As I'm a functional programming fan, I wrote the no side-effects version with reduce in partition-reduce-reverse.
Emacs has a profiling tool. I run it against these 3 functions. The first element in a list returned is the total amount of seconds. As you can see, appending to list works extremely slow, while the functional variant is the quickest.
ELISP> (benchmark-run 100 (-separate #'evenp (number-sequence 0 1000)))
(0.043594004 0 0.0)
ELISP> (benchmark-run 100 (partition-push #'evenp (number-sequence 0 1000)))
(0.468053176 7 0.2956386049999793)
ELISP> (benchmark-run 100 (partition-append #'evenp (number-sequence 0 1000)))
(7.412973128 162 6.853687342999947)
ELISP> (benchmark-run 100 (partition-reduce-reverse #'evenp (number-sequence 0 1000)))
(0.217411618 3 0.12750035599998455)
References
Differences between Common Lisp and Emacs Lisp
Map higher-order function
Technical Issues of Separation in Function Cells and Value Cells
Fold higher-order function
I don't think that there is a partition function in the common lisp standard, but there are libraries that provide such an utility (with documentation and source).
CL-USER> (ql:quickload :arnesi)
CL-USER> (arnesi:partition '(1 2 3 4 5) 'evenp 'oddp)
((2 4) (1 3 5))
CL-USER> (arnesi:partition '(1 2 b "c") 'numberp 'symbolp 'stringp)
((1 2) (B) ("c"))

Resources