Where does "#" come from in SML? - sml

I'm trying to make the function which takes string and transforms it to boolean expression. For example:for input ((x10+~1)*x132) it should give times(plus(var 10,compl 1),var 132), but it gives times(plus(var #,compl #),var 132). Where do hashtags come from??
datatype boolexp = zero
| one
| plus of boolexp * boolexp
| times of boolexp * boolexp
| var of int
| compl of boolexp
exception InvalidInput
(* takes the first n elements *)
fun take (_, 0) = nil
| take (nil, _) = raise InvalidInput
| take (h::t, n) = if n < 0
then raise InvalidInput
else h::take(t, n-1)
(* drops the frist n elements *)
fun drop (xs, 0) = xs
| drop (nil, _) = raise InvalidInput
| drop (h::t,n) = if n < 0
then raise InvalidInput
else drop (t, n-1)
(* converts string to integer *)
fun charlist_to_int (nil) = raise InvalidInput
| charlist_to_int (xs) =
let fun helper_int_rev (nil) = 0
| helper_int_rev (h::t) = if h >= #"0" andalso h <= #"9"
then helper_int_rev t * 10 + (ord h - ord #"0")
else raise InvalidInput
in helper_int_rev (rev xs) end;
(* finds the operator and its position *)
fun searchfor_oper (nil,_,_) = raise InvalidInput
| searchfor_oper (#"("::t, np, pos) = searchfor_oper (t, np+1, pos+1)
| searchfor_oper (#")"::t, np, pos) = searchfor_oper(t, np-1, pos+1)
| searchfor_oper (#"+"::t, 0, pos) = (pos, #"+")
| searchfor_oper (#"*"::t, 0, pos) = (pos, #"*")
| searchfor_oper (h::t, np, pos) = searchfor_oper (t, np, pos+1)
fun beparse_helper (nil) = raise InvalidInput
| beparse_helper (h::t) =
if h = #"x" then if hd(t)= #"0" then raise InvalidInput
else var (charlist_to_int (t))
else if h = #"0" then if t = nil then zero else raise InvalidInput
else if h = #"1" then if t = nil then one else raise InvalidInput
else if h = #"~" then compl(beparse_helper(t))
else if h = #"(" then
let
val lst = if hd (rev t)= #")" then take(t, length(t)-1) else raise InvalidInput
val (pos, oper) = searchfor_oper (lst, 0, 1)
in
if oper = (#"+")
then plus(beparse_helper(take(lst,pos-1)), beparse_helper(drop(lst,pos)))
else if oper = (#"*")
then times(beparse_helper(take(lst,pos-1)),beparse_helper(drop(lst,pos)))
else raise InvalidInput
end
else raise InvalidInput;
fun beparse(s) = beparse_helper(explode(s));
(*TESTING*)
beparse ("((x10+~1)*x132)");

I don't think that it is SML per se so much as SML/NJ default REPL output. In the grand scheme of things the REPL is for development/debugging -- not the environment for the finished program to run it. Recursive data structures such as trees can give quickly give rise to values which are too big to conveniently print. The REPL truncates the output in a couple of ways. For lists it will print around a dozen elements and then use .... For things like trees it will print down a few levels and then use a # to indicate that you have reached the level where the truncation happens. If you find this inconvenient you can do one of two things:
1) The logical printing depth in SML/NJ can be altered by evaluating Control.Print.printDepth := 20; (or however much you want) in the REPL
2) Perhaps a little more principled but more work -- write a custom pretty-printer (say pprint) for your values and evaluate e.g. pprint v; in the REPL rather than just v;

Also, consider using pattern matching more:
fun beparse_helper [] = raise InvalidInput
| beparse_helper (#"x"::cs) = var (charlist_to_int cs)
| beparse_helper (#"0"::[]) = zero
| beparse_helper (#"1"::[]) = one
| beparse_helper (#"~"::cs) = compl (beparse_helper cs)
| beparse_helper (#"("::(cs as (_::_))) =
let val lst = if List.last cs = #")"
then take (cs, length cs - 1)
else raise InvalidInput
in case searchfor_oper (lst, 0, 1) of
(pos, #"+") => plus (beparse_helper (take (lst, pos-1)),
beparse_helper(drop (lst, pos)))
| (pos, #"*") => times (beparse_helper (take (lst, pos-1)),
beparse_helper(drop (lst, pos)))
end
| beparse_helper _ = raise InvalidInput

Related

OCaml Longest common sequences (deep search)

Write with OCaml Longest Common Sottosequence (Deep Search)
Consider a finite set S of strings and an integer K. Determine, if it exists, a string x of length greater than or equal to K subsequence of each string s∈S. The problem is solved by using an in-depth search.
I tried it with two strings without k, it works!
this bellow is my code:
(*trasfmorm string in list char*)
let explode s =
let rec exp i l =
if i < 0 then l
else exp (i - 1) (s.[i] :: l)
in
exp (String.length s - 1) []
(*print list of strings*)
let rec print_list_strings = function
| [] -> ()
| e::l ->
print_string e;
print_string "\n";
print_list_strings l
(*print list of char*)
let rec print_list_char = function
| [] -> print_string "\n"
| e::l ->
print_char e;
print_string " ";
print_list_char l
(*between the lists tell me which one is longer*)
let longest xs ys =
if List.length xs > List.length ys then xs
else ys
(*lcs deep*)
let rec lcs a b =
match a, b with
| [], _ | _, [] -> []
| x::xs, y::ys ->
if x = y then
x :: lcs xs ys
else
longest (lcs a ys) (lcs xs b)
(*
On input: "ABCBDAB", "ABCBDAB"
The LCS returned is "BDAB"
*)
let a = "ABCBDAB";;
let b = "ABCBDAB";;
let a = explode a;;
let b = explode b;;
print_list_char (lcs a b);;
But when I start to find the solution for s strings it seems impossible.
For the moment i write the code bellow:
(* function return n-elemt of a list *)
exception Nth
let rec nth n lista =
match (n, lista) with
| (_, []) -> raise Nth
| (0, t::_) -> t
| (n, t::c) -> nth (n-1) c;;
(* functione given input list of char output string *)
let rendi_stringa s =
String.of_seq (List.to_seq s)
(* delete first n-element of a string *)
let rec drop n = function
| [] -> []
| x::xs ->
if n <= 0 then x::xs
else drop (n-1) xs ;;
(*string into a char list*)
let explode s =
let rec exp i l =
if i < 0 then l
else exp (i - 1) (s.[i] :: l)
in
exp (String.length s - 1) []
(*read k-elemt and return a list*)
let rec leggi k =
if k=0 then []
else
let x = read_line() in
(x) :: leggi (k-1)
(*print element list*)
let rec print_list = function
| [] -> ()
| e::l ->
print_string e;
print_string "\n";
print_list l
(*funzione lista string esplosa--> lista di lista*)
let rec explode_list n lista =
if n = 0 then []
else
let x = List.hd lista in
[(explode x)] # explode_list (n-1) (List.tl lista)
(*n-esima raw e m-column of matrix*)
let pos tabla n m =
let lista = (List.nth tabla n) in
List.nth lista m;;
let subset tabella n =
let rec aux solution tot = function
| [] ->
if tot > 0 then raise NotFound
else solution
| x::rest ->
print_string x;
print_string "\n";
aux (x::solution) (tot-1) rest
in
aux [] n tabella
let subset tabella n =
let rec aux solution = function
| [] ->
if List.length solution < n then raise NotFound
else solution
| x::rest -> nuova_funzione (explode x) rest n
in
aux [] n tabella
let nuova_funzione lista_char lista_string n = function
| _, [] -> print_string "non posso piu fare niente, stringhe finite\n"
| [], _ -> print_string "ho finito confronto con la lista\n"
| [] , x::lt ->
if (lcs lista_char (explode x)) > n then
else
let longest xs ys =
if List.length xs > List.length ys then xs
else ys
(*lcs profonda*)
let rec lcs a b =
match a, b with
| [], _ | _, [] -> []
| x::xs, y::ys ->
if x = y then
x :: lcs xs ys
else
longest (lcs a ys) (lcs xs b)
(**)
(*let rec lcs stringhe num = function
| []
| List.length stringhe < num -> []
| *)
(*------------------------main--------------*)
print_string "how many strings?\n";;
let m = read_int();;
print_string "please write your strings\n";;
let lista = leggi m;;
print_string "strings wrote\n";;
print_list lista;;
explode (nth 0 c);;
let a = "ABCBDAB";;
let a = explode a;;
let b = "BDCABA";;
let b = explode b;;
let c = "BADACB";;
let c = explode c;;
My idea was to use Backtracking, but i'm stuck with logical idea, I have no idea to implement it even with pseudocode!
Any idea or advise?

Why is this OCaml code resulting in a runtime error?

I am trying to run the following code on a coding question website and it says there is a runtime error, but running it on the top-level ocaml seems to work fine. Could there be any source of error in the code? Thanks in advance
The question is to find the number of 'good segments' within the given list and a specific number. A good segment is defined as follows:
A and B are positive integers such that A < B.
x that satisfies A <= x <= B is not an element of the given list.
The following are the inputs.
n, which is the number of elements in the list that will be given.
a, b, c, ... which are the elements of the list.
t, which is the number that must be included in the segment.
The output should be a single number printed out.
Edited Code:
let rec drop_value l to_drop =
match l with
| [] -> []
| hd :: tl ->
let new_tl = drop_value tl to_drop in
if hd = to_drop then new_tl else hd :: new_tl
;;
let rec find_start li t cur_min =
match li with
| [] -> cur_min
| hd :: tl -> let new_min = abs (t - hd) in
if new_min = 0 then find_start tl t new_min
else if new_min < cur_min && t > hd then find_start tl t new_min
else find_start tl t cur_min
;;
let rec find_end li t cur_min =
match li with
| [] -> cur_min
| hd :: tl -> let new_min = abs (t - hd) in
if new_min = 0 then find_end tl t new_min
else if new_min < cur_min && t < hd then find_end tl t new_min
else find_end tl t cur_min
;;
let rec contains_value l value =
match l with
| [] -> false
| hd :: tl -> if hd = value then true else contains_value tl value
;;
let nums = ref [];;
let n = read_int () in
for i = 1 to n do
Scanf.scanf " %d" (fun a ->
nums := a :: !nums)
done;
Scanf.scanf " %d" (fun t ->
if contains_value !nums t then print_int 0
else let start = if List.length !nums = 1 then 1 else abs (find_start !nums t 1001 - t) in
let finish = find_end (drop_value !nums start) t 1001 + t in
if t > start && t < finish then (if start = 1 && List.length ! nums = 1 then print_int ((t - start + 1) * (finish - t) - 1) else print_int ((t - start) * (finish - t) - 1))
else let start = 1 in print_int ((t - start + 1) * (finish - t) - 1))
;;
eg.
5
4 8 13 24 30
10
should give
5
=> [9, 10], [9, 11], [9, 12], [10, 11], [10, 12]
You don't describe the exact input format that your code is going to get. This makes it pretty much impossible to debug your code.
When I compile and run your code (as m.ml) using the input you describe I see this:
$ ./m
5 4 8 13 24 30 10
Fatal error: exception Failure("int_of_string")
In fact no matter what format I try for the input I get the same result.
So that is probably what is happening at the website.
In my experience it always causes more harm than good to use scanf. Combining it with other input functions is probably going to make things worse.
If you describe the expected format of the input carefully, somebody on StackOverflow can recommend a way to get your numbers.
In the meantime here's a way to read all the numbers on one line:
let rec split_at list n =
if n = 0 then
([], list)
else
match list with
| [] -> ([], [])
| h :: t ->
let (a, b) = split_at t (n - 1) in (h :: a, b)
in
let (nums, t) =
let line = read_line () in
let nstrs = Str.split (Str.regexp "[ \t][ \t]*") line in
match List.map int_of_string nstrs with
| [] -> failwith "no numbers"
| n :: rest ->
if List.length rest <> n + 1 then
failwith "bad count"
else
let (nums, tlist) = split_at rest n in
(nums, List.hd tlist)
in
. . .

Why this program dosen't halt when only need to iterating throught a finite stream?

I'm trying to get a list of primes of two digits by running these codes in LearnOcaml. The codes compile if I restrict the parameter of the listify method, which returns a list from a stream, to be less than 20. Otherwise, it either never halt or return "Exception: Js_of_ocaml__Js.Error _.". I don't think the code is semantically wrong. So I'm
wondering if anyone can help resolve the problem?
type 'a stream = Eos | StrCons of 'a*(unit -> 'a stream)
(*integers from n onwards*)
let rec nums_from n =
StrCons(n,fun () -> nums_from (n+1))
let rec filterStr (test : 'a -> bool) (s: 'a stream) =
match s with
|Eos -> Eos
|StrCons(q,w) -> if test q then StrCons(q,fun ()-> filterStr test (w ()))
else filterStr test (w ())
(*Remove all numbers mod p*)
let sift p =
filterStr (fun x -> x mod p <> 0)
(*Sieves*)
let rec sieves s =
match s with
|Eos ->Eos
|StrCons(x,g) -> StrCons(x, fun ()-> sieves (sift x (g ())))
(*primes*)
let allprimes = sieves (nums_from 2)
let rec listify s n=
if n =0 then [] else
match s with
|Eos -> []
|StrCons(q,w) -> q::(listify (w ()) (n-1))
let twodigitsprimes = filterStr (fun x -> x > 10&& x<100) allprimes
let twodigitsprimeslist= listify twodigitsprimes 21
It appears that filterStr is looping while trying to create the StrCons that represents the next element after the 21st. Since there are only 21 2-digit primes, this will loop forever.
Note that when listify is called with n = 0, the StrCons has already been constructed; it just isn't examined. But the StrCons for this case diverges (and OCaml is a strict language).
You can get things to work using this version of listify:
let rec listify s n =
if n = 0 then []
else
match s with
| Eos -> []
| StrCons (q, w) ->
if n = 1 then [q] else q :: listify (w ()) (n - 1)

How to count the number of successive duplicates in Ocaml

I'm trying to write a function that takes in a list, and returns the number of successive duplicate elements in the list.
For example, given [1;2;3;3;4;4;5], the function should return 2
This is my initial implementation, but unfortunately it always returns 0. I'm not quite sure where the bug lies.
Any help on how to improve it will be highly appreciated.
let rec count_successive_duplicates (lst: int list) (count: int) : (int) =
match lst with
| [] | [_]-> 0
| x :: y :: tl ->
if x = y then count_successive_duplicates (y::tl) (count + 1) else count_successive_duplicates (y::tl) count
;;
let () =
print_int (count_successive_duplicates [1;2;3;3;4;4;5] 0)
In the end, you'll want to return the accumulator with the count instead of 0 always:
let rec count_successive_duplicates (lst: int list) (count: int) : (int) =
match lst with
| [] | [_] -> count
(* ^^^^^ */)
| x :: y :: tl -> count_successive_duplicates (y::tl) (count + if x = y then 1 else 0)
Seems I was doing something silly by always returning 0 for the base case, instead of the computed count. The previous version was just ignoring the computed count it received. This now works:
let rec count_successive_duplicates lst count : (int) = match lst with
| [] | [_]-> count
| x :: y :: tl ->
if x = y then count_successive_duplicates (y::tl) (count + 1) else count_successive_duplicates (y::tl) count
;;
let () =
print_int (count_successive_duplicates [1;2;3;3;4;4;5] 0)

Unite multiple code lines into one function in sml/ml using "let" command

I'm having a problem grouping these code lines into one function
sumFirstEven : int * int seq -> int
such that sumFirstEven (5, s) is the sum of the first 5 even elements of the sequence s
I've been told that I need to group my lines into one function that includes "let-in commands"
these are my lines for these func:
datatype 'a seq=null|SEQ of 'a*(unit->'a seq);
fun head(SEQ(x,_))=x
|head null=raise Empty;
fun tail(SEQ(_,xf))=xf()
|tail null=raise Empty;
fun sumFirstEven(0,_)=0
|sumFirstEven(n,null)=0
|sumFirstEven(n,xs)=if(head(xs) mod 2=0)then head(xs)+sumFirstEven(n-1,tail(xs))
else sumFirstEven(n,tail(xs));
fun seqFrom i=SEQ(i,fn()=>seqFrom(i+1));
val seqStart=seqFrom 1;
sumFirstEven(5,seqStart);
My function works fine but I dont know how to regroup all of these lines
correctly
The beauty of pattern matching is that it often obviates helper functions like head and tail.
fun sumFirstEven (0, _) = 0
| sumFirstEven (_, null) = 0
| sumFirstEven (n, SEQ (h, t)) =
case h mod 2
of 0 => h + sumFirstEven (n-1, t ())
| _ => sumFirstEven (n, t ())
Since the first two clauses didn't match, there's no need in the third clause to call a function with a failure condition like head... we already know the data is in the right form!
The pattern matching in the function clause serves the same role that a let-in-end expression (not command!) would.
Given your lazy list type,
datatype 'a seq = Null | Seq of 'a * (unit -> 'a seq)
you might want the helper function,
fun even n = n mod 2 = 0
and you might want to either recurse manually,
fun sumFirstEven (0, _) = 0
| sumFirstEven (_, Null) = 0
| sumFirstEven (n, Seq (x, seqf) =
if even x
then x + sumFirstEven (n-1, seqf ())
else sumFirstEven (n, seqf ())
or you may want to accumulate the result in a function parameter,
fun sumFirstEven (n, seq) =
let fun sfe (0, _, result) = result
| sfe (_, Null, result) = result
| sfe (n, Seq (x, seqf), result) =
if even x
then sfe (n-1, seqf (), result + x)
else sfe (n, seqf (), result)
in sfe (n, seq, 0) end
to make it tail-recursive (i.e. use a fixed amount of stack frames). More conveniently, you might want to extract the recursion part of the function into a separate higher-order fold combinator,
fun foldseqn _ e 0 _ = e
| foldseqn _ e _ Null = e
| foldseqn f e n (Seq (x, seqf)) =
case f (x, e) of
(e', true) => foldseqn f e' (n-1) (seqf ())
| (e', false) => foldseqn f e' n (seqf ())
fun sumFirstEven (n, seq) =
foldseqn (fn (x, sum) => if even x
then (sum + x, true)
else (sum, false)) 0 n seq
And a quick test,
fun nats n = Seq (n, fn () => nats (n+1))
val twelve = sumFirstEven (3, nats 1) (* 2+4+6 *)
Edit: Responded to Nick's comment, thanks.