OCaml: Stream.peek without consuming line? - stream

I'm working on a program that iterates over an input file, with a variable number of 'programs', and ending in '0'. My function run works fine if I start it from the top of the file, but for some reason a line is consumed by peeking to see if the next char is '0' (indicating the end of the file).
Here's my code:
let line_stream_of_channel channel =
Stream.from
(fun _ ->
try Some (input_line channel) with End_of_file -> None);;
let in_channel = open_in "dull.in" in
let line_stream = line_stream_of_channel in_channel in
while Stream.peek line_stream != Some "0" do
run in_channel;
print_string "...\n";
done;;
From what I've read, Stream.peek shouldn't consume a line, so maybe the problem doesn't come from that, but if not, I can't figure out what's doing it. Any ideas?
Edit Here's the entirety of my program:
let hello c =
print_char c;;
let hello_int c =
print_int c;
print_char '\n';;
let ios = int_of_string;;
let rec print_string_list = function
[] -> print_string "\n"
| h::t -> print_string h ; print_string " " ; print_string_list t;;
let rec print_int_list = function
[] -> print_string "\n"
| h::t -> print_int h ; print_string " " ; print_int_list t;;
let rec append l i =
match l with
[] -> [i]
| h :: t -> h :: (append t i);;
let line_stream_of_channel channel =
Stream.from
(fun _ ->
try Some (input_line channel) with End_of_file -> None);;
let string_to_int_list str_list int_list=
let len = List.length str_list in
for i = 0 to len - 1 do
int_list := append !int_list (ios (List.nth str_list i));
done;;
let get_option = function
| Some x -> x
| None -> raise (Invalid_argument "Option.get");;
let chomp_line ns in_channel =
let s = input_line in_channel in
let len = String.length s in
let start_pos = ref 0 in
for i = 0 to len do
if i == len then
let word = String.sub s !start_pos (i - !start_pos) in
ns := append !ns word;
else if s.[i] == ' ' then
let word = String.sub s !start_pos (i - !start_pos) in
ns := append !ns word;
start_pos := i + 1;
done;;
let run in_channel =
let ns = ref [] in
chomp_line ns in_channel;
let n = ios (List.nth !ns 0) in
let p = ios (List.nth !ns 1) in
let s = ios (List.nth !ns 2) in
print_string "num dulls: "; hello_int n;
print_string "num programs: "; hello_int p;
print_string "num state transitions: "; hello_int s;
let dull_sizes = ref [] in
chomp_line dull_sizes in_channel;
let int_dull_sizes = ref [] in
string_to_int_list !dull_sizes int_dull_sizes;
print_string "size of dulls: "; print_int_list !int_dull_sizes;
let program_sizes = ref [] in
let program_dulls = ref [] in
for i = 0 to p - 1 do
let program = ref [] in
chomp_line program in_channel;
program_sizes := append !program_sizes (List.nth !program 0);
program_dulls := append !program_dulls (List.nth !program 1);
done;
let int_program_sizes = ref [] in
string_to_int_list !program_sizes int_program_sizes;
print_string "program sizes: "; print_int_list !int_program_sizes;
print_string "program dulls: "; print_string_list !program_dulls;
let transitions = ref [] in
chomp_line transitions in_channel;
let int_transitions = ref [] in
string_to_int_list !transitions int_transitions;
for i = 0 to s - 1 do
hello_int (List.nth !int_transitions i)
done
;;
let in_channel = open_in "dull.in" in
let line_stream = line_stream_of_channel in_channel in
while Stream.peek line_stream <> Some "0" do
run in_channel;
done;;
And here's a sample input:
2 2 3
500 600
100 A
200 B
2 1 2
5 4 8
100 400 200 500 300
250 AC
360 ACE
120 AB
40 DE
2 3 4 -3 1 2 -2 1
0

