Related
I am studying about haskell recursion. and when i read about recursion topic which talk about this two different type of recursion. i am understand how tail recursion works and its step to be done. i am not understand how is primitive recursion done in background. can anyone here help explain more about primitive and given some example ?
For example : tail recursion
sum:: [Int] -> Int
sum [] = 0
sum (x:xs) = x+ (sum xs)
process of sum [1,2,3,4]:
= 1 + sum[2,3,4]
= 1 + (2 + sum [3,4] )
= 1 + ( 2 + ( 3 + sum[4]) )
= 1 + (2 + (3 ( 4 + sum[])))
= 1 + (2 + ( 3 + ( 4 + 0 ) ) )
= 10
How does primitive recursion works?
Intuitively, we have tail recursion when we have a recursive function such that, when a recursive call is performed, the result of that call is the result of the function. In a sense, after the recursive call "there is nothing more to be done".
-- tail recursion
f1 n = if ... then ... else f1 (n - 1)
-- not tail recursion
f2 n = if ... then ... else 5 * f2 (n - 1)
Primitive recursion is another beast. We have primitive recursion when every recursive call is done using an argument which is a "direct subterm" of the original one.
-- primitive recursion (& non-tail recursion)
f1 (x:xs) = g x (f1 xs) -- xs is asubterm of x:xs
-- a tree type
data T = K Int T T
-- primitive recursion (& non-tail recursion)
f2 (K n l r) = h n (f2 l) (f2 r) -- l, r are subterms
-- non-primitive recursion (& tail recursion)
f3 (K n l (K m rl rr)) = f3 (K m (K n rl l) rl) -- not a subterm
I'm writing a function like this:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ]
let t1 = [ w | (u,v) <- zip t (tail t), let w = if (u == 2) && (v == 0) then 2 else v]
head t : t1
What the first let does is: return a list like this: [2,0,0,0,1,0], from the second let and the following line, I want the output to be like this: [2,2,2,2,1,0]. But, it's not working and giving parse error!!
What am I doing wrong?
There are two kinds of lets: the "let/in" kind, which can appear anywhere an expression can, and the "let with no in" kind, which must appear in a comprehension or do block. Since your function definition isn't in either, its let's must use an in, for example:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ] in
let t1 = [ w | (u,v) <- zip t (tail t), let w = if (x == 2) && (y == 0) then 2 else y] in
return (head t : t1)
Alternately, since you can define multiple things in each let, you could consider:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ]
t1 = [ w | (u,v) <- zip t (tail t), let w = if (x == 2) && (y == 0) then 2 else y]
in return (head t : t1)
The code has other problems, but this should get you to the point where it parses, at least.
With an expression formed by a let-binding, you generally need
let bindings
in
expressions
(there are exceptions when monads are involved).
So, your code can be rewritten as follows (with simplification of r and w, which were not really necessary):
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ if y == 0 && x == 2 then 2 else y | (x,y) <- zip lst1 lst2]
t1 = [ if (v == 0) && (u == 2) then 2 else v | (u,v) <- zip t (tail t)]
in
head t : t1
(Note, I also switched u and v so that t1 and t has similar forms.
Now given a list like [2,0,0,0,1,0], it appears that your code is trying to replace 0 with 2 if the previous element is 2 (from the pattern of your code), so that eventually, the desired output is [2,2,2,2,1,0].
To achieve this, it is not enough to use two list comprehensions or any fixed number of comprehensions. You need to somehow apply this process recursively (again and again). So instead of only doing 2 steps, we can write out one step, (and apply it repeatedly). Taking your t1 = ... line, the one step function can be:
testing' lst =
let
t1 = [ if (u == 2) && (v == 0) then 2 else v | (u,v) <- zip lst (tail lst)]
in
head lst : t1
Now this gives:
*Main> testing' [2,0,0,0,1,0]
[2,2,0,0,1,0]
, as expected.
The rest of the job is to apply testing' as many times as necessary. Here applying it (length lst) times should suffice. So, we can first write a helper function to apply another function n times on a parameter, as follows:
apply_n 0 f x = x
apply_n n f x = f $ apply_n (n - 1) f x
This gives you what you expected:
*Main> apply_n (length [2,0,0,0,1,0]) testing' [2,0,0,0,1,0]
[2,2,2,2,1,0]
Of course, you can wrap the above in one function like:
testing'' lst = apply_n (length lst) testing' lst
and in the end:
*Main> testing'' [2,0,0,0,1,0]
[2,2,2,2,1,0]
NOTE: this is not the only way to do the filling, see the fill2 function in my answer to another question for an example of achieving the same thing using a finite state machine.
I have been reading a little bit about functional programming on the web lately and I think I got a basic idea about the concepts behind it.
I'm curious how everyday programming problems which involve some kind of state are solved in a pure functional programing language.
For example: how would the word count program from the book 'The C programming Language' be implemented in a pure functional language?
Any contributions are welcome as long as the solution is in a pure functional style.
Here's the word count C code from the book:
#include <stdio.h>
#define IN 1 /* inside a word */
#define OUT 0 /* outside a word */
/* count lines, words, and characters in input */
main()
{
int c, nl, nw, nc, state;
state = OUT;
nl = nw = nc = 0;
while ((c = getchar()) != EOF) {
++nc;
if (c == '\n')
++nl;
if (c == ' ' || c == '\n' || c = '\t')
state = OUT;
else if (state == OUT) {
state = IN;
++nw;
}
}
printf("%d %d %d\n", nl, nw, nc);
}
Basically, in a functional styly you'll want to divide the IO operation of getting your stream of data from the pure operation of some stateful transistion based on the current character and the current state.
The Haskell solution from Tikhon is very clean but performs three passes on your input data and will result in the entire input being contained in memory until the result is computed. You can process data incrementally, which I do below using the Text package but no other advanced Haskell tools (which could clean this up at the expense of understandability by non-Haskellers).
First we have our preamble:
{-# LANGUAGE BangPatterns #-}
import Data.Text.Lazy as T
import Data.Text.Lazy.IO as TIO
Then we define our data structure to hold the state of the process (number of characters, words, and lines along with the State IN/OUT):
data Counts = Cnt { nc, nl, nw :: !Int
, state :: State }
deriving (Eq, Ord, Show)
data State = IN | OUT
deriving (Eq, Ord, Show)
Now I define a "zero" state just for easy use. I'd normally make a number of helper functions or use a package like lense to make incrementing each field in the Counts structure simple, but will go without for this answer:
zeros :: Counts
zeros = Cnt 0 0 0 OUT
And now I translate your series of if/else statements into a pure state machine:
op :: Counts -> Char -> Counts
op c '\n' = c { nc = nc c + 1, nw = nw c + 1, nl = nl c + 1, state=OUT }
op c ch | ch == ' ' || ch == '\t' = c { nc = nc c + 1, state=OUT }
| state c == OUT = c { nc = nc c + 1, nw = nw c + 1, state = IN }
| otherwise = c { nc = nc c + 1 }
Finally the main function just gets the input stream and folds our operation over the characters:
main = do
contents <- TIO.getContents
print $ T.foldl' op zeros contents
EDIT: You mentioned not understanding the syntax. Here is an even simpler version that I will explain:
import Data.Text.Lazy as T
import Data.Text.Lazy.IO as TIO
op (nc, nw, nl, st) ch
| ch == '\n' = (nc + 1, nw + 1 , nl + 1, True)
| ch == ' ' || ch == '\t' = (nc + 1, nw , nl , True)
| st = (nc + 1, nw + 1 , nl , False)
| otherwise = (nc + 1, nw , nl , st)
main = do
contents <- TIO.getContents
print $ T.foldl' op (0,0,0,True) contents
The import statements give us access to the getContents and foldl' functions we use.
The op function uses a bunch of guards - parts like | ch = '\n' - which is basically like a C if/elseif/else series.
The tuples ( ... , ... , ... , ... ) contain all our state. Haskell variables are immutable, so we make new tuples by adding one (or not) to the values of the previous variables.
A simple way to do it would be to read in the input and then use some simple functions to get the line/word/character count. Something like this would work:
count :: String -> (Int, Int, Int)
count str = (length $ lines str, length $ words str, length str)
main :: IO ()
main = fmap count getContents >>= print
This isn't exactly the same, but it's close.
This works really simply. Given a string, we can turn it into a list of lines with the standard lines function and a list of words with the standard words function. Since String is just [Char], length returns the number of characters. This is how we get the three counts. (For reference, length $ lines str is the same as length (lines str).)
The important idea is how the IO--reading the input and printing it out--is separated from the actual logic.
Also, instead of going through the input character by character keeping track of some state, we get the actual numbers by applying simple functions to the input. These functions are all just compositions of standard library functions.
In your loop there are four state variables, nc, nw, nl and state, plus the next character c. The loop remembers nc, nw, nl and state from the last time through the loop, and c changes each iteration through the loop. Imagine instead that you take those variables out of the loop and put them in a vector: [state, nc, nw, nl]. Then you change your loop construct into a function that takes two arguments, the first being a vector [state, nc, nw, nl], and the second being c, and returns a new vector with the updated values of nc, nw, nl and state. In C-ish pseudocode:
f([state, nc, nw, nl], c) {
++nc;
if (c == '\n')
++nl;
if (c == ' ' || c == '\n' || c = '\t')
state = OUT;
else if (state == OUT) {
state = IN;
++nw;
}
return [state, nc, nw, nl];
}
Now you can call that function with the vector [OUT, 0, 0, 0] and the first character in the string ("hello, world", say), and it will return a new vector [IN, 1, 0, 0]. Call f again with this new vector and the second character 'e', and it returns [IN, 2, 0, 0]. Repeat for the rest of the characters in the string, and the last call will return [IN, 12, 2, 0], identical to the values printed by the C code.
The basic idea is that you take the state variables out of the loop, turn the guts of the loop into a function, and pass the vector of state variables and the next input in as arguments to that function, and return a new state vector as a result. There is a function called reduce that does this.
Here's how you would do it in Clojure (formatted to emphasize the vectors returned):
(defn f [[state nc nw nl] c]
(let [nl (if (= c \n)(inc nl) nl)]
(cond
(or (= c \space)(= c \n)(= c \t)) [:out (inc nc) nw nl]
(= state :out) [:in (inc nc) (inc nw) nl]
true [state (inc nc) nw nl]
)))
(defn wc [s] (reduce f [:out 0 0 0] s))
(wc "hello, world")
which returns (and prints in the repl) [:in 12 2 0]
Here's my shot at a purely functional, strict, single-pass, tail-recursive solution in Scheme:
(define (word-count input-port)
(let loop ((c (read-char input-port))
(nl 0)
(nw 0)
(nc 0)
(state 'out))
(cond ((eof-object? c)
(printf "nl: ~s, nw: ~s, nc: ~s\n" nl nw nc))
((char=? c #\newline)
(loop (read-char input-port) (add1 nl) nw (add1 nc) 'out))
((char-whitespace? c)
(loop (read-char input-port) nl nw (add1 nc) 'out))
((eq? state 'out)
(loop (read-char input-port) nl (add1 nw) (add1 nc) 'in))
(else
(loop (read-char input-port) nl nw (add1 nc) state)))))
word-count receives an input port as a parameter; notice that no additional data structures are created (structs, tuples, vectors, etc.) instead, all state is kept in parameters. As an example, for counting the words in a file containing this:
hello, world
Call the procedure like this:
(call-with-input-file "/path/to/file" word-count)
> nl: 0, nw: 2, nc: 12
Common Lisp is mentioned, but it is not a pure functional programming language and it does not support TCO in its standard. Individual implementations do.
Tail recursive version, if the compiler supports it:
(defun word-count (&optional (stream *standard-input*))
(labels ((word-count-aux (in-p chars words lines)
(case (read-char stream nil :eof)
(:eof (values chars words lines))
(#\newline (word-count-aux nil (1+ chars) words (1+ lines)))
((#\space #\tab) (word-count-aux nil (1+ chars) words lines))
(otherwise (word-count-aux t
(1+ chars)
(if in-p words (1+ words))
lines)))))
(word-count-aux nil 0 0 0)))
But since TCO is not in the standard, a portable version would look more like this:
(defun word-count (&optional (stream *standard-input*)
&aux (in-p nil) (chars 0) (words 0) (lines 0) char)
(loop while (setf char (read-char stream nil nil)) do
(case char
(#\newline (setf in-p nil) (incf lines))
((#\space #\tab) (setf in-p nil))
(otherwise (unless in-p (incf words)) (setf in-p t)))
(incf chars))
(values chars words lines))
Above is no longer Functional.
We can replace the loop with a higher-order stream-map:
(defun stream-map (function stream)
(loop for char = (read-char stream nil nil)
while char do (funcall function char)))
(defun word-count (&optional (stream *standard-input*)
&aux (in-p nil) (chars 0) (words 0) (lines 0) char)
(stream-map (lambda (char)
(incf chars)
(when (eql char #\newline)
(incf lines))
(if (member char '(#\space #\newline #\tab))
(setf in-p nil)
(unless in-p
(incf words)
(setf in-p t))))
stream)
(values chars words lines))
The state is modified by the closure. To get rid of that we can implement a stream-reduce.
(defun stream-reduce (function stream &key initial-value)
(let ((value initial-value))
(loop for char = (read-char stream nil nil)
while char
do (setf value (funcall function value char)))
value))
(defun word-count (&optional (stream *standard-input*))
(rest (stream-reduce
(lambda (state char)
(destructuring-bind (in-p chars words lines) state
(case char
(#\newline (list nil (1+ chars) words (1+ lines)))
((#\space #\tab) (list nil (1+ chars) words lines))
(otherwise (list t
(1+ chars)
(if in-p words (1+ words))
lines)))))
stream
:initial-value (list nil 0 0 0))))
Here is a Scheme version of the program, from my blog, which implements the entire Unix word count program, including argument- and file-handling. The key function is wc, which is purely functional. It moves all local variables into the arguments of a local function (defined via named-let), which is the standard idiom for converting an imperative loop to functional style. The man page and code appear below:
NAME
wc -- word count
SYNOPSIS
wc [ -lwc ] [ name ... ]
DESCRIPTION
Wc counts lines, words and characters in the named files,
or in the standard input if no name appears. A word is a
maximal string of characters delimited by spaces, tabs or
newlines.
If the optional argument is present, just the specified
counts (lines, words, or characters) are selected by the
letters l, w or c.
#! /usr/bin/scheme --script
(define l-flag #t)
(define w-flag #t)
(define c-flag #t)
(define (update-flags fs)
(if (not (member #\l fs)) (set! l-flag #f))
(if (not (member #\w fs)) (set! w-flag #f))
(if (not (member #\c fs)) (set! c-flag #f)))
(define (put-dec n width)
(let* ((n-str (number->string n)))
(display (make-string (- width (string-length n-str)) #\space))
(display n-str)))
(define (wc)
(let loop ((inword #f) (c (read-char)) (ls 0) (ws 0) (cs 0))
(cond ((eof-object? c) (values ls ws cs))
((char=? c #\newline)
(loop #f (read-char) (add1 ls) ws (add1 cs)))
((not (member c '(#\space #\newline #\tab)))
(if inword
(loop #t (read-char) ls ws (add1 cs))
(loop #t (read-char) ls (add1 ws) (add1 cs))))
(else (loop #f (read-char) ls ws (add1 cs))))))
(define (main args)
(when (and (pair? args) (char=? (string-ref (car args) 0) #\-))
(update-flags (cdr (string->list (car args))))
(set! args (cdr args)))
(if (null? args)
(let-values (((ls ws cs) (wc)))
(when l-flag (display ls) (display " "))
(when w-flag (display ws) (display " "))
(when c-flag (display cs) (display " "))
(newline))
(let loop ((args args) (l-tot 0) (w-tot 0) (c-tot 0))
(if (null? args)
(begin (when l-flag (put-dec l-tot 12))
(when w-flag (put-dec w-tot 12))
(when c-flag (put-dec c-tot 12)))
(with-input-from-file (car args)
(lambda ()
(let-values (((ls ws cs) (wc)))
(when l-flag (put-dec ls 12))
(when w-flag (put-dec ws 12))
(when c-flag (put-dec cs 12))
(display " ") (display (car args)) (newline)
(loop (cdr args) (+ l-tot ls) (+ w-tot ws) (+ c-tot cs)))))))))
(main (cdr (command-line)))
Here's a solution based on the Clojure example posted here but in CL using recursion.
(defstruct (state (:constructor make-state (state chars words lines)))
state chars words lines)
(defun wc (state stream)
(symbol-macrolet ((s (state-state state))
(c (state-chars state))
(w (state-words state))
(l (state-lines state)))
(case (read-char stream nil :eof)
(:eof state)
(#\Newline (wc (make-state :out (1+ c) w (1+ l)) stream))
(#\Space (wc (make-state :out (1+ c) w l) stream))
(t (if (eq s :out)
(wc (make-state :in (1+ c) (1+ w) l) stream)
(wc (make-state :in (1+ c) w l) stream))))))
(with-input-from-string (stream "Hello Functional Programming World")
(wc (make-state :out 0 0 0) stream))
;;; => #S(STATE :STATE :IN :CHARS 34 :WORDS 4 :LINES 0)
I believe you could write this somewhat more elegantly while still only iterating over the input once, but you'll need to make GHC do more work, certainly use -O2.
I have not yet compiled this code, much less compared it's speed vs. Thomas DuBuisson's answer, but this should indicate the basic direction.
{-# LANGUAGE BangPatterns #-}
import Data.List
wordcount = snd . foldl' go (False,0)
where go (!b,!n) !c = if elem c [' ','\t','\n'] then (False,n)
else (True, n + if b then 0 else 1)
linecount = foldl' go 0
where go !n !c = n + if c == '\n' then 1 else 0
main = interact $ show . go
where go x = (linecount x, wordcount x, foldl' (\!n _ ->n+1) 0 x)
If I understand stream fusion correctly, then GHC should inline wordcount and linecount into main, merge the three foldl' commands into one, well hopefully, and start rearranging the if checks. I'd hope it'd inlined elem and foldl' too of course.
If not, you could certainly force inlining and probably create a simple fusion rule, but maybe the defaults suffice. Or maybe some simple alterations produce the desired effect.
Btw, I have written foldl' (\n _ ->n+1) 0 x only because I've heard bad storied about length, but maybe length works fine, another change worth profiling.
In Haskell using strict IO rather than lazy. Does words only but you can easily implement characters and lines on top of this. Requires the text and conduit packages:
module Main
where
import Control.Applicative
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Text as CT
import qualified Data.Text as T
import System.Environment
main :: IO ()
main = do args <- getArgs
print <$> (runResourceT $
CB.sourceFile (args !! 0)
$$ CB.lines
=$= CT.decode CT.utf8
=$= CL.map T.words
=$ CL.fold (\acc words -> acc + length words) 0)
Here's a version in Typed Racket using match and the for loop macros:
(: word-count : Input-Port -> Void)
(define (word-count in)
(define-values (nl nw nc st)
(for/fold: ([nl : Integer 0] [nw : Integer 0] [nc : Integer 0]
[state : (U 'in 'out) 'out])
([c (in-input-port-chars in)])
(match* (c state)
[(#\newline _) (values (add1 nl) nw (add1 nc) 'out)]
[((? char-whitespace?) _)
(values (add1 nl) nw (add1 nc) 'out)]
[(_ 'out) (values nl (add1 nw) (add1 nc) 'in)]
[(_ _) (values nl nw (add1 nc) state)])))
(printf "nl: ~s, nw: ~s, nc: ~s\n" nl nw nc))
Here is a Haskell implementation, where I have tried to stay close to the approach followed by the original C program. Iterations often become fold operations, with state-containing variables ending up as the first argument to the operation passed to fold.
-- Count characters, words, and lines in an input string.
wordCount::String->(Int, Int, Int)
wordCount str = (c,w,l)
where (inWord,c,w,l) = foldl op (False,0,0,1) str
where op (inWord,c,w,l) next | next == '\n' = (False,c+1,w,l+1)
| next == '\t' || next == ' ' = (False,c+1,w,l)
| inWord == False = (True,c+1,w+1,l)
| otherwise = (True,c+1,w,l)
main = interact $ show . wordCount
I am doing another Project Euler problem and I need to find when the result of these 3 lists is equal (we are given 40755 as the first time they are equal, I need to find the next:
hexag n = [ n*(2*n-1) | n <- [40755..]]
penta n = [ n*(3*n-1)/2 | n <- [40755..]]
trian n = [ n*(n+1)/2 | n <- [40755..]]
I tried adding in the other lists as predicates of the first list, but that didn't work:
hexag n = [ n*(2*n-1) | n <- [40755..], penta n == n, trian n == n]
I am stuck as to where to to go from here.
I tried graphing the function and even calculus but to no avail, so I must resort to a Haskell solution.
Your functions are weird. They get n and then ignore it?
You also have a confusion between function's inputs and outputs. The 40755th hexagonal number is 3321899295, not 40755.
If you really want a spoiler to the problem (but doesn't that miss the point?):
binarySearch :: Integral a => (a -> Bool) -> a -> a -> a
binarySearch func low high
| low == high = low
| func mid = search low mid
| otherwise = search (mid + 1) high
where
search = binarySearch func
mid = (low+high) `div` 2
infiniteBinarySearch :: Integral a => (a -> Bool) -> a
infiniteBinarySearch func =
binarySearch func ((lim+1) `div` 2) lim
where
lim = head . filter func . lims $ 0
lims x = x:lims (2*x+1)
inIncreasingSerie :: (Ord a, Integral i) => (i -> a) -> a -> Bool
inIncreasingSerie func val =
val == func (infiniteBinarySearch ((>= val) . func))
figureNum :: Integer -> Integer -> Integer
figureNum shape index = (index*((shape-2)*index+4-shape)) `div` 2
main :: IO ()
main =
print . head . filter r $ map (figureNum 6) [144..]
where
r x = inIncreasingSerie (figureNum 5) x && inIncreasingSerie (figureNum 3) x
Here's a simple, direct answer to exactly the question you gave:
*Main> take 1 $ filter (\(x,y,z) -> (x == y) && (y == z)) $ zip3 [1,2,3] [4,2,6] [8,2,9]
[(2,2,2)]
Of course, yairchu's answer might be more useful in actually solving the Euler question :)
There's at least a couple ways you can do this.
You could look at the first item, and compare the rest of the items to it:
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [4,5,6] ]
False
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [1,2,3] ]
True
Or you could make an explicitly recursive function similar to the previous:
-- test.hs
f [] = True
f (x:xs) = f' x xs where
f' orig (y:ys) = if orig == y then f' orig ys else False
f' _ [] = True
Prelude> :l test.hs
[1 of 1] Compiling Main ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main> f [ [1,2,3], [1,2,3], [1,2,3] ]
True
*Main> f [ [1,2,3], [1,2,3], [4,5,6] ]
False
You could also do a takeWhile and compare the length of the returned list, but that would be neither efficient nor typically Haskell.
Oops, just saw that didn't answer your question at all. Marking this as CW in case anyone stumbles upon your question via Google.
The easiest way is to respecify your problem slightly
Rather than deal with three lists (note the removal of the superfluous n argument):
hexag = [ n*(2*n-1) | n <- [40755..]]
penta = [ n*(3*n-1)/2 | n <- [40755..]]
trian = [ n*(n+1)/2 | n <- [40755..]]
You could, for instance generate one list:
matches :: [Int]
matches = matches' 40755
matches' :: Int -> [Int]
matches' n
| hex == pen && pen == tri = n : matches (n + 1)
| otherwise = matches (n + 1) where
hex = n*(2*n-1)
pen = n*(3*n-1)/2
tri = n*(n+1)/2
Now, you could then try to optimize this for performance by noticing recurrences. For instance when computing the next match at (n + 1):
(n+1)*(n+2)/2 - n*(n+1)/2 = n + 1
so you could just add (n + 1) to the previous tri to obtain the new tri value.
Similar algebraic simplifications can be applied to the other two functions, and you can carry all of them in accumulating parameters to the function matches'.
That said, there are more efficient ways to tackle this problem.
I am doing yet another projecteuler question in Haskell, where I must find if the sum of the factorials of each digit in a number is equal to the original number. If not repeat the process until the original number is reached. The next part is to find the number of starting numbers below 1 million that have 60 non-repeating units. I got this far:
prob74 = length [ x | x <- [1..999999], 60 == ((length $ chain74 x)-1)]
factorial n = product [1..n]
factC x = sum $ map factorial (decToList x)
chain74 x | x == 0 = []
| x == 1 = [1]
| x /= factC x = x : chain74 (factC x)
But what I don't know how to do is to get it to stop once the value for x has become cyclic. How would I go about stopping chain74 when it gets back to the original number?
When you walk through the list that might contain a cycle your function needs to keep track of the already seen elements to be able to check for repetitions. Every new element is compared against the already seen elements. If the new element has already been seen, the cycle is complete, if it hasn't been seen the next element is inspected.
So this calculates the length of the non-cyclic part of a list:
uniqlength :: (Eq a) => [a] -> Int
uniqlength l = uniqlength_ l []
where uniqlength_ [] ls = length ls
uniqlength_ (x:xs) ls
| x `elem` ls = length ls
| otherwise = uniqlength_ xs (x:ls)
(Performance might be better when using a set instead of a list, but I haven't tried that.)
What about passing another argument (y for example) to the chain74 in the list comprehension.
Morning fail so EDIT:
[.. ((length $ chain74 x x False)-1)]
chain74 x y not_first | x == y && not_first = replace_with_stop_value_:-)
| x == 0 = []
| x == 1 = [1]
| x == 2 = [2]
| x /= factC x = x : chain74 (factC x) y True
I implemented a cycle-detection algorithm in Haskell on my blog. It should work for you, but there might be a more clever approach for this particular problem:
http://coder.bsimmons.name/blog/2009/04/cycle-detection/
Just change the return type from String to Bool.
EDIT: Here is a modified version of the algorithm I posted about:
cycling :: (Show a, Eq a) => Int -> [a] -> Bool
cycling k [] = False --not cycling
cycling k (a:as) = find 0 a 1 2 as
where find _ _ c _ [] = False
find i x c p (x':xs)
| c > k = False -- no cycles after k elements
| x == x' = True -- found a cycle
| c == p = find c x' (c+1) (p*2) xs
| otherwise = find i x (c+1) p xs
You can remove the 'k' if you know your list will either cycle or terminate soon.
EDIT2: You could change the following function to look something like:
prob74 = length [ x | x <- [1..999999], let chain = chain74 x, not$ cycling 999 chain, 60 == ((length chain)-1)]
Quite a fun problem. I've come up with a corecursive function that returns the list of the "factorial chains" for every number, stopping as soon as they would repeat themselves:
chains = [] : let f x = x : takeWhile (x /=) (chains !! factC x) in (map f [1..])
Giving:
take 4 chains == [[],[1],[2],[3,6,720,5043,151,122,5,120,4,24,26,722,5044,169,363601,1454]]
map head $ filter ((== 60) . length) (take 10000 chains)
is
[1479,1497,1749,1794,1947,1974,4079,4097,4179,4197,4709,4719,4790,4791,4907,4917
,4970,4971,7049,7094,7149,7194,7409,7419,7490,7491,7904,7914,7940,7941,9047,9074
,9147,9174,9407,9417,9470,9471,9704,9714,9740,9741]
It works by calculating the "factC" of its position in the list, then references that position in itself. This would generate an infinite list of infinite lists (using lazy evaluation), but using takeWhile the inner lists only continue until the element occurs again or the list ends (meaning a deeper element in the corecursion has repeated itself).
If you just want to remove cycles from a list you can use:
decycle :: Eq a => [a] -> [a]
decycle = dc []
where
dc _ [] = []
dc xh (x : xs) = if elem x xh then [] else x : dc (x : xh) xs
decycle [1, 2, 3, 4, 5, 3, 2] == [1, 2, 3, 4, 5]