Finding the diagonals of square matrix made from lists - recursion

I am currently trying to define a function that takes a list of lists, models that list as a square matrix and returns the diagonal of said matrix.
For example, input ((a b c) (d e f) (g h i)) gives (a e i).
I have a vague idea of how to go about solving this (taking the last element of the last list then the second to last element of the second to last list etc.) but I am not really sure of how to go about programming this in Scheme.
I would appreciate it if somebody could point me in the right direction.
Thanks.

(With apologies to Nethack fans)
As you step back from the altar, you find a little piece of paper lying on the floor from which you can decipher the following text:
0> Calling (DIAG ((A B C) (D E F) (G H I)))
1> Calling (DIAG ((E F) (H I)))
2> Calling (DIAG ((I)))
3> Calling (DIAG NIL)
<3 DIAG returned NIL
<2 DIAG returned (I)
<1 DIAG returned (E I)
<0 DIAG returned (A E I)
This looks good, but as you start reading the scroll aloud, you smell a foul scent of garbage nearby.
With the help of your wand of metamorphosis, you zap the cursed object.
The previous text vanishes and another one appears:
0> Calling (DIAG ((A B C) (D E F) (G H I)))
1> Calling (DIAG% ((A B C) (D E F) (G H I)) 0)
2> Calling (DIAG% ((D E F) (G H I)) 1)
3> Calling (DIAG% ((G H I)) 2)
4> Calling (DIAG% NIL 3)
<4 DIAG% returned NIL
<3 DIAG% returned (I)
<2 DIAG% returned (E I)
<1 DIAG% returned (A E I)
<0 DIAG returned (A E I)
A lit field surrounds you!

Related

Haskell: Traversal on a Map

I'm looking for a function with this signature:
chainTraversal :: k -> (k -> a -> Maybe (k, b)) -> Map k a -> Map k b
You give it an initial key to start at, a function and a map.
It will extract the element at the position k in the Map, and feed that element to the function. Based on this, the function will return another key to look at next.
It's some mix between a filter and a traversal, with the elements themselves giving the next position to open. The result is the list of elements that has been traversed. It can be shorter than the original map.
Edit: taking into account a comment.
Since all the lookups are done in the original Map:
foo :: k -> (k -> a -> Maybe (k, b)) -> Map k a -> Map k b
foo k f m = fromList $ unfoldr g k
where
g k = (\(k', b) -> (k', (k, b))) -- k ? k' ? you decide
<$> (f' k =<< (m `at` k))
f' k (k', a) = f k a -- or: f k' a ? you decide
or something like that.
You'll have to implement the at function in terms of one of the lookupNN functions of your choosing.
It's not a filter since it must stop on the first Nothing produced by f.
There is no existing function with that signature and behavior. You'll have to write it yourself.

Anonymous recursive functions in OCaml