(!=) is physical (pointer) inequality, and the test fails to detect your end mark 0. When 0 is peeked, Stream.peek returns Some 0, but it is a different entity from Some 0 of the right hand of the inequality check, and therefore the loop never terminates until it crashes at EOF.
The following demonstrates what is happening:
# Some 0 != Some 0;;
- : bool = true
# let x = Some 0 in x != x;;
- : bool = false
Use (<>), structural inequality here. Except it and the omitted run_in_channel part, the code works fine for me.
A golden rule: do not use physical equality (==) and (!=) unless you really need them. Normally, stick to structural equalities (=) and (<>).
-- edit --
There was another issue in the code which was not originally revealed.
Once you create a stream from an in_channel. Do not touch it by yourself, until you want to close it by close_in! Let the stream the only reader of it.
The benefit of the stream is that once created, you are freed from taking care of when the actual readings happen. You could still access the channel directly, but it just ruins the benefit completely. Just do not do it. Use Stream.next or Stream.peek instead of input_line in your run.

Related

BF Interpreter in F# Issue [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 2 years ago.
Improve this question
Ok so i am working on a small project as you can tell in the title i am making an BrainFuck interpeter in f# and i am new to this language but it is fun except that you fight with the compiler lot but i am used to it cause i used to use rust but aside the point it looks like to me it is only executing the symbols once. I know this is not efficient or fully functional but right now i am just going that works. Here is my code
main.fs
open System
open System.IO
let mutable reg : int array = Array.zeroCreate 50
let mutable ptr = 0
let mutable larr : int array = Array.zeroCreate 50
let mutable lptr = 0
let mutable pc = 0
let result = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++."
let prog = result.ToCharArray()
let startLoop =
larr.[lptr] <- pc
printfn "STARTING LOOP AT %d" larr.[lptr]
lptr <- lptr + 1
let doEnd =
pc <- larr.[lptr]
while larr.[lptr - 1] > 0 do
ptr <- larr.[lptr - 1]
larr.[lptr - 1] <- larr.[lptr - 1] - 1
let endLoop =
lptr <- lptr - 1
if reg.[ptr] = 0 then pc <- pc
else doEnd
let doPlus =
reg.[ptr] <- (reg.[ptr] + 1) % 265
printfn "ADDING"
let doMinus =
reg.[ptr] <- (reg.[ptr] - 1) % 265
printfn "SUB"
let doInc =
ptr <- (ptr + 1) % 265
printfn "INC"
let doDec =
ptr <- (ptr - 1) % 265
printfn "MINUS"
let doPrt =
printfn "%c" (reg.[ptr] |> char)
let doSloop =
startLoop
printfn "START LOOP"
let doEloop =
endLoop
printfn "END LOOP"
let exec =
while pc < prog.Length do
let i = prog.[pc]
if i = '+' then doPlus
elif i = '-' then doMinus
elif i = '>' then doInc
elif i = '<' then doDec
elif i = '.' then doPrt
elif i = '[' then doSloop
elif i = ']' then doEloop
else 1 |> ignore
pc <- pc + 1
exec
Welcome to the F# community.
Here is a more functional style of writing your program. It's just a start, but I hope it will give you some ideas about how to proceed. Ultimately, you'll want to avoid mutable values if at all possible, and probably the first step to doing that would be to write functions that have parameters other than unit.
let result = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++."
let doPlus () =
// reg.[ptr] <- (reg.[ptr] + 1) % 265
printfn "ADDING"
let doMinus () =
// reg.[ptr] <- (reg.[ptr] - 1) % 265
printfn "SUB"
let doDefault () = printfn ""
let funcs =
[|
'+', doPlus
'-', doMinus
|] |> Map.ofArray
let exec () =
result
|> Seq.iteri (fun i c ->
printf "%03d: " i
match funcs.TryFind(c) with
| Some func -> func ()
| None -> doDefault ()
)
exec ()

Any suggestions on how to optimize this string -> double parser further, in F#?

