I'm trying to implement the following recursive definition for addition in F#
m + 0 := m
m + (n + 1) := (m + n) + 1
I can't seem to get the syntax correct, The closest I've come is
let rec plus x y =
match y with
| 0 -> x;
| succ(y) -> succ( plus(x y) );
Where succ n = n + 1. It throws an error on pattern matching for succ.
I'm not sure what succ means in your example, but it is not a pattern defined in the standard F# library. Using just the basic functionality, you'll need to use a pattern that matches any number and then subtract one (and add one in the body):
let rec plus x y =
match y with
| 0 -> x
| y -> 1 + (plus x (y - 1))
In F# (unlike e.g. in Prolog), you can't use your own functions inside patterns. However, you can define active patterns that specify how to decompose input into various cases. The following takes an integer and returns either Zero (for zero) or Succ y for value y + 1:
let (|Zero|Succ|) n =
if n < 0 then failwith "Unexpected!"
if n = 0 then Zero else Succ(n - 1)
Then you can write code that is closer to your original version:
let rec plus x y =
match y with
| Zero -> x
| Succ y -> 1 + (plus x y)
As Tomas said, you can't use succ like this without declaring it. What you can do is to create a discriminated union that represents a number:
type Number =
| Zero
| Succ of Number
And then use that in the plus function:
let rec plus x y =
match y with
| Zero -> x
| Succ(y1) -> Succ (plus x y1)
Or you could declare it as the + operator:
let rec (+) x y =
match y with
| Zero -> x
| Succ(y1) -> Succ (x + y1)
If you kept y where I have y1, the code would work, because the second y would hide the first one. But I think doing so makes the code confusing.
type N = Zero | Succ of N
let rec NtoInt n =
match n with
| Zero -> 0
| Succ x -> 1 + NtoInt x
let rec plus x y =
match x with
| Zero -> y
| Succ n -> Succ (plus n y)
DEMO:
> plus (Succ (Succ Zero)) Zero |> NtoInt ;;
val it : int = 2
> plus (Succ (Succ Zero)) (Succ Zero) |> NtoInt ;;
val it : int = 3
let rec plus x y =
match y with
| 0 -> x
| _ -> plus (x+1) (y-1)
Related
I have a haskell assignment in which i have to create a function lastDigit x y of 2 arguments that calculates the sum of all [x^x | (0..x)], mine is too slow and i need to speed it up. Anyone has any ideas??
list :: Integral x=>x->[x]
list 0 = []
list x = list(div x 10) ++ [(mod x 10)]
sqrall :: Integer->[Integer]
sqrall x y = [mod (mod x 10^y)^x 10^y | x <- [1..x]]
lastDigits :: Integer -> Int -> [Integer]
lastDigits x y = drop (length((list(sum (sqrall x y))))-y) (list(sum (sqrall x)))
The main reason this will take too long is because you calculate the entire number of x^x, which scales super exponentially. This means that even for very small x, it will still take a considerable amount of time.
The point is however that you do not need to calculate the entire number. Indeed, you can make use of the fact that x×y mod n = (x mod n) × (y mod n) mod n. For example Haskell's arithmoi package makes use of this [src]:
powMod :: (Integral a, Integral b) => a -> b -> a -> a
powMod x y m
| m <= 0 = error "powModInt: non-positive modulo"
| y < 0 = error "powModInt: negative exponent"
| otherwise = f (x `rem` m) y 1 `mod` m
where
f _ 0 acc = acc
f b e acc = f (b * b `rem` m) (e `quot` 2)
(if odd e then (b * acc `rem` m) else acc)
We can make a specific version for modulo 10 with:
pow10 :: Integral i => i -> i
pow10 x = go x x
where go 0 _ = 1
go i j | odd i = rec * j `mod` 10
| otherwise = rec
where rec = go (div i 2) ((j*j) `mod` 10)
This then matches x^x `mod` 10, except that we do not need to calculate the entire number:
Prelude> map pow10 [1 .. 20]
[1,4,7,6,5,6,3,6,9,0,1,6,3,6,5,6,7,4,9,0]
Prelude> [x^x `mod` 10 | x <- [1..20]]
[1,4,7,6,5,6,3,6,9,0,1,6,3,6,5,6,7,4,9,0]
Now that we have that, we can also calculate the the sum of the two last digits with integers that range to at most 18:
sum10 :: Int -> Int -> Int
sum10 x y = (x + y) `mod` 10
we thus can calculate the last digit with:
import Data.List(foldl')
lastdigit :: Int -> Int
lastdigit x = foldl' sum10 0 (map pow10 [0 .. x])
For example for x = 26, we get:
Prelude Data.List> lastdigit 26
4
Prelude Data.List> sum [ x^x | x <- [0 .. 26] ]
6246292385799360560872647730684286774
I keep it as an exercise to generalize the above to calculate it for the last y digits. As long as y is relatively small, this will be efficient, since then the numbers never take huge amounts of memory. Furthermore if the numbers have an upper bound, addition, multiplication, etc. are done in constant time. If you however use an Integer, then the numbers can be arbitrary large, and thus operations like addition are not constant.
I created a function (mergesort) in ocaml but when I use it, the list is inverted.
In addition, I want to calculate the time the system takes to do the calculation, how can I do it?
let rec merge l x y = match (x,y) with
| ([],_) -> y
| (_,[]) -> x
| (h1::t1, h2::t2) ->
if l h1 h2
then h1::(merge l t1 y)
else h2::(merge l x t2);;
let rec split x y z = match x with
| [] -> (y,z)
| x::resto -> split resto z (x::y);;
let rec mergesort l x = match x with
| ([] | _::[]) -> x
| _ -> let (pri,seg) = split x [] []
in merge l (mergesort l pri) (mergesort l seg);;
mergesort (>) [2;6;1;8];;
- : int list = [8; 6; 2; 1]
Change the line if l h1 h2 by if l h2 h1. The way of comparing the head elements from the two sublists gives you a inverted list.
Also, I can propose you to use the following syntax when you have multiples recursives functions calling each other :
let rec merge cmp x y = match (x,y) with
| ([],_) -> y
| (_,[]) -> x
| (h1::t1, h2::t2) ->
if cmp h2 h1
then h1::(merge cmp t1 y)
else h2::(merge cmp x t2)
and split x y z = match x with
| [] -> (y,z)
| x::resto -> split resto z (x::y)
and mergesort cmp x = match x with
| ([] | _::[]) -> x
| _ -> let (pri,seg) = split x [] []
in (merge cmp (mergesort cmp pri) (mergesort cmp seg));;
To measure the time function, you can have a look here :
Running time in Ocaml
For benchmark a function see Core_Bench https://blogs.janestreet.com/core_bench-micro-benchmarking-for-ocaml/.
I'm trying to find all the integer lattice points within various 3D ellipses.
I would like my program to take an integer N, and count all the lattice points within the ellipses of the form ax^2 + by^2 + cz^2 = n, where a,b,c are fixed integers and n is between 1 and N. This program should then return N tuples of the form (n, numlatticePointsWithinEllipse n).
I'm currently doing it by counting the points on the ellipses ax^2 + by^2 + cz^2 = m, for m between 0 and n inclusive, and then summing over m. I'm also only looking at x, y and z all positive initially, and then adding in the negatives by permuting their signs later.
Ideally, I'd like to reach numbers of N = 1,000,000+ within the scale of hours
Taking a specific example of x^2 + y^2 + 3z^2 = N, here's the Haskell code I'm currently using:
import System.Environment
isqrt :: Int -> Int
isqrt 0 = 0
isqrt 1 = 1
isqrt n = head $ dropWhile (\x -> x*x > n) $ iterate (\x -> (x + n `div` x) `div` 2) (n `div` 2)
latticePointsWithoutNegatives :: Int -> [[Int]]
latticePointsWithoutNegatives 0 = [[0,0,0]]
latticePointsWithoutNegatives n = [[x,y,z] | x<-[0.. isqrt n], y<- [0.. isqrt (n - x^2)], z<-[max 0 (isqrt ((n-x^2 -y^2) `div` 3))], x^2 +y^2 + z^2 ==n]
latticePoints :: Int -> [[Int]]
latticePoints n = [ zipWith (*) [x1,x2,x3] y | [x1,x2,x3] <- (latticePointsWithoutNegatives n), y <- [[a,b,c] | a <- (if x1 == 0 then [0] else [-1,1]), b<-(if x2 == 0 then [0] else [-1,1]), c<-(if x3 == 0 then [0] else [-1,1])]]
latticePointsUpTo :: Int -> Int
latticePointsUpTo n = sum [length (latticePoints x) | x<-[0..n]]
listResults :: Int -> [(Int, Int)]
listResults n = [(x, latticePointsUpTo x) | x<- [1..n]]
main = do
args <- getArgs
let cleanArgs = read (head args)
print (listResults cleanArgs)
I've compiled this with
ghc -O2 latticePointsTest
but using the PowerShell "Measure-Command" command, I get the following results:
Measure-Command{./latticePointsTest 10}
TotalMilliseconds : 12.0901
Measure-Command{./latticePointsTest 100}
TotalMilliseconds : 12.0901
Measure-Command{./latticePointsTest 1000}
TotalMilliseconds : 31120.4503
and going any more orders of magnitude up takes us onto the scale of days, rather than hours or minutes.
Is there anything fundamentally wrong with the algorithm I'm using? Is there any core reason why my code isn't scaling well? Any guidance will be greatly appreciated. I may also want to process the data between "latticePoints" and "latticePointsUpTo", so I can't just rely entirely on clever number theoretic counting techniques - I need the underlying tuples preserved.
Some things I would try:
isqrt is not efficient for the range of values you are working work. Simply use the floating point sqrt function:
isqrt = floor $ sqrt ((fromIntegral n) :: Double)
Alternatively, instead of computing integer square roots, use logic like this in your list comprehensions:
x <- takeWhile (\x -> x*x <= n) [0..],
y <- takeWhile (\y -> y*y <= n - x*x) [0..]
Also, I would use expressions like x*x instead of x^2.
Finally, why not compute the number of solutions with something like this:
sols a b c n =
length [ () | x <- takeWhile (\x -> a*x*x <= n) [0..]
, y <- takeWhile (\y -> a*x*x+b*y*y <= n) [0..]
, z <- takeWhile (\z -> a*x*x+b*y*y+c*z*z <= n) [0..]
]
This does not exactly compute the same answer that you want because it doesn't account for positive and negative solutions, but you could easily modify it to compute your answer. The idea is to use one list comprehension instead of iterating over various values of n and summing.
Finally, I think using floor and sqrt to compute the integral square root is completely safe in this case. This code verifies that the integer square root by sing sqrt of (x*x) == x for all x <= 3037000499:
testAll :: Int -> IO ()
testAll n =
print $ head [ (x,a) | x <- [n,n-1 .. 1], let a = floor $ sqrt (fromIntegral (x*x) :: Double), a /= x ]
main = testAll 3037000499
Note I am running this on a 64-bit GHC - otherwise just use Int64 instead of Int since Doubles are 64-bit in either case. Takes only a minute or so to verify.
This shows that taking the floor of sqrt y will never result in the wrong answer if y <= 3037000499^2.
Here is quite a typical make a century problem.
We have a natural number list [1;2;3;4;5;6;7;8;9].
We have a list of possible operators [Some '+'; Some '*';None].
Now we create a list of operators from above possibilities and insert each operator into between each consecutive numbers in the number list and compute the value.
(Note a None b = a * 10 + b)
For example, if the operator list is [Some '+'; Some '*'; None; Some '+'; Some '+'; Some '+'; Some '+'; Some '+'], then the value is 1 + 2 * 34 + 5 + 6 + 7 + 8 + 9 = 104.
Please find all possible operator lists, so the value = 10.
The only way I can think of is brute-force.
I generate all possible operator lists.
Compute all possible values.
Then filter so I get all operator lists which produce 100.
exception Cannot_compute
let rec candidates n ops =
if n = 0 then [[]]
else
List.fold_left (fun acc op -> List.rev_append acc (List.map (fun x -> op::x) (candidates (n-1) ops))) [] ops
let glue l opl =
let rec aggr acc_l acc_opl = function
| hd::[], [] -> (List.rev (hd::acc_l), List.rev acc_opl)
| hd1::hd2::tl, None::optl -> aggr acc_l acc_opl (((hd1*10+hd2)::tl), optl)
| hd::tl, (Some c)::optl -> aggr (hd::acc_l) ((Some c)::acc_opl) (tl, optl)
| _ -> raise Cannot_glue
in
aggr [] [] (l, opl)
let compute l opl =
let new_l, new_opl = glue l opl in
let rec comp = function
| hd::[], [] -> hd
| hd::tl, (Some '+')::optl -> hd + (comp (tl, optl))
| hd1::hd2::tl, (Some '-')::optl -> hd1 + (comp ((-hd2)::tl, optl))
| hd1::hd2::tl, (Some '*')::optl -> comp (((hd1*hd2)::tl), optl)
| hd1::hd2::tl, (Some '/')::optl -> comp (((hd1/hd2)::tl), optl)
| _, _ -> raise Cannot_compute
in
comp (new_l, new_opl)
let make_century l ops =
List.filter (fun x -> fst x = 100) (
List.fold_left (fun acc x -> ((compute l x), x)::acc) [] (candidates ((List.length l)-1) ops))
let rec print_solution l opl =
match l, opl with
| hd::[], [] -> Printf.printf "%d\n" hd
| hd::tl, (Some op)::optl -> Printf.printf "%d %c " hd op; print_solution tl optl
| hd1::hd2::tl, None::optl -> print_solution ((hd1*10+hd2)::tl) optl
| _, _ -> ()
I believe my code is ugly. So I have the following questions
computer l opl is to compute using the number list and operator list. Basically it is a typical math evaluation. Is there any nicer implementation?
I have read Chapter 6 in Pearls of Functional Algorithm Design. It used some techniques to improve the performance. I found it really really obscurity and hard to understand. Anyone who read it can help?
Edit
I refined my code. Basically, I will scan the operator list first to glue all numbers where their operator is None.
Then in compute, if I meet a '-' I will simply negate the 2nd number.
A classic dynamic programming solution (which finds the = 104
solution instantly) that does not risk any problem with operators
associativity or precedence. It only returns a boolean saying whether
it's possible to come with the number; modifying it to return the
sequences of operations to get the solution is an easy but interesting
exercise, I was not motivated to go that far.
let operators = [ (+); ( * ); ]
module ISet = Set.Make(struct type t = int let compare = compare end)
let iter2 res1 res2 f =
res1 |> ISet.iter ## fun n1 ->
res2 |> ISet.iter ## fun n2 ->
f n1 n2
let can_make input target =
let has_zero = Array.fold_left (fun acc n -> acc || (n=0)) false input in
let results = Array.make_matrix (Array.length input) (Array.length input) ISet.empty in
for imax = 0 to Array.length input - 1 do
for imin = imax downto 0 do
let add n =
(* OPTIMIZATION: if the operators are known to be monotonous, we need not store
numbers above the target;
(Handling multiplication by 0 requires to be a bit more
careful, and I'm not in the mood to think hard about this
(I think one need to store the existence of a solution,
even if it is above the target), so I'll just disable the
optimization in that case)
*)
if n <= target && not has_zero then
results.(imin).(imax) <- ISet.add n results.(imin).(imax) in
let concat_numbers =
(* concatenates all number from i to j:
i=0, j=2 -> (input.(0)*10 + input.(1))*10 + input.(2)
*)
let rec concat acc k =
let acc = acc + input.(k) in
if k = imax then acc
else concat (10 * acc) (k + 1)
in concat 0 imin
in add concat_numbers;
for k = imin to imax - 1 do
let res1 = results.(imin).(k) in
let res2 = results.(k+1).(imax) in
operators |> List.iter (fun op ->
iter2 res1 res2 (fun n1 n2 -> add (op n1 n2););
);
done;
done;
done;
let result = results.(0).(Array.length input - 1) in
ISet.mem target result
Here is my solution, which evaluates according to the usual rules of precedence. It finds 303 solutions to find [1;2;3;4;5;6;7;8;9] 100 in under 1/10 second on my MacBook Pro.
Here are two interesting ones:
# 123 - 45 - 67 + 89;;
- : int = 100
# 1 * 2 * 3 - 4 * 5 + 6 * 7 + 8 * 9;;
- : int = 100
This is a brute force solution. The only slightly clever thing is that I treat concatenation of digits as simply another (high precedence) operation.
The eval function is the standard stack-based infix expression evaluation that you will find described many places. Here is an SO article about it: How to evaluate an infix expression in just one scan using stacks? The essence is to postpone evaulating by pushing operators and operands onto stacks. When you find that the next operator has lower precedence you can go back and evaluate what you pushed.
type op = Plus | Minus | Times | Divide | Concat
let prec = function
| Plus | Minus -> 0
| Times | Divide -> 1
| Concat -> 2
let succ = function
| Plus -> Minus
| Minus -> Times
| Times -> Divide
| Divide -> Concat
| Concat -> Plus
let apply op stack =
match op, stack with
| _, [] | _, [_] -> [] (* Invalid input *)
| Plus, a :: b :: tl -> (b + a) :: tl
| Minus, a :: b :: tl -> (b - a) :: tl
| Times, a :: b :: tl -> (b * a) :: tl
| Divide, a :: b :: tl -> (b / a) :: tl
| Concat, a :: b :: tl -> (b * 10 + a) :: tl
let rec eval opstack numstack ops nums =
match opstack, numstack, ops, nums with
| [], sn :: _, [], _ -> sn
| sop :: soptl, _, [], _ ->
eval soptl (apply sop numstack) ops nums
| [], _, op :: optl, n :: ntl ->
eval [op] (n :: numstack) optl ntl
| sop :: soptl, _, op :: _, _ when prec sop >= prec op ->
eval soptl (apply sop numstack) ops nums
| _, _, op :: optl, n :: ntl ->
eval (op :: opstack) (n :: numstack) optl ntl
| _ -> 0 (* Invalid input *)
let rec incr = function
| [] -> []
| Concat :: rest -> Plus :: incr rest
| x :: rest -> succ x :: rest
let find nums tot =
match nums with
| [] -> []
| numhd :: numtl ->
let rec try1 ops accum =
let accum' =
if eval [] [numhd] ops numtl = tot then
ops :: accum
else
accum
in
if List.for_all ((=) Concat) ops then
accum'
else try1 (incr ops) accum'
in
try1 (List.map (fun _ -> Plus) numtl) []
I came up with a slightly obscure implementation (for a variant of this problem) that is a bit better than brute force. It works in place, rather than generating intermediate data structures, keeping track of the combined values of the operators that have already been evaluated.
The trick is to keep track of a pending operator and value so that you can evaluate the "none" operator easily. That is, if the algorithm had just progressed though 1 + 23, the pending operator would be +, and the pending value would be 23, allowing you to easily generate either 1 + 23 + 4 or 1 + 234 as necessary.
type op = Add | Sub | Nothing
let print_ops ops =
let len = Array.length ops in
print_char '1';
for i = 1 to len - 1 do
Printf.printf "%s%d" (match ops.(i) with
| Add -> " + "
| Sub -> " - "
| Nothing -> "") (i + 1)
done;
print_newline ()
let solve k target =
let ops = Array.create k Nothing in
let rec recur i sum pending_op pending_value =
let sum' = match pending_op with
| Add -> sum + pending_value
| Sub -> if sum = 0 then pending_value else sum - pending_value
| Nothing -> pending_value in
if i = k then
if sum' = target then print_ops ops else ()
else
let digit = i + 1 in
ops.(i) <- Add;
recur (i + 1) sum' Add digit;
ops.(i) <- Sub;
recur (i + 1) sum' Sub digit;
ops.(i) <- Nothing;
recur (i + 1) sum pending_op (pending_value * 10 + digit) in
recur 0 0 Nothing 0
Note that this will generate duplicates - I didn't bother to fix that. Also, if you are doing this exercise to gain strength in functional programming, it might be beneficial to reject the imperative approach taken here and search for a similar solution that doesn't make use of assignments.
A friend of mine showed me a home exercise in a C++ course which he attend. Since I already know C++, but just started learning Haskell I tried to solve the exercise in the "Haskell way".
These are the exercise instructions (I translated from our native language so please comment if the instructions aren't clear):
Write a program which reads non-zero coefficients (A,B,C,D) from the user and places them in the following equation:
A*x + B*y + C*z = D
The program should also read from the user N, which represents a range. The program should find all possible integral solutions for the equation in the range -N/2 to N/2.
For example:
Input: A = 2,B = -3,C = -1, D = 5, N = 4
Output: (-1,-2,-1), (0,-2, 1), (0,-1,-2), (1,-1, 0), (2,-1,2), (2,0, -1)
The most straight-forward algorithm is to try all possibilities by brute force. I implemented it in Haskell in the following way:
triSolve :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
triSolve a b c d n =
let equation x y z = (a * x + b * y + c * z) == d
minN = div (-n) 2
maxN = div n 2
in [(x,y,z) | x <- [minN..maxN], y <- [minN..maxN], z <- [minN..maxN], equation x y z]
So far so good, but the exercise instructions note that a more efficient algorithm can be implemented, so I thought how to make it better. Since the equation is linear, based on the assumption that Z is always the first to be incremented, once a solution has been found there's no point to increment Z. Instead, I should increment Y, set Z to the minimum value of the range and keep going. This way I can save redundant executions.
Since there are no loops in Haskell (to my understanding at least) I realized that such algorithm should be implemented by using a recursion. I implemented the algorithm in the following way:
solutions :: (Integer -> Integer -> Integer -> Bool) -> Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
solutions f maxN minN x y z
| solved = (x,y,z):nextCall x (y + 1) minN
| x >= maxN && y >= maxN && z >= maxN = []
| z >= maxN && y >= maxN = nextCall (x + 1) minN minN
| z >= maxN = nextCall x (y + 1) minN
| otherwise = nextCall x y (z + 1)
where solved = f x y z
nextCall = solutions f maxN minN
triSolve' :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
triSolve' a b c d n =
let equation x y z = (a * x + b * y + c * z) == d
minN = div (-n) 2
maxN = div n 2
in solutions equation maxN minN minN minN minN
Both yield the same results. However, trying to measure the execution time yielded the following results:
*Main> length $ triSolve' 2 (-3) (-1) 5 100
3398
(2.81 secs, 971648320 bytes)
*Main> length $ triSolve 2 (-3) (-1) 5 100
3398
(1.73 secs, 621862528 bytes)
Meaning that the dumb algorithm actually preforms better than the more sophisticated one. Based on the assumption that my algorithm was correct (which I hope won't turn as wrong :) ), I assume that the second algorithm suffers from an overhead created by the recursion, which the first algorithm isn't since it's implemented using a list comprehension.
Is there a way to implement in Haskell a better algorithm than the dumb one?
(Also, I'll be glad to receive general feedbacks about my coding style)
Of course there is. We have:
a*x + b*y + c*z = d
and as soon as we assume values for x and y, we have that
a*x + b*y = n
where n is a number we know.
Hence
c*z = d - n
z = (d - n) / c
And we keep only integral zs.
It's worth noticing that list comprehensions are given special treatment by GHC, and are generally very fast. This could explain why your triSolve (which uses a list comprehension) is faster than triSolve' (which doesn't).
For example, the solution
solve :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
-- "Buffalo buffalo buffalo buffalo Buffalo buffalo buffalo..."
solve a b c d n =
[(x,y,z) | x <- vals, y <- vals
, let p = a*x +b*y
, let z = (d - p) `div` c
, z >= minN, z <= maxN, c * z == d - p ]
where
minN = negate (n `div` 2)
maxN = (n `div` 2)
vals = [minN..maxN]
runs fast on my machine:
> length $ solve 2 (-3) (-1) 5 100
3398
(0.03 secs, 4111220 bytes)
whereas the equivalent code written using do notation:
solveM :: Integer -> Integer -> Integer -> Integer -> Integer -> [(Integer,Integer,Integer)]
solveM a b c d n = do
x <- vals
y <- vals
let p = a * x + b * y
z = (d - p) `div` c
guard $ z >= minN
guard $ z <= maxN
guard $ z * c == d - p
return (x,y,z)
where
minN = negate (n `div` 2)
maxN = (n `div` 2)
vals = [minN..maxN]
takes twice as long to run and uses twice as much memory:
> length $ solveM 2 (-3) (-1) 5 100
3398
(0.06 secs, 6639244 bytes)
Usual caveats about testing within GHCI apply -- if you really want to see the difference, you need to compile the code with -O2 and use a decent benchmarking library (like Criterion).