How do you make an anonymous recursive function (something simple for example factorial n?) I have heard it is possible but no idea how to make it work in OCaml.
let a =
fun x -> ....
I just don't know how to keep it going...
Here is a definition of factorial using only anonymous functions:
let fact =
(fun f -> (fun x a -> f (x x) a) (fun x a -> f (x x) a))
(fun f n -> if n < 2 then 1 else n * f (n - 1))
It requires the use of the -rectypes flag.
Here's a session showing that it works:
$ rlwrap ocaml -rectypes
OCaml version 4.03.0
let fact =
(fun f -> (fun x a -> f (x x) a) (fun x a -> f (x x) a))
(fun f n -> if n < 2 then 1 else n * f (n - 1));;
val fact : int -> int = <fun>
# fact 8;;
- : int = 40320
I cheated somewhat by looking up the Y Combinator here: Rosetta Code: Y Combinator
Update
Disclaimer: you would do better to read up on lambda calculus, fixed points, and the Y Combinator than to get your info from me. I'm not a theorist, just a humble practitioner.
Following the actual computation is almost impossible (but definitely worth doing I'm sure). But at a high level the ideas are like this.
The first line of the definition is the Y Combinator, which in general calculates the fixed point of a function. It so happens that a recursive function is the fixed point of a function from functions to functions.
So the first goal is to find the function whose fixed point is the factorial function. That's the second line of the definition. If you give it a function of type int -> int, it gives you back another function of type int -> int. And if you give it the factorial function, it gives you back the factorial function. This means that the factorial function is its fixed point.
So then when you apply the Y Combinator to this function, you do indeed get the factorial function.
Let me try to expand a bit on Jeffrey Scofield's answer. A non-anonymous recursive definition of the factorial function could be
let rec fact n =
if n < 2 then 1 else n * fact (n - 1)
The first problem you encounter when you try to define an anonymous recursive function is how to do the actual recursive call (fact (n - 1) in our case). For a call we need a name and we do not have a name for an anonymous function. The solution is to use a temporary name. With the temporary name f, the definition body is just
fun n -> if n < 2 then 1 else n * f (n - 1)
This term does not have a type, because the "temporary name" f is unbound. But we can turn it into a value that does have a type by bounding f as well. Let us call the result g:
let g = fun f n -> if n < 2 then 1 else n * f (n - 1)
g is not yet anonymous at the moment, but only because I want to refer to it again.
Observe that g has type (int -> int) -> (int -> int). What we want (the factorial function) will have type (int -> int). So g takes something of the type we want (a function type in this case) and produces something of the same type. The intuition is that g takes an approximation of the factorial function, namely a function f which works for all n up to some limit N and returns a better approximation, namely a function that works for all n up to N+1.
Finally we need something that turns g into an actual recursive definition.
Doing so is a very generic task. Recall that g improves the approximation quality. The final factorial function fact is one which cannot be further improved. So applying g to fact should be the same as just fact. (Actually that is only true from a value point of view. The actual computation inherent in g fact n for some n is different from that of just fact n. But the returned values are the same.) In other words, fact is a fixed point of g. So what we need is something that computes fixed points.
Luckily, there is a single function that does so: The Y combinator. From a value point of view, the Y combinator (let us use y in OCaml, as uppercase is reserved for constructors) is defined by the fact that y g = g (y g) for all g: given some function g, the combinator returns one of its fixed points.
Consequently,
y : (`a -> `a) -> `a
In our case the type variable is instantiated by (int -> int).
One possible way to define y would be
let y = fun g -> (fun x -> g (x x)) (fun x -> g (x x))
but this works only with lazy evaluation (as, I believe, Haskell has). As OCaml has eager evaluation, it produces a stack overflow when used. The reason is that OCaml tries to turn something like y g 8 into
g (y g) 8
g (g (y g)) 8
g (g (g (y g))) 8
...
without ever getting to call g.
The solution is to use deferred computation inside of y:
let y = fun g -> (fun x a -> g (x x) a) (fun x a -> g (x x) a)
One drawback is that y does not work for arbitrary types any more. It only works for function types.
y : ((`b -> `c) -> (`b -> `c)) -> (`b -> `c)
But you asked for recursive definitions of functions anyway, not for recursive definitions of other values. So, our definition of the factorial function is y g with y and g defined as above. Neither y nor g are anonymous yet, but that can be remedied easily:
(fun g -> (fun x a -> g (x x) a) (fun x a -> g (x x) a))
(fun f n -> if n < 2 then 1 else n * f (n - 1))
UPDATE:
Defining y only works with the -rectypes option. The reason is that we apply x to itself.
There is also an "intuitive" way to accomplish anonymous recursion without resorting to Y combinators.
It makes use of a let binding to store the value of a lambda that accepts itself as an argument, so that it can call itself with itself as the first parameter, like so:
let fact = (let fact0 = (fun self n -> if n < 2 then 1 else n * self self (n - 1)) in (fun n -> fact0 fact0 n));;
It's anonymous only to the extent that it is not defined with let rec.

Is there a tco pattern with two accumulating variables?

Just for fun (Project Euler #65) I want to implement the formula
n_k = a_k*n_k-1 + n_k-2
in an efficient way. a_k is either 1 or (* 2 (/ k 3)), depending on k.
I started with a recursive solution:
(defun numerator-of-convergence-for-e-rec (k)
"Returns the Nth numerator of convergence for Euler's number e."
(cond ((or (minusp k)) (zerop k) 0)
((= 1 k) 2)
((= 2 k) 3)
((zerop (mod k 3)) (+ (* 2 (/ k 3) (numerator-of-convergence-for-e-rec (1- k)))
(numerator-of-convergence-for-e-rec (- k 2))))
(t (+ (numerator-of-convergence-for-e-rec (1- k))
(numerator-of-convergence-for-e-rec (- k 2))))))
which works for small k but gets pretty slow for k = 100, obviously.
I have no real idea how to transform this function to a version with could be tail-call optimized. I have seen a pattern using two accumulating variables for fibonacci numbers but fail to transform this pattern to my function.
Is there a general guideline how to transform complex recursions to tco versions or should I implement an iterative solution directly.?
First, note that memoization is probably the simplest way optimize your code: it does not reverse the flow of operations; you call your function with a given k and it goes back to zero to compute the previous values, but with a cache. If however you want to turn your function from recursive to iterative with TCO, you'll have to compute things from zero up to k and pretend you have a constant-sized stack / memory.
Step function
First, write a function which computes current n given k, n-1 and n-2:
(defun n (k n1 n2)
(if (plusp k)
(case k
(1 2)
(2 3)
(t (multiple-value-bind (quotient remainder) (floor k 3)
(if (zerop remainder)
(+ (* 2 quotient n1) n2)
(+ n1 n2)))))
0))
This step should be easy; here, I rewrote your function a little bit but I actually only extracted the part that computes n given the previous n and k.
Modified function with recursive (iterative) calls
Now, you need to call n from k starting from 0 to the maximal value you want to be computed, named m hereafter. Thus, I am going to add a parameter m, which controls when the recursive call stops, and call n recursively with the modified arguments. You can see the arguments are shifted, current n1 is the next n2, etc.
(defun f (m k n1 n2)
(if (< m k)
n1
(if (plusp k)
(case k
(1 (f m (1+ k) 2 n1))
(2 (f m (1+ k) 3 n1))
(t (multiple-value-bind (quotient remainder) (floor k 3)
(if (zerop remainder)
(f m (1+ k) (+ (* 2 quotient n1) n2) n1)
(f m (1+ k) (+ n1 n2) n1)))))
(f m (1+ k) 0 n1))))
That's all, except that you don't want to show this interface to your user. The actual function g properly bootstraps the initial call to f:
(defun g (m)
(f m 0 0 0))
The trace for this function exhibits an arrow ">" shape, which is the case with tail-recursive functions (tracing is likely to inhibit tail-call optimization):
0: (G 5)
1: (F 5 0 0 0)
2: (F 5 1 0 0)
3: (F 5 2 2 0)
4: (F 5 3 3 2)
5: (F 5 4 8 3)
6: (F 5 5 11 8)
7: (F 5 6 19 11)
7: F returned 19
6: F returned 19
5: F returned 19
4: F returned 19
3: F returned 19
2: F returned 19
1: F returned 19
0: G returned 19
19
Driver function with a loop
The part that can be slightly difficult, or make your code hard to read, is when we inject tail-recursive calls inside the original function n. I think it is better to use a loop instead, because:
unlike with the tail-recursive call, you can guarantee that the code will behave as you wish, without worrying whether your implementation will actually optimize tail-calls or not.
the code for the step function n is simpler and only expresses what is happening, instead of detailing how (tail-recursive calls are just an implementation detail here).
With the above function n, you can change g to:
(defun g (m)
(loop
for k from 0 to m
for n2 = 0 then n1
for n1 = 0 then n
for n = (n k n1 n2)
finally (return n)))
Is there a general guideline how to transform complex recursions to
tco versions or should I implement an iterative solution directly?
Find a step function which advances the computation from the base case to the general case, and put intermediate variables as parameters, in particular results from past calls. This function can call itself (in which case it will be tail-recursive, because you have to compute all the arguments first), or simply called in a loop. You have to be careful when computing the initial values, you might have more corner cases than with a simple recursive function.
 See also
Scheme's named let, the RECUR macro in Common Lisp and the recur special form in Clojure.

Recursively find element position in list using LISP

Here is my problem:Without using MEMBER, complete the following definition of a recursive function POS
such that if L is a list and E is an element of L then (POS E L) returns the position of the first
occurrence of E in L, and such that if E is not an element of L then (POS E L) returns 0.This is the solution have come up with:
(DEFUN POS (E L)
(COND ((ENDP L) 0)
((EQUAL E (CAR L)) 1 )
(T
(+ 1 (POS E (CDR L)) )
)))
The algorithm works fine if the element I am looking for is in the list. My problem is that when the element is not in the list I will get the length of the list.
Example:
list[1,2,3,4] Find: 5 will reurn 4
How do I get it to return 0 if element is not found. And as it is functional programming I can't use loops or variable.
You always return (+ 1 <recursive-call>). But what if the recursive result is zero? You should check that return value before computing the result.
if you find an occurence, return 1
if you don't find a result, compute recursively, which gives you R
if R is zero, return zero
otherwise, return R + 1
As an aside, the Common Lisp way would be:
(or (position E L :test #'equal) 0)
As #coredump has explained, the problem is that you are always adding 1 to the result, even if you haven't found the element. I would keep the track of the current position within the list by adding an extra parameter to function POS:
(defun pos (element list &optional (start 0))
(cond ((endp list) 0)
((equal element (first list)) (1+ start))
(t (pos element (rest list) (1+ start)))))
Testing:
(pos 'a '(b a c d a))
2
(pos 'a '(a d a f g))
1
(pos 'w '(a b c d e f))
0
One extra benefit: this function generates iterative process due to recursive call being in tail-call position (however, ANSI Common Lisp does not guarantee it will do tail-call optimization! AFAIK, CLisp doesn't do it; SBCL and CCL will do for optimized code, see DECLARE). More idiomatic Common Lisp solution would be using LOOP:
(defun pos (element list)
(loop for x in list
counting x into pos
when (equal element x)
return pos
end
finally (return 0)))

Summation in functional programming

I was searching in the web for exclusion-Inclusion principle, what i have found is this:
(from MathWorld - A Wolfram Web Resource: wolfram.com)
http://mathworld.wolfram.com/Inclusion-ExclusionPrinciple.html
I doesn't matter if you don't understand the formula, in fact, what i need is to implement this:
For example, the input is:
(summation (list 1 2) 3)
Where (list 1 2) is i and j and 3 is the limit of the sum n.
(n had to be up the sigma but...)
Then, the output of formula, in Scheme will be:
(list (list 1 2) (list 1 3) (list 2 3))
How can i implemment this in Scheme or in Haskell? (sorry for my English).
In Haskell, use a list comprehension:
Prelude> [(i,j) | i <- [1..4], j <- [i+1..4]]
[(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
Prelude> [i * j | i <- [1..4], j <- [i+1..4]]
[2,3,4,6,8,12]
Prelude> sum [i * j | i <- [1..4], j <- [i+1..4]]
35
First line gives all a list of all pairs (i,j) where 1 <= i < j <= 4
Second line gives a list of i*j where 1 <= i < j <= 4
Third line gives sum of these values: Σ1 <= i < j <= 4 i*j.
In racket, you'd probably use a list comprehension:
#lang racket
(for*/sum ([i (in-range 1 5)]
[j (in-range (add1 i) 5)])
(* i j))
The core functionality you need for a simple implementation of the inclusion-exclusion principle is to generate all k-element subsets of the index set. Using lists, that is an easy recursion:
pick :: Int -> [a] -> [[a]]
pick 0 _ = [[]] -- There is exactly one 0-element subset of any set
pick _ [] = [] -- No way to pick any nonzero number of elements from an empty set
pick k (x:xs) = map (x:) (pick (k-1) xs) ++ pick k xs
-- There are two groups of k-element subsets of a set containing x,
-- those that contain x and those that do not
If pick is not a local function whose calls are 100% under your control, you should add a check that the Int parameter is never negative (you could use Word for that parameter, then that's built into the type).
If k is largish, checking against the length of the list to pick from prevents a lot of fruitless recursion, so it's better to build that in from the start:
pick :: Int -> [a] -> [[a]]
pick k xs = choose k (length xs) xs
choose :: Int -> Int -> [a] -> [[a]]
choose 0 _ _ = [[]]
choose k l xs
| l < k = [] -- we want to choose more than we have
| l == k = [xs] -- we want exactly as many as we have
| otherwise = case xs of
[] -> error "This ought to be impossible, l == length xs should hold"
(y:ys) -> map (y:) (choose (k-1) (l-1) ys) ++ choose k (l-1) ys
The inclusion-exclusion formula then becomes
inclusionExclusion indices
= sum . zipWith (*) (cycle [1,-1]) $
[sum (map count $ pick k indices) | k <- [1 .. length indices]]
where count list counts the number of elements of the intersection of [subset i | i <- list]. Of course, you need an efficient way to calculate that, or it would be more efficient to find the size of the union directly.
There's much room for optimisation, and there are different ways to do it, but that's a fairly short and direct translation of the principle.
Here is a possible way with Scheme. I've made the following function to create quantification
#lang racket
(define (quantification next test op e)
{lambda (A B f-terme)
(let loop ([i A] [resultat e])
(if [test i B]
resultat
(loop (next i) (op (f-terme i) resultat)) ))})
With this function you can create sum, product, generalized union and generalized intersection.
;; Arithmetic example
(define sumQ (quantification add1 > + 0))
(define productQ (quantification add1 > * 1))
;; Sets example with (require
(define (unionQ set-of-sets)
(let [(empty-set (set))
(list-of-sets (set->list set-of-sets))
]
((quantification cdr eq? set-union empty-set) list-of-sets
'()
car)))
(define (intersectionQ set-of-sets)
(let [(empty-set (set))
(list-of-sets (set->list set-of-sets))
]
((quantification cdr eq? set-intersect (car list-of-sets)) (cdr list-of-sets)
'()
car)))
This way you can do
(define setA2 (set 'a 'b))
(define setA5 (set 'a 'b 'c 'd 'e))
(define setC3 (set 'c 'd 'e))
(define setE3 (set 'e 'f 'g))
(unionQ (set setA2 setC3 setE3))
(intersectionQ (set setA5 setC3 setE3))
I work on something similar in Haskell
module Quantification where
quantifier next test op =
let loop e a b f = if (test a b)
then e
else loop (op (f a) e) (next a) b f
in loop
quantifier_on_integer_set = quantifier (+1) (>)
sumq = quantifier_on_integer_set (+) 0
prodq = quantifier_on_integer_set (*) 1
But I never go further... Probably that you can start from this however.

Resources