Part of testing, I have to load massive CSV files (200+mb each) and I'm trying to cut down the load time since this is adding up.
As the CSV files are all floating point numbers, I tried to see if I could speed that up.
One important point: I do NOT need precision beyond 5 digits after the comma. The code I post here parses it anyways to give a fair comparison to .NET's parser, but any shortcut that preserves that precision is good.
The code I came up with:
open System
open System.Diagnostics
[<EntryPoint>]
let main _ =
let r = Random()
let numbers =
seq {
for _ in 0 .. 10000000 do
let n = (1000. * r.NextDouble()) - 500.
yield (n, sprintf "%.8f" n)
}
|> Seq.toList
let parseString (number: string) : double =
let len = number.Length
let rec parse (index: int) (nSign: double) (signMultiplier: double) (nAccumulator: int64) : float =
if index < len then
match number.[index] with
| x when x >= '0' && x <= '9' -> parse (index + 1) (signMultiplier * nSign) signMultiplier (nAccumulator * 10L + int64 x - int64 '0')
| x when x = '.' -> parse (index + 1) nSign 0.1 nAccumulator
| x when x = '-' -> parse (index + 1) -nSign signMultiplier nAccumulator
| _ -> parse (index + 1) nSign signMultiplier nAccumulator
else
double nAccumulator * nSign
parse 0 +1. 1. 0L
let benchmark name (func: string -> double) =
let allowedError = 0.00001
printf "checking %s - " name
let sw = Stopwatch()
sw.Start()
numbers
|> List.iter (fun (num, str) ->
let parsed = func str
let delta = num - parsed
if abs delta > allowedError then
failwithf "(%f, %s) not matching %f" num str parsed
)
sw.Stop()
printfn "%i ms" sw.ElapsedMilliseconds
benchmark ".net parser" (fun x -> double x)
benchmark "parser1" (fun x -> parseString x)
0
Is there anything obvious I missed to speed this up?
Additionally, there is something I do not understand: I tried to make the test numbers an array instead of a list and suddenly the processing took longer, while I'd expect the opposite. If anyone has some insights as to why it is happening, I'd be happy to know. You can just change the toList to toArray and replace the List with Array in the benchmark loop to test this.
Edit:
to load the data, here is the code I use:
// load a csv file
let loadCSV (stream: Stream) =
seq {
use s = new StreamReader (stream)
while not s.EndOfStream do
yield s.ReadLine ()
}
|> Seq.map (fun line -> line.Split(",") |> Array.toList)
|> Seq.toList

iterative binary search implementation in f#

