I'm writing a program which converts decimal numbers, characters, strings to binary numbers and works with them. But I got stuck because I want to divide Bin by Bin.
something like this:
11010110110000
/ 10011
--------------
= 01001110110000
so the new number will be 1001110110000 / 10011... until the very last result.
Here is my code:
import Data.Char (ord)
import Data.List
toBinary :: Int -> [Int]
toBinary 0 = []
toBinary x = reverse (kisegf x)
kisegf 0 = []
kisegf x | x `mod` 2 == 1 = 1 : kisegf (x `div` 2)
| x `mod` 2 == 0 = 0 : kisegf (x `div` 2)
chrToBinary :: Char -> [Int]
chrToBinary x
|length (toBinary (ord x)) == 8 = (toBinary (ord x))
|otherwise = take (8-(length (toBinary (ord x))))[0,0..] ++ (toBinary (ord x))
strToBinary :: String -> [Int]
strToBinary [] = []
strToBinary (x:xs) = [l | l <- chrToBinary x] ++ strToBinary xs
bxor :: [Int] -> [Int] -> [Int]
bxor [] [] = []
bxor (x:xs) (y:ys)
|length (x:xs) == length (y:ys) && (x /= y) = 1 : bxor xs ys
|length (x:xs) == length (y:ys) && (x == y) = 0 : bxor xs ys
|length (x:xs) < length (y:ys) && (x /= y) = 1 : bxor (take (length (y:ys)-(length (x:xs)))[0,0..] ++ xs) ys
|length (x:xs) < length (y:ys) && (x == y) = 0 : bxor (take (length (y:ys)-(length (x:xs)))[0,0..] ++ xs) ys
|length (x:xs) > length (y:ys) && (x /= y) = 1 : bxor xs (take (length (x:xs)-(length (y:ys)))[0,0..] ++ ys)
|length (x:xs) > length (y:ys) && (x == y) = 0 : bxor xs (take (length (x:xs)-(length (y:ys)))[0,0..] ++ ys)
{-this will compare 2 bin if a bigger than true else false-}
(%>=%) :: [Int] -> [Int] -> Bool
(%>=%)[] [] = True
(%>=%)[] _ = False
(%>=%)_ [] = True
(%>=%) (x:xs) (y:ys) = x==1 && y==1 && elemIndex 1 (x:xs) == elemIndex 1 (y:ys)
bmod :: [Int]{-number-} -> [Int]{-div-} -> [Int]{-result-}
bmod (x:xs) (y:ys)
|length(x:xs) >= length(y:ys) && (take (length (y:ys)) (x:xs)) %>=% (y:ys) = ???
|length(x:xs) >= length(y:ys) = ???
|otherwise = (x:xs)
what should i write in the place of "???"
another and bigger for example:
Példa: bmod 11010110110000 10011.
_______________
10011 ) 11010110110000
10011,,.,,....
-----,,.,,....
10011,.,,....
10011,.,,....
-----,.,,....
00001.,,....
00000.,,....
-----.,,....
00010,,....
00000,,....
-----,,....
00101,....
00000,....
-----,....
01011....
00000....
-----....
10110...
10011...
-----...
01010..
00000..
-----..
10100.
10011.
-----.
01110
10011 <- bigger so cant div again
-----
1110 = what i want
your function as written isn't what you want.
bmod xs ys | not (xs %>=% ys) = xs
| otherwise = ????
will probably work better. In the ????, you want to take successive amounts of digits from the beginning of xs until you find a prefix of xs is greater than ys, then recurse with
bmod ((xsPrefix %-% ys)++xsSuffix) ys
For getting the prefix of xs, inits combined with filter is pretty much what you need. Obviously, there are also some more binary functions you will need to implement.
The issue with your design is that there is nothing for you to recurse to in the second case -- you want to end up using the code from your first case somehow, but there isn't an easy way to do that short of copying the code.
Also, your kisegf function could be cleaned up a bit - why not
kisegf 0 = []
kisegf x = (x `mod` 2) : kisegf (x `div` 2)
Although not an answer to your question, I would keep the bit strings LSB first, rather than MSB first (i.e. don't reverse in toBinary). In this way, the list index corresponds to the bit significance, so you don't have to worry about adding leading zeros to align operands. For instance, the bxor function becomes much simpler:
bxor [] bs = bs
bxor as [] = as
bxor (a:as) (b:bs) = (a `xor` b) : bxor as bs where
a `xor` b | a /= b = 1
| otherwise = 0
Having the bits in this order will also make addition/subtraction simpler, since carries propagate from the LSB to the MSB:
badd :: [Int] {- a -} -> [Int] {- b -} -> Int {- carry-in -} -> [Int]
badd [] [] 0 = [] -- no carry-out
badd [] [] 1 = [1] -- carry-out
badd [] (b:bs) c = s : badd [] bs c' where (c', s) = add 0 b c -- zero-extend as
badd (a:as) [] c = s : badd as [] c' where (c', s) = add a 0 c -- zero-extend bs
badd (a:as) (b:bs) c = s : badd as bs c' where (c', s) = add a b c
add a b c = (s `div` 2, s `mod` 2) where s = a+b+c
Left and right shifts are also simpler since they affect LSBs:
as `rsh` n = drop n as
as `lsh` n = replicate n 0 ++ as
For signed numbers, you implicitly assume that the last bit repeats indefinitely.
Related
What is the right way to append items to a list inside a recursive function?
let () =
let rec main m l acc =
if (acc = 3) then
acc
else
if (m = 1) then
l := 1 :: !l
main (m - 1) l
else if (m = 2) then
l := 2 :: !l
main (m - 1) l
else
l := m :: !l
main (m - 1) l
in l = ref []
let main 10 l 0
List.iter (fun l -> List.iter print_int l) l
another Example:
let () =
let rec main m =
if (m = 3) then m
else
l := m :: !l;
main (m + 1) l
in l = ref []
let main 0 l
List.iter (fun l -> List.iter print_int l) l
I want to append a value to a list inside a function and then print the elements of the list.
If you want to print [1;2;...;10]:
let () =
let rec main m l =
if (m = 0) then
!l
else begin
l := m :: !l;
main (m - 1) l
end
in
let l = ref [] in
List.iter print_int (main 10 l); print_newline();;
or better without ref
let () =
let rec main m l =
if (m = 0) then
l
else
main (m - 1) (m::l)
in
List.iter print_int (main 10 []); print_newline();;
but I am not sure of what you want to do...
What you mean by "the right way" is not quite clear. The functional "right way" would be not to use references. The efficiency "right way" would be to prepend rather than to append.
Another direct way to build a list inspired from user4624500's answer could be:
let rec f = function
| 0 -> [0]
| n -> n :: f (n-1)
(note: that's not tail recursive, and would uglily fail with negative numbers...)
Then the following expression calls the previous function to build the list and then print the result (adding newlines for readability purposes):
let my_list = f 10 in
List.iter (fun n -> print_int n; print_newline ()) my_list
I created a function and helper function that find the number of repeating elements in a list, and what those elements.
let rec _encode l x =
match l with
| [] -> 0
| head::rest -> (if head = x then 1 else 0) + encode rest x
let encode l x = ((_encode l x), x)
In this case, I have to specify what that element is for it to search.
So this is a two part question. 1) How do I do it to return a list of tuples, with format (int * 'a) list, where int is the # of rep, and 'a is the element that is repeating.
2) How would I implement this using fold_right?
I was thinking something along the lines of:
let encode (l : 'a list) : (int * 'a) list = fold_right (fun (x,hd) lst ->
match x with
| [] -> 0
| hd :: rest -> if hd x then (x+1, hd) else (x, hd)) l []
Your attempt looks very confused:
It doesn't use lst, hd (the first one), or rest.
x is used as a list (match x with []) and a number (x+1).
The elements of x (list) are functions that return bools?? (... hd::rest -> ... if hd x)
The function sometimes returns a number (0) and sometimes a tuple ((x, hd)).
Here's how I'd do it:
let encode l =
let f x = function
| (n, y) :: zs when x = y -> (n + 1, y) :: zs
| zs -> (1, x) :: zs
in
fold_right f l []
Which is the same as:
let encode l =
let f x z = match z with
| (n, y) :: zs when x = y -> (n + 1, y) :: zs
| zs -> (1, x) :: zs
in
fold_right f l []
Which is the same as:
let encode l =
fold_right (fun x z ->
match z with
| (n, y) :: zs when x = y -> (n + 1, y) :: zs
| zs -> (1, x) :: zs
) l []
I implemented a non-in-place version of selection sort in OCaml.
let sort compare_fun l =
let rec find_min l' min_l origin_l =
match l' with
| [] ->
if min_l = [] then (min_l, l')
else
let min = List.hd min_l
in
(min_l, List.filter (fun x -> if x != min then true else false) origin_l)
| x::tl ->
if min_l = [] then
find_min tl [x] origin_l
else
let c = compare_fun (List.hd min_l) x
in
if c = 1 then
find_min tl [x] origin_l
else if c = 0 then
find_min tl (min_l # [x]) origin_l
else
find_min tl min_l origin_l
in
let rec insert_min l' new_l =
match l' with
| [] -> new_l
| _ ->
let (min_l, rest) = find_min l' [] l'
in
insert_min rest (new_l # min_l)
in
insert_min l [];;
My idea is that in a list, every time I find the list of minimum items (in case of duplicate values) and add this min list to the result list, then redo the finding_min in the rest of the list.
I use List.filter to filter out the min_list, so the resulting list will be the list for next find_min.
I find my implementation is quite complicated, and far more complicated than the Java in-place version of selection sort.
Any suggestions to improve it?
Edit: Here's a much better implementation: http://rosettacode.org/wiki/Sorting_algorithms/Selection_sort#OCaml
here's my own crappier implementation
(* partial function - bad habit, don't do this. *)
let smallest (x::xs) = List.fold_right (fun e acc -> min e acc) xs x
let remove l y =
let rec loop acc = function
| [] -> raise Not_found
| x::xs -> if y = x then (List.rev acc) # xs else loop (x::acc) xs
in loop [] l
let selection_sort =
let rec loop acc = function
| [] -> List.rev acc
| xs ->
let small = smallest xs in
let rest = remove xs small in
loop (small::acc) rest
in loop []
I often need to match a tuple of values that should have the same constructor. The catchall _,_ always winds-up at the end. This of course is fragile, any additional constructor added to the type will compile perfectly fine. My current thoughts are to have matches that connect the first but not second argument. But, is there any other options?
For example,
type data = | States of int array
| Chars of (char list) array
let median a b = match a,b with
| States xs, States ys ->
assert( (Array.length xs) = (Array.length ys) );
States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
| Chars xs, Chars ys ->
assert( (Array.length xs) = (Array.length ys) );
let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) # c2 in
Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))
(* inconsistent pairs of matching *)
| Chars _, _
| States _, _ -> assert false
You can use the slightly shorter pattern below:
| (Chars _| States _), _ -> assert false
In fact, you can let the compiler generate it for you, because it's still a little tedious.
Type the following and compile:
let median a b = match a,b with
| States xs, States ys ->
assert( (Array.length xs) = (Array.length ys) );
States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
| Chars xs, Chars ys ->
assert( (Array.length xs) = (Array.length ys) );
let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) # c2 in
Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))
Warning 8: this pattern-matching is
not exhaustive. Here is an example of
a value that is not matched: (Chars _,
States _)
You can now copy-paste the suggested pattern back into your code. This is usually how I generate non-fragile catch-all patterns for types with tens of constructors. You may need to launch the compiler several times, but it's still faster than typing them yourself.
It's only a matter of taste/style, but I tend to prefer grouping clauses on the same constructor together, rather than having the useful clauses for everything first, then all the "absurd cases" together. This can be quite helpful when you get to write several "useful" clauses for one given constructor, and want to check you didn't forget anything.
let median a b = match a,b with
| States xs, States ys ->
assert( (Array.length xs) = (Array.length ys) );
States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
| States _, _ -> assert false
| Chars xs, Chars ys ->
assert( (Array.length xs) = (Array.length ys) );
let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) # c2 in
Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))
| Chars _, _ -> assert false
This is pretty hackish (and results in warnings) but you can use Obj to check if the tags are equal or not. It should catch all cases where a and b have different values:
type data = | States of int array
| Chars of (char list) array
let median a b = match a,b with
| States xs, States ys ->
assert( (Array.length xs) = (Array.length ys) );
States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
| Chars xs, Chars ys ->
assert( (Array.length xs) = (Array.length ys) );
let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) # c2 in
Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))
(* inconsistent pairs of matching *)
| x, y when (Obj.tag (Obj.repr x)) <> (Obj.tag (Obj.repr y)) -> assert false
The warning is for non-exhaustive pattern-matching (since it can't tell whether or not the guarded clause matches the rest or not).
EDIT: you don't need to use Obj at all, you can just compare x and y directly:
| x, y when x <> y -> assert false
Though this still results in a warning, unfortunately.
This is actually a solution to Project Euler Problem 14 in F#. However, I'm running into a System.OutOfMemory exception when attempting to calculate an iterative sequence for larger numbers. As you can see, I'm writing my recursive function with tail calls.
I was running into a problem with StackOverFlowException because I was debugging in visual studio (which disables the tail calls). I've documented that in another question. Here, I'm running in release mode--but I'm getting out of memory exceptions when I run this as a console app (on windows xp with 4gb ram).
I'm really at a loss to understand how I coded myself into this memory overflow & hoping someone can show my the error in my ways.
let E14_interativeSequence x =
let rec calc acc startNum =
match startNum with
| d when d = 1 -> List.rev (d::acc)
| e when e%2 = 0 -> calc (e::acc) (e/2)
| _ -> calc (startNum::acc) (startNum * 3 + 1)
let maxNum pl=
let rec maxPairInternal acc pairList =
match pairList with
| [] -> acc
| x::xs -> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
maxPairInternal (0,0) pl
|> fst
// if I lower this to like [2..99999] it will work.
[2..99999]
|> List.map (fun n -> (n,(calc [] n)))
|> List.map (fun pair -> ((fst pair), (List.length (snd pair))))
|> maxNum
|> (fun x-> Console.WriteLine(x))
EDIT
Given the suggestions via the answers, I rewrote to use a lazy list and also to use Int64's.
#r "FSharp.PowerPack.dll"
let E14_interativeSequence =
let rec calc acc startNum =
match startNum with
| d when d = 1L -> List.rev (d::acc) |> List.toSeq
| e when e%2L = 0L -> calc (e::acc) (e/2L)
| _ -> calc (startNum::acc) (startNum * 3L + 1L)
let maxNum (lazyPairs:LazyList<System.Int64*System.Int64>) =
let rec maxPairInternal acc (pairs:seq<System.Int64*System.Int64>) =
match pairs with
| :? LazyList<System.Int64*System.Int64> as p ->
match p with
| LazyList.Cons(x,xs)-> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
| _ -> acc
| _ -> failwith("not a lazylist of pairs")
maxPairInternal (0L,0L) lazyPairs
|> fst
{2L..999999L}
|> Seq.map (fun n -> (n,(calc [] n)))
|> Seq.map (fun pair -> ((fst pair), (Convert.ToInt64(Seq.length (snd pair)))))
|> LazyList.ofSeq
|> maxNum
which solves the problem. I'd also look at Yin Zhu's solution which is better, though.
As mentioned by Brian, List.* operations are not appropriate here. They cost too much memory.
The stackoverflow problem comes from another place. There are two possible for you to have stackoverflow: calc and maxPairInternal. It must be the first as the second has the same depth as the first. Then the problem comes to the numbers, the number in 3n+1 problem could easily go to very large. So you first get a int32 overflow, then you get a stackoverflow. That's the reason. After changing the numbers to 64bit, the program works.
Here is my solution page, where you can see a memoization trick.
open System
let E14_interativeSequence x =
let rec calc acc startNum =
match startNum with
| d when d = 1L -> List.rev (d::acc)
| e when e%2L = 0L -> calc (e::acc) (e/2L)
| _ -> calc (startNum::acc) (startNum * 3L + 1L)
let maxNum pl=
let rec maxPairInternal acc pairList =
match pairList with
| [] -> acc
| x::xs -> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
maxPairInternal (0L,0) pl
|> fst
// if I lower this to like [2..99999] it will work.
[2L..1000000L]
|> Seq.map (fun n -> (n,(calc [] n)))
|> Seq.maxBy (fun (n, lst) -> List.length lst)
|> (fun x-> Console.WriteLine(x))
If you change List.map to Seq.map (and re-work maxPairInternal to iterate over a seq) that will probably help tons. Right now, you're manifesting all the data at once in a giant structure before processing the whole structure to get a single number result. It is much better to do this lazily via Seq, and just create one row, and compare it with the next row, and create a single row at a time and then discard it.
I don't have time to code my suggestion now, but let me know if you are still having trouble and I'll revisit this.
Stop trying to use lists everywhere, this isn't Haskell! And stop writing fst pair and snd pair everywhere, this isn't Lisp!
If you want a simple solution in F# you can do it directly like this without creating any intermediate data structures:
let rec f = function
| 1L -> 0
| n when n % 2L = 0L -> 1 + f(n / 2L)
| n -> 1 + f(3L * n + 1L)
let rec g (li, i) = function
| 1L -> i
| n -> g (max (li, i) (f n, n)) (n - 1L)
let euler14 n = g (0, 1L) n
That takes around 15s on my netbook. If you want something more time efficient, reuse previous results via an array:
let rec inside (a : _ array) n =
if n <= 1L || a.[int n] > 0s then a.[int n] else
let p =
if n &&& 1L = 0L then inside a (n >>> 1) else
let n = 3L*n + 1L
if n < int64 a.Length then inside a n else outside a n
a.[int n] <- 1s + p
1s + p
and outside (a : _ array) n =
let n = if n &&& 1L = 0L then n >>> 1 else 3L*n + 1L
1s + if n < int64 a.Length then inside a n else outside a n
let euler14 n =
let a = Array.create (n+1) 0s
let a = Array.Parallel.init (n+1) (fun n -> inside a (int64 n))
let i = Array.findIndex (Array.reduce max a |> (=)) a
i, a.[i]
That takes around 0.2s on my netbook.
Found this looking for Microsoft.FSharp.Core.Operators.Checked.
I'm just learning F#, so I thought I'd take the Project Euler 14 Challenge.
This uses recursion but not tail-recursion.
Takes about 3.1 sec for me, but has the advantage that I can almost understand it.
let Collatz (n:int64) = if n % 2L = 0L then n / 2L else n * 3L + 1L
let rec CollatzLength (current:int64) (acc:int) =
match current with
| 1L -> acc
| _ -> CollatzLength (Collatz current) (acc + 1)
let collatzSeq (max:int64) =
seq{
for i in 1L..max do
yield i, CollatzLength i 0
}
let collatz = Seq.toList(collatzSeq 1000000L)
let result, steps = List.maxBy snd collatz