How to write a shortest and most idiomatic CLI calculator in Clojure - data-structures

I like to learn a new language by making small tool like calculator.
Although I already searched a lot idiomatic examples about specific cases(such as idiomatic usage of array and list), I have no idea how to put those together to write this small calculator in an idiomatic way.
So here is my code:
(defn pre-process [s]
"Seperate operands with operators and replace ( with l, ) with r"
(re-seq #"\d+|[\+\-\*\/lr]"
(clojure.string/replace s #"\(|\)" {"(" "l" ")" "r"})))
(defn calc-once [stk]
"Take one operator from operator stack and apply it to
top two numbers in operand stack"
(let [opt (:opt stk)
num (:num stk)
tmp-num (pop (pop num))
tmp-opt (pop opt)
last-two-num [(peek (pop num)) (peek num)]
last-opt (peek opt)]
(assoc stk
:num (conj tmp-num (apply (eval last-opt) last-two-num))
:opt tmp-opt)))
(defn clean-stk [stk]
(loop [stk stk]
(if (> (count (:opt stk)) 1)
(recur (calc-once stk))
(peek (:num stk)))))
(defn calc
"A simple calculator"
[s]
(clean-stk
(reduce
(fn [stk item]
(let [item (read-string item)
operators #{'+ '- '* '/}
prio {'+ 0 ; Define operator priority here
'- 0
'* 1
'/ 1
'l -1
'r -1
'dummy -2}
add-to-num #(assoc %1 :num (conj (:num %1) %2))
add-to-opt #(assoc %1 :opt (conj (:opt %1) %2))
item-prio (get prio item)
last-prio #(get prio (peek (:opt %)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(loop [stk stk]
(if (<= item-prio (last-prio stk))
(recur (calc-once stk))
(add-to-opt stk item)))
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(loop [stk stk]
(if (not= (peek (:opt stk)) 'l)
(recur (calc-once stk))
(assoc stk :opt (pop (:opt stk)))))
:else
(println "Unexpected syntax: " item))))
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))))
After calling it:
(calc (pre-process (read-line))))
It can calculate like:
(1 + 3) * ( 4 + 4)
32
I think my code could be improved by
eliminating those cond
or
try to make the {:num '() :opt '()} into a more accessible data
structure
, but I have no idea.
Hopefully someone can give me some suggestions or point out problems with my code (or the grammers of my question :P).
====================================Thank you :)================================
Thank you guys for help. I modified my code, it seems better now. But I still have some questions:
Should I put some less generic functions (such as add-to-num) into global var?
Does anybody discover that sometimes naming a function in FP is pretty hard? Especially for those non-generic functions.
And here is my new code:
(def prio
{'+ 0 ; Define operator priority here
'- 0
'* 1
'/ 1
'l -1
'r -1
'dummy -2})
(def operators #{'+ '- '* '/})
(defn pre-process [s]
"Seperate operands with operators and replace ( with l, ) with r"
(re-seq #"\d+|[\+\-\*\/lr]"
(clojure.string/replace s #"\(|\)" {"(" "l" ")" "r"})))
(defn calc-once [stk]
"Take one operator from operator stack and apply it to
top two numbers in operand stack"
(let [opt (:opt stk)
num (:num stk)
tmp-num (pop (pop num))
tmp-opt (pop opt)
last-two-num [(peek (pop num)) (peek num)]
last-opt (peek opt)]
(assoc stk
:num (conj tmp-num (apply (eval last-opt) last-two-num))
:opt tmp-opt)))
(defn process-stk [stk checker fn-ret]
(loop [stk stk]
(if (checker stk)
(recur (calc-once stk))
(fn-ret stk))))
(defn calc
"A simple calculator"
[s]
(process-stk
(reduce
(fn [stk item]
(let [item (read-string item)
add-to-num #(assoc %1 :num (conj (:num %1) %2))
add-to-opt #(assoc %1 :opt (conj (:opt %1) %2))
item-prio (get prio item)
last-prio #(get prio (peek (:opt %)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(process-stk stk #(<= item-prio (last-prio %))
#(add-to-opt % item))
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(process-stk stk #(not= (peek (:opt %)) 'l)
#(assoc % :opt (pop (:opt %))))
:else
(println "Unexpected syntax: " item))))
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))
#(> (count (:opt %)) 1)
#(peek (:num %))))

This cries out for a macro solution, given below. I did cheat in that there are only 2 precedence levels so I didn't have to work out a stack to keep track of precedence. This solution could be generalized but it take a little more doing.
The trick to remember about macros in clojure is they take clojure structure (which is a nested list of lists) and return a different list of lists. The calc macro simply takes the input, wraps it in parens and passes it to the clojure reader which does all the heavy lifting of parsing the input string into a list of symbols.
Then the reorder-equation function turns the infix into a prefix order list. That list is returned by the macro and is then evaluated as clojure code.
The check for * and / makes sure they get evaluated first. To see what it does try
(reorder-equation '((1 + 3) * (4 + 4)))
=> (* (+ 1 3) (+ 4 4))
As you can see it takes the equations and rewrites it into a valid clojure expression which will then be evaluated.
This may seem like cheating but as you get more familiar with Clojure you will realize that you can let the language do a lot of the heavy lifting. Parsing input into a list of symbols and using those symbols as function names make perfect sense. As a matter of fact, any function that takes two arguments is valid in our calculator:
(calc "(1 + 3) < (4 + 4)")
=> true
and
(calc "(1 + 3) str (4 + 4)")
=> "48"
The code:
(defn reorder-equation [ arg ]
(if (seq? arg)
(let [[f s & r] arg
f (reorder-equation f)]
(cond
(#{"*" "/"} (str s)) ( let [[t ft & r2 ] r
t (reorder-equation t)]
(if ft
(list ft (list s f t) (reorder-equation r2))
(list s f t)))
(nil? s) f
:else (list s f (reorder-equation r))))
arg))
(defmacro calc [inp]
(let [tr (read-string (str "(" inp ")"))]
(reorder-equation tr)))

It is the correct version of the M Smith's solution, although I used eval in my code, which is generally a bad idea. I paste it here and hope it can help someone.
(defn calc [ arg ]
(if (seq? arg)
(let [[f s & r] arg
f (calc f)]
(if (nil? s)
f
(let [[t ft & r2 ] r
t (calc t)
new-f ((resolve s) f t)]
(cond
(#{"*" "/"} (str s))
(if ft
(calc (concat `(~new-f) (rest r)))
new-f)
(nil? s) f
:else
(if (#{"+" "/"} (str ft))
(calc (concat `(~new-f) (rest r)))
((resolve s) f (calc r)))))))
arg))
(defn main [inp]
(let [tr (read-string (str "(" inp ")"))]
(calc tr)))
Example:
(println (main "2 - 4 + 8 * 16"))
(println (main "(1 + 2) * (10 - 4) / 9 * 6"))
(println (main "10 + 2 * 100 / ((40 - 37) * 100 * (2 - 4 + 8 * 16))"))
Result:
126
12
1891/189

Here is my solution, which does not use regex or macros, and which instead uses partition and reduce for its parsing logic.
The general idea is that you treat the user input as a sequence of symbol pairs after the initial value. So your arithmetic expression is essentially '(<init-value> (op1 value1) (op2 value2) ...(opN valueN)) Of course, the <init-value> could itself be a parenthetical, and if so must first be reduced as well.
partition then provides the sequence of symbol/value pairs to reduce, which constructs a valid Clojure expression with symbols arranged by precedence. I halt evaluation on invalid symbols (anything not a number list or symbol), exiting the reduce block with the handy reduced (added in 1.5).
An important concept is that any lists (parenthesis) encountered ultimately reduce to values, and so are recursively reduce-d. The function peel handles nested lists, i.e. (((1 + 1)))
It a little verbose (I prefer descriptive variable names), but it's correct. I checked several rather complex nested expressions against Google.
(def instructions
(str "Please enter an arithmetic expression separated by spaces.\n"
"i.e. 1 + 2 / 3 * 4"))
(defn- error
([] (error instructions))
([msg] (str "ERROR: " (if (nil? msg)
instructions
msg))))
(def ^{:private true} operators {'* 1
'/ 1
'+ 0
'- 0})
(def ^{:private true} operator? (set (keys operators)))
(defn- higher-precedence? [leftop rightop]
(< (operators leftop) (operators rightop)))
(declare parse-expr)
(defn- peel
"Remove all outer lists until you reach
a list that contains more than one value."
[expr]
(if (and (list? expr) (= 1 (count expr)))
(recur (first expr))
expr))
(defn- read-value [e]
(if (list? e)
(parse-expr (peel e))
(if (number? e) e)))
(defn- valid-expr? [op right]
(and (operator? op)
(or (number? right) (list? right))))
(defn- higher-precedence-concat [left op right]
(let [right-value (read-value right)
last-left-value (last left)
other-left-values (drop-last left)]
(concat other-left-values `((~op ~last-left-value ~right-value)))))
(defn- parse-expr [s]
(let [left (read-value (first s))
exprs (partition 2 (rest s))
[[op right] & _] exprs]
(if (and left (valid-expr? op left))
(let [right (read-value right)]
(reduce (fn [left [op right]]
(if (valid-expr? op right)
(if (higher-precedence? (first left) op)
(higher-precedence-concat left op right)
(list op left (read-value right)))
(reduced nil)))
(list op left right) (rest exprs))))))
(defn calc [input]
(try
(let [expr (-> (str "(" input ")")
read-string ;; TODO: use tools.reader?
peel)]
(if (list? expr)
(if-let [result (eval (parse-expr expr))]
result
(error))
(error)))
(catch java.lang.RuntimeException ex
(error (.getMessage ex)))))
Example checked against google's online calculator:
(calc "10 + 2 * 100 / ((40 - 37) * 100 * (2 - 4 + 8 * 16))")
=> 1891/189
(double *1)
=> 10.00529100529101
Two limitations: expressions must be space delimited (i.e. 1+2-3 not supported) just like Incanter's infix mathematics, and because I use read-string the user input can have trailing parens (I consider this a bug I'll have to fix with a more robust REPL implementation).
Credits: I used Eric Robert's Programming Abstractions in C (Addison Wesley, 1997) as a reference in coding the above. Chapter 14 "Expression Trees" describes an almost identical problem.

I'll try it out, but I can't get your code to work, so it's a bit hard for me to understand what is happening in every place. Basically, the following is a guess and not intended to be a complete answer. Hopefully someone can come in and edit this down a bit and get it to function correctly.
I'll start with the basic premise: You have, in my opinion, way to many nested and anonymous functions. Everywhere you see a #(xyz) could probably be pulled out into its own function. I'm pretty sure having function inside of function inside of function would be pretty bad form in any programming language, and I feel it is bad form here. I began by removing anon functions, both hashed and the (fn) you have in your original code.
I also don't like nesting functions in my let-bindings.
(def prio
{'+ 0 ; Define operator priority here
'- 0
'* 1
'/ 1
'l -1
'r -1
'dummy -2})
(def operators #{'+ '- '* '/})
(defn pre-process [s]
"Seperate operands with operators and replace ( with l, ) with r"
(re-seq #"\d+|[\+\-\*\/lr]"
(clojure.string/replace s #"\(|\)" {"(" "l" ")" "r"})))
(defn calc-once [stk]
"Take one operator from operator stack and apply it to
top two numbers in operand stack"
(let [opt (:opt stk)
num (:num stk)
tmp-num (pop (pop num))
tmp-opt (pop opt)
last-two-num [(peek (pop num)) (peek num)]
last-opt (peek opt)]
(assoc stk
:num (conj tmp-num (apply (eval last-opt) last-two-num))
:opt tmp-opt)))
(defn process-stk [stk checker fn-ret]
(loop [stk stk]
(if (checker stk)
(recur (calc-once stk))
(fn-ret stk))))
(defn assoc-to-item [item]
#(assoc %1 item (conj (item %1) %2)))
(defn priority [item]
(get prio item))
(defn create-checker [op item v]
(op item v))
(defn pre-calc [stk item s]
(reduce
(let [item (read-string item)
add-to-num (assoc-to-item :num)
add-to-opt (assoc-to-item :opt)
item-prio (priority item)
last-prio (priority (last (:opt)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(process-stk stk
(create-checker <= item-prio (last-prio))
add-to-opt)
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(process-stk stk
(create-checker not= (peek (:opt)) 'l)
#(assoc % :opt (pop (:opt %))))
:else
(println "Unexpected syntax: " item))))
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))
(defn calc [s]
"A simple calculator"
(process-stk (pre-calc stk item s)
#(> (count (:opt %)) 1)
#(peek (:num %))))
Further notes:
(peek) is very ambiguous and I generally don't like using it. From the cheatsheets:
For a list or queue, same as first, for a vector, same as, but much
more efficient than, last. If the collection is empty, returns nil.
Since I'm not entirely sure what structure you are working with at all times (I think its a vec?) and you do, you may want to use last or first, which ever is more appropriate. Although it is "much more efficient" than last, it's not helping me understand how the program works, so use peek in the finished product but not the shared product (mind you don't really need super speed for this either).
I also think that the (cond) should be unambiguously case-tested.
I attempted to make it a tad more "idiomatic" by making sure the args are less ambiguous. In your original code, you are passing in massive functions (and the results of nested functions) as one large argument to another function. Breaking all of that down to smaller functions is where you need to work more a bit. Notice how it is more clear what is happening in the calc function?
I pulled out the anon function inside calc and entered into a function called pre-calc. I would still suggest pulling out the anon functions from calc and work on clarifying what is happening inside of pre-calc. It is still hard to read because I can't really guess what is happening.
I would suggest starting with something like the following because it is hard to see what args are passed into (reduce). You can see how this is confusing because I am passing item in as an argument then I am following your pattern and passing item into (read-string) and then I am binding that result to item. I'm not sure if this is your intent, but I most certainly would not pass in an arg called let and them bind the result of passing it into a function created by evaluating item. This creates further confusion for me because you have item passed into a let-bound item-prio. I never did this, so I don't even know if the arg item or the let-bound item is being evaluated here.
Here is that part of the code. Notice how it is easy to see what is being reduced now?
(defn stack-binding [item]
(let [item (read-string item)
add-to-num (assoc-to-item :num)
add-to-opt (assoc-to-item :opt)
item-prio (priority item)
last-prio (priority (last (:opt)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(process-stk stk
(create-checker <= item-prio (last-prio))
add-to-opt)
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(process-stk stk
(create-checker not= (peek (:opt)) 'l)
#(assoc % :opt (pop (:opt %))))
:else
(println "Unexpected syntax: " item))))
(defn pre-calc [stk item s]
(reduce (stack-binding item)
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))
There is a lot more I could write, but as I said, I really don't know how everything is working together. Regardless, this should at least show some of the logic I would use in creating this program. I would try to generalize this a lot more and keep it so that each function is only about 10 LOC each.
As I said, I hope others can either expand on this or edit it to something more palatable.

The smallest idiomatic calculator is the REPL!
If infix notation is the goal, I'd go for changing the reader so that numbers become functions of the arithmetic functions *,/,+,-,% etc, so (7 + 5) would be read as 7, being a Clojure function (in addition to being a java.lang.Number), can take + 5 as arguments, similar to how, in Smalltalk, numbers can understand arithmetic operations as messages.

Related

How to change this function, "car" got problems

I want to write a function, which converts from a "normal" notation like this: "1+4*2-8" to this pre-notation: "+1-*428".
I hope you get the point here.
Important: It must be in Strings.
What I get so far:
(define (converter lst )
(let ((operand1 (car lst))
(operator (car (cdr lst)))
(operand2 (caddr lst)))
(list operator
(converter operand1)
(converter operand2)))
)
(infixLst->prefixLst '(1 + 2 * 3))
I got two problems here.
1) It's for Lists, I need it work for Strings like "1+3" and not '(1+3)
2) It doesn't work so far (even not for Lists), because it give me some errors regarding the "car", e.g: car: expects a pair, given 1
Soo starting with the List -> String change: (I know that (list is unappropriate here. As well as the other list-methods but I didnt got a better idea so far.
(define (infix->prefix str)
(let ((operand1 (car str))
(operator (cadr str))
(operand2 (caddr str)))
(list operator
(infix->prefix operand1)
(infix->prefix operand2)))
)
(infix->prefix "1 + 2")
The normal notation 1+4*2-8 is called infix notation.
If you simply need to use that notation, Racket has a ready module: (require infix), here's a link to its documentation.
If you want to practice writing your own infix parser, the shunting-yard algorithm can do that. It uses a stack to keep track of the operators in the math expression.
If you want to parse math from a string, you need to first split the string into a list of tokens (numbers and operators). Start with a math->tokens procedure that simply returns a list of the tokens without caring about their meaning. There are many ways to write it. Here is one:
(define (math->tokens s)
(let collect-tokens ((i 0) (tokens '()))
(if (= i (string-length s))
(reverse tokens)
(let ((char (string-ref s i)))
(if (not (char-numeric? char))
(let ((operator (string->symbol (string char))))
(collect-tokens (+ i 1) (cons operator tokens)))
(let collect-number ((j (+ i 1)))
(if (and (< j (string-length s))
(char-numeric? (string-ref s j)))
(collect-number (+ j 1))
(let ((number (string->number (substring s i j))))
(collect-tokens j (cons number tokens))))))))))
For example, (math->tokens "+1-*428") returns the list of tokens (+ 1 - * 428). Now you can apply the shunting-yard algorithm to that list.

Compare two lists and return false if they are not equal scheme

i would like to ask you for help to complete code below with condition which is testing if lists ws and vs are not equal. If they are not equal so return text false(#f) else process code below. I stared with fulfilling variables len1 and len2 which are counting length of both lists. When i run it i am getting this error: lambda: no expression after a sequence of internal definitions in: lambda What i am doing wrong?
(define (weighted-sum . ws)
(define (sub . vs)
(let ((len1 (length ws)) (len2 (length vs)))
(if (not (equal? (len1 len2) '#f))
(foldl
(lambda (i j res) (+ res (* i j)))
0
ws vs)))
sub)
Thanks for help.
length is almost always an anti-pattern in Scheme.
length is a O(n) operation, which is called twice, then you call another O(n) operation, foldl, resulting in a O(3n) process for weighted-sum - far from the ideal minimum O(n). foldl is a nice candidate for many linear computations, but because of the length-matching requirement, you've created a bit of a square-peg-in-a-round-hole situation.
Using a named-let and match*, we write weighted-sum as a O(n) computation -
#lang racket
(define ((weighted-sum . ws) . vs) ;; curried form syntactic sugar
(let loop ((acc 0)
(ws ws)
(vs vs))
(match* (ws vs)
;; both lists have at least one value
[((list w ws ...) (list v vs ...))
(loop (+ acc (* w v))
ws
vs)]
;; both lists are empty
[((list) (list))
acc]
;; any other case
[(_ _)
#f])))
Of course match* is a pretty fancy macro, so I'll show you how to rewrite weighted-sum using a simple cond expression. Get your logical reasoning hat ready: the order of the condition clauses is very important here -
(define ((weighted-sum . ws) . vs)
(let loop ((acc 0)
(ws ws)
(vs vs))
(cond
;; both lists are empty
[(and (null? ws)
(null? vs))
acc]
;; at least one list is empty
[(or (null? ws)
(null? vs))
#f]
;; inductive: both lists have at least one value
[else
(loop (+ acc (* (car ws)
(car vs)))
(cdr ws)
(cdr vs))])))
Both programs have the same output -
((weighted-sum 1 2 3) 1 2 3)
;; 14
((weighted-sum 1 2 3) 1 2)
;; #f
((weighted-sum 1 2) 1 2 3)
;; #f
((weighted-sum))
;; 0
Erase )) after #f . Add )) after len1 len2), and it'll work. (not quite, but close(*))
#f is self-evaluating, you don't need to quote it. Indent the (foldl ...) form which became a part of the if expression now.
Lastly, (if (not A) #f B) is the same as (if A B #f) is the same as (and A B).
You are correct in checking that the lengths of both lists, the carried (sic) and the expected, are equal. I don't see why the lists themselves should be equal, though. They shouldn't, as far I can tell.
(weighted-sum list-of-weights) creates a procedure expecting a list of numbers to calculate its weighted sum using the previously supplied weights.
(*) The corrected code, after a few more fixes, is:
(define (weighted-sum . ws)
(define (sub . vs)
(let ((len1 (length ws)) (len2 (length vs)))
(and (equal? len1 len2)
(foldl
(lambda (i j res) (+ res (* i j)))
0
ws vs))))
sub)
It is highly advisable to install e.g. Racket and use its editor to see and correct the parentheses mismatches etc.

Prolog translation of Lisp's tail-recursion

I have a question that is a followup to a previous topic,
Should I avoid tail recursion in Prolog and in general?
In the above linked article , user false
provided this code example and this explanation ...
Back in the 1970s, the major AI language was LISP. And the
corresponding definition would have been ...
(defun addone (xs)
(cond ((null xs) nil)
(t (cons (+ 1 (car xs))
(addone (cdr xs))))))
... which is not directly tail-recursive: The reason is the cons:
In implementations of that time, its arguments were evaluated first,
only then, the cons could be executed. So rewriting this as you have
indicated (and reversing the resulting list) was a possible
optimization technique.
In Prolog, however, you can create the cons prior to knowing the
actual values, thanks to logic variables. So many programs that were
not tail-recursive in LISP, translated to tail-recursive programs in
Prolog.
The repercussions of this can still be found in many Prolog
textbooks.
My question is : what is a good Prolog translation of the above
LISP code ?
EDIT: added the example of the lisp code in action and the
lisp documentation describing the various lisp functions .
example of addone in action
1 > (addone '(1 2 3))
(2 3 4)
2 > (addone '('()))
> Error: The value 'NIL is not of the expected type NUMBER.
> While executing: CCL::+-2, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
3 > (addone '(a b c))
> Error: The value A is not of the expected type NUMBER.
> While executing: CCL::+-2, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
3 > ^C
documentation of lisp features
cons object-1 object-2 => cons
Creates a fresh cons ,
the car of which is object-1 ,
and the cdr of which is object-2 .
Examples
(cons 1 2) => (1 . 2)
(cons 1 nil) => (1)
(cons nil 2) => (NIL . 2)
(cons nil nil) => (NIL)
(cons 1 (cons 2 (cons 3 (cons 4 nil)))) => (1 2 3 4)
(cons 'a 'b) => (A . B)
(cons 'a (cons 'b (cons 'c '()))) => (A B C)
(cons 'a '(b c d)) => (A B C D)
(car x) => object
If x is a cons ,
car returns the car of that cons .
If x is nil ,
car returns nil .
(cdr x) => object
If x is a cons ,
cdr returns the cdr of that cons .
If x is nil ,
cdr returns nil
.
cond {clause}* => result*
clause::= (test-form form*)
Test-forms are evaluated one at a time in the order in which they
are given in the argument list until a test-form is found that
evaluates to true .
If there are no forms in that clause, the primary value of the
test-form [ed: the first value of the test-form , or nil if there
are no values] is returned by the cond form. Otherwise, the forms
associated with this test-form are evaluated in order, left to
right, as an implicit progn, and the values returned by the last
form are returned by the cond form.
Once one test-form has yielded true, no additional test-forms are
evaluated. If no test-form yields true, nil is returned
See
http://www.lispworks.com/documentation/HyperSpec/Body/m_cond.htm#cond
for more information .
defun function-name lambda-list form* => function-name
See
http://www.lispworks.com/documentation/HyperSpec/Body/m_defun.htm#defun
for more information .
t => T
t => T
(eq t 't) => T
(case 'b (a 1) (t 2)) => 2
Here's a rendition in Prolog of the given Lisp algorithm. Note that Lisp is functional and a Lisp function can return values. This isn't the case in Prolog, so you need two arguments.
A direct implementation, which is not relational, would be:
addone([], []).
addone([H|T], [H1|T1]) :-
H1 is H + 1,
addone(T, T1).
Note that the [H1|T1] argument in the head of the second predicate clause corresponds to (cons H1 T1) in Lisp.
This can also be done using maplist, which steps a little bit away from the original Lisp implementation, but Lisp does have list mapping functions which could be used to create a Lisp implementation that would look more like this:
addone_element(X, X1) :- X1 is X + 1.
addone(List, List1) :- maplist(addone_element, List, List1).
In Prolog this can be made more relational using CLP(FD) which is useful for reasoning over integers:
:- use_module(library(clpfd)).
addone([], []).
addone([H|T], [H1|T1]) :-
H1 #= H + 1,
addone(T, T1).
And the maplist version:
addone_element(X, X1) :- X1 #= X + 1.
addone(List, List1) :- maplist(addone_element, List, List1).
A direct translation:
(defun addone (xs)
(cond ((null xs) nil)
(t (cons (+ 1 (car xs))
(addone (cdr xs))))))
is
addone( XS, RESULT) :-
( XS = [], % null XS ? then:
RESULT = [] %
;
XS = [CAR | CDR], % else:
R is 1 + CAR, % calculate the two
addone( CDR, S) % fields % almost TR,
RESULT = [R | S], % and cons them up % save for this cons
).
But, transformed,
(defun addone (xs)
(let ((result))
(cond ((null xs) (setf result nil))
(t (setf result (cons (+ 1 (car xs))
(addone (cdr xs))))))
result))
=
(defun addone (xs)
(let ((result))
(cond ((null xs) (setf result nil))
(t (setf result (list nil))
(setf (car result) (+ 1 (car xs)))
(setf (cdr result) (addone (cdr xs)))))
result))
=
(defun addone (xs &optional (result (list nil))) ; head sentinel
(cond ((null xs))
(t (setf (cdr result) (list nil))
(setf (cadr result) (+ 1 (car xs)))
(addone (cdr xs) (cdr result)))) ; almost TR
(cdr result)) ; returned but not used
=
(defun addone (xs &aux (result (list nil)))
(labels ((addone (xs result)
(cond ((null xs))
(t (setf (cdr result) (list nil))
(setf (cadr result) (+ 1 (car xs)))
(addone (cdr xs) (cdr result)))))) ; fully TR
(addone xs result))
(cdr result))
it is, fully tail recursive,
addone( XS, RESULT) :-
( XS = [],
RESULT = []
;
XS = [CAR | CDR],
RESULT = [R | S], % cons two empty places, and
R is 1 + CAR, % fill'em
addone( CDR, S) % up % fully TR
).
Boxing / head sentinel is used so we can have settable pointers in Common Lisp, but in Prolog this isn't needed -- Prolog's logical variables are directly settable (once), named pointers.
This is also the reason why Prolog's transformation is so much smaller and easier than Lisp's. All it took was moving one line of code up a notch or two (and it could've been one just the same).

Scheme - Replacing elements in a list with its index

I am trying to replace the elements in a scheme list with its position.
For example, calling:
(position '((a b) c))
should return:
'((0 1) 2)
So far, my code keeps the list format, but the index is not updating.
(define (position term1)
(define index 0)
(cond [(null? term1) '()]
[(list? term1) (cons (position (car term1)) (position(cdr term1)))]
[else (+ 1 index) index]))
When (position '((a b) c)) is called, it returns
'((0 0) 0)
Can anybody explain why the index isn't updating?
There are a couple things wrong: first notice that every time you recursively call position, index is bound to zero.
Second, look at your else branch. (+ 1 index) evaluates to 1 (it does not change any variables) and index evaluates to 0. This branch can only evaluate to one thing, so what happens is the last one is returned and the rest are discarded. This is where your zeroes come from.
It seems like within your function you are trying to keep a global state (the current index) and modify it each time you label a leaf. The "modifying state" part is not good functional style, but if you are okay with that then take a look at set!.
Here is one solution using CPS:
#lang racket
(define (index xs [i 0] [continue (λ (xs i) xs)])
(match xs
[(cons x xs) (index x i
(λ (js j)
(index xs j
(λ (ks k)
(continue (cons js ks) k)))))]
['() (continue '() i)]
[x (continue i (+ i 1))]))
; Example
;(index '((a b) (c d) x (e (f g) h)))
; '((0 1) (2 3) 4 (5 (6 7) 8))
Here (index xs i continue) replaces the elements in xs with their indices, the count starts from i. Let's say the result of indexing xs is js, then continue is called with the indexing result and the next index to be used: (continue js j).
Daenerys Naharis already pointed out what's wrong, so let me point out some features of Scheme and Racket you may be unaware of that you could use in a solution that maintains functional style.
This is called a named let:
(let loop ((index 0)
(result '()))
(if (= index 10)
(reverse result)
(loop (+ 1 index) (cons index result)))
Within the let form, loop is bound as a function that takes all the local variables as arguments. Calling it recursively calls the let form itself. This way you can make index an argument without making it an argument of position. You can also put the result in an argument, which allows you to make the call to loop a tail call.
The other feature is less widespread among existing Scheme implementations: Optional arguments. In Racket, they're defined like this:
(define (position term1 (index 0)) ...)
Then position can be called with or without the index argument.
An example using mutation that maintains it's own state so that each item of each list has a unique id.
Example Usage:
> (position '((a b) c))
'((0 1) 2)
> (position '((a b) c (d (e))))
'((3 4) 5 (6 (7)))
Example Implementation:
#lang racket
(provide position)
(define base -1)
(define (indexer)
(set! base (add1 base))
base)
(define (position list-of-x)
(cond [(null? list-of-x) null]
[else
(define head (first list-of-x))
(cond [(list? head)
(cons (position head)
(position (rest list-of-x)))]
[else (cons (indexer)
(position (rest list-of-x)))])]))

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