I am trying to write a binary search in f#, but stumbled at a problem:
let find(words:string[]) (value:string) =
let mutable mid = 0
let mutable fpos = 0
let mutable lpos = words.Length - 1
while fpos < lpos do
mid <- (fpos + lpos) / 2
if value < words.[mid] then
lpos <- mid
else if value > words.[mid] then
fpos <- mid
else if value = words.[mid] then
true
false
It is giving error at the line which says true saying it expected an expression of type unit() instead got bool. What is the correct way to write this function?
Edit:
Temporarily I took to writing as follows:
let find(words:string[]) (value:string) =
let mutable mid = 0
let mutable fpos = 0
let mutable lpos = words.Length - 1
let ret = false
while fpos < lpos && ret = false do
mid <- (fpos + lpos) / 2
if value < words.[mid] then
lpos <- mid
else if value > words.[mid] then
fpos <- mid
else if value = words.[mid] then
ret <- true
ret
But execution wise I think I am doing a lot of operations here than intended...
Use a recursive function:
let find(words:string[]) (value:string) =
let rec findRec fpos lpos =
if fpos > lpos then
false
else
let mid = (fpos + lpos) / 2
if value < words.[mid] then
findRec fpos (mid-1)
else if value > words.[mid] then
findRec (mid+1) lpos
else
true
findRec 0 (words.Length-1)
Non-recursive version (adapted from Gene's answer):
let find (words: string[]) (value:string) =
let mutable mid = 0
let mutable fpos = 0
let mutable lpos = words.Length - 1
let mutable cont = true
while fpos <= lpos && cont do
mid <- (fpos + lpos) / 2
match sign(value.CompareTo(words.[mid])) with
| -1 -> lpos <- mid-1
| 1 -> fpos <- mid+1
| _ -> cont <- false
not cont
But I think that the recursive version is preferable: more idiomatic, as efficient as the iterative one because it uses tail calls.
To begin with, your algo would not terminate for value greater, than the rightmost words element (easy test case is find [|"a";"b";"c";"d"|] "e").
This matter being corrected and throwing in few minor optimizations, the final interactive implementation is not likely can be shorter, than below
let find (words: string[]) (value:string) =
let mutable lpos = words.Length - 1
if value.CompareTo(words.[lpos]) > 0 then
false
else
let mutable mid = 0
let mutable fpos = 0
let mutable cont = true
while fpos < lpos && cont do
mid <- (fpos + lpos) / 2
match sign(value.CompareTo(words.[mid])) with
| -1 -> lpos <- mid
| 1 -> fpos <- mid
| _ -> cont <- false
not cont
UPDATE: That's what happens when putting answer in a rush and without a computer around :(. The content striked-through above is not something to be proud of. As MiMo has already took care of all problems in the snippet above I'll try something different to vindicate myself, namely, try demonstrating how MiMo's recursive implementation after tail-call recursion elimination turns almost literally into his non-recursive one.
We'll do this in two steps: first use a pseudo-code with labels and gotos to illustrate what compiler does for eliminating this form of tail recursion, and then convert pseudo-code back into F# for getting an imperative version.
// Step 1 - pseudo-code with tail recursion substituted by goto
let find(words:string[]) (value:string) =
let mutable fpos = 0
let mutable lpos = words.Length - 1
findRec:
match fpos - lpos > 0 with
| true -> return false
| _ -> let mid = (fpos + lpos) / 2
match sign(value.CompareTo(words.[mid])) with
| -1 -> lpos <- mid - 1
goto findRec
| 1 -> fpos <- mid + 1
goto findRec
| _ -> return true
Now, in absence of goto we should come up with an equivalent construction while staying within legit set of F# constructions. The easiest approach would be using while...do construction in concert with a mutable state variable capable simultaneously of signaling while when to stop and carrying return value. A tuple of two Booleans would be sufficient for this purpose:
// Step 2 - conversion of pseudo-code back to F#
let find(words:string[]) (value:string) =
let mutable fpos = 0
let mutable lpos = words.Length - 1
let mutable state = (true,false)
while (fst state) do
match fpos - lpos > 0 with
| true -> state <- (false,false)
| _ -> let mid = (fpos + lpos) / 2
match sign(value.CompareTo(words.[mid])) with
| -1 -> lpos <- mid - 1
| 1 -> fpos <- mid + 1
| _ -> state <- (false,true)
snd state
Summing up, the difference between "a-la compiler optimized" recursive version and hand-picked imperative one is insignificant, indeed, which should, in my opinion, make evident that correctly arranged recursive version performance-wise is equivalent to imperative version, but, given conversion performed by compiler, leaves no space for blunders of stateful coding.
I would suggest a recursive solution like this:
let find (xs: _ []) x =
let rec loop i0 i2 =
match i2-i0 with
| 0 -> false
| 1 -> xs.[i0]=x
| di ->
let i1 = i0 + di/2
let c = compare x xs.[i1]
if c<0 then loop i0 i1
else c=0 || loop i1 i2
loop 0 xs.Length
F# converts the tail calls into gotos, of course:
internal static bool loop#4<a>(a[] xs, a x, int i0, int i2)
{
a a;
while (true)
{
int num = i2 - i0;
switch (num)
{
case 0:
return false;
case 1:
goto IL_50;
default:
{
int i3 = i0 + num / 2;
a = xs[i3];
int c = LanguagePrimitives.HashCompare.GenericComparisonIntrinsic<a>(x, a);
if (c < 0)
{
a[] arg_37_0 = xs;
a arg_35_0 = x;
int arg_33_0 = i0;
i2 = i3;
i0 = arg_33_0;
x = arg_35_0;
xs = arg_37_0;
}
else
{
if (c == 0)
{
return true;
}
a[] arg_4A_0 = xs;
a arg_48_0 = x;
int arg_46_0 = i3;
i2 = i2;
i0 = arg_46_0;
x = arg_48_0;
xs = arg_4A_0;
}
break;
}
}
}
return true;
IL_50:
a = xs[i0];
return LanguagePrimitives.HashCompare.GenericEqualityIntrinsic<a>(a, x);
}
public static bool find<a>(a[] xs, a x)
{
return File1.loop#4<a>(xs, x, 0, xs.Length);
}

F# solution to "Escape from Zurg" puzzle

I have written an F# program to solve the "Escape from Zurg" puzzle
My code is the following. but somehow something is wrong with the way I am returning the boolean value when the puzzle is solved.
On the line
retVal = Move (cost + (MoveCost toy1 toy2)) Right remainingElements
I get a warning
The expression should have type 'unit' but has type 'bool'. If assigning a property use the syntax 'obj.Prop <- expr'
and I see that even though the function returns true when the puzzle is soved. when it returns the retVal remains false.
Below is my code.
open System
type Direction =
| Left
| Right
type Toy = {Name: string; Cost: int}
let toys = [
{Name="Buzz"; Cost=5};
{Name="Woody"; Cost=10};
{Name="Rex"; Cost=20};
{Name="Hamm"; Cost=25};
]
let MoveCost toy1 toy2 =
if (toy1.Cost > toy2.Cost) then
toy1.Cost
else
toy2.Cost
let rec Move cost direction group =
match group with
| [] -> if (cost > 60) then
false
else
Console.WriteLine("Solution Found!")
true
| _ ->
match direction with
| Left ->
let retVal = false
let combinations = Set.ofSeq (seq {for i in group do for j in group do if i <> j then if i < j then yield i, j else yield j, i})
for pair in combinations do
let (toy1, toy2) = pair
let remainingElements = List.filter (fun t-> t.Name <> toy1.Name && t.Name <> toy2.Name) group
retVal = Move (cost + (MoveCost toy1 toy2)) Right remainingElements
if (retVal) then
Console.WriteLine ("Move " + toy1.Name + " and " + toy2.Name + " with the total cost of " + cost.ToString())
retVal
| Right ->
let retVal = false
let toysOnRightBank = List.filter (fun t-> not(List.exists (fun g-> g = t) group)) toys
for toy in toysOnRightBank do
let cost = cost + toy.Cost
let retVal = Move cost Left (toy :: group)
if (retVal) then
Console.WriteLine("Move " + toy.Name + " back with the cost of " + toy.Cost.ToString())
retVal
[<EntryPoint>]
let main args =
let x = Move 0 Left toys
0
You cann't reassign a let binding. It should be:
let mutable retVal = false
...
retVal <- Move (cost + (MoveCost toy1 toy2)) Right remainingElements
However, you could easily rewrite it so that mutable isn't needed:
let res =
[
for i in group do
for j in group do
if i < j then yield i, j elif i > j then yield j, i
]
|> List.filter (fun (toy1, toy2) ->
let remainingElements = List.filter (fun t-> t.Name <> toy1.Name && t.Name <> toy2.Name) group
Move (cost + (MoveCost toy1 toy2)) Right remainingElements)
match res with
| [] -> false
| _ ->
res |> List.iter (fun (toy1, toy2) ->
Console.WriteLine ("Move " + toy1.Name + " and " + toy2.Name + " with the total cost of " + cost.ToString()))
true
EDIT: I posted a complete solution on gist, if you need a reference implementation.

F# match char values

I'm trying to match an integer expression against character literals, and the compiler complains about type mismatch.
let rec read file includepath =
let ch = ref 0
let token = ref 0
use stream = File.OpenText file
let readch() =
ch := stream.Read()
let lex() =
match !ch with
| '!' ->
readch()
| _ -> token := !ch
ch has to be an int because that's what stream.Read returns in order to use -1 as end of file marker. If I replace '!' with int '!' it still doesn't work. What's the best way to do this?
open System.IO
let rec read file includepath =
let ch = ref '0'
let token = ref '0'
use stream = File.OpenText file
let readch() =
let val = stream.Read();
if val = -1 then xxx
else
ch := (char)(val)
xxx
let lex() =
match !ch with
| '!' ->
readch()
| _ -> token := !ch
0
better style:
let rec read file includepath =
use stream = File.OpenText file
let getch() =
let ch = stream.Read()
if ch = -1 then None
else Some(char ch)
let rec getToken() =
match getch() with
| Some ch ->
if ch = '!' then getToken()
else ch
| None ->
failwith "no more chars" //(use your own excepiton)
The F# language does not have implicit conversation between types as they break compositional (i.e. if you move an operation it changes it's mean as there will no longer be an implicit conversion). You can use the char operator to change the int returned by the stream to a char:
open System.IO
let rec read file includepath =
let ch = ref 0
let token = ref 0
use stream = File.OpenText file
let readch() =
ch := stream.Read()
let lex() =
match char !ch with
| '!' ->
readch()
| _ -> token := !ch
lex()

Resources