I wish to create two functions : the first one generates a new integer and the second one reset the generator
let a = ref 0 in
let f () = a := !a + 1 and
g () = a := 0; ();;
The REPL shows "Error: Syntax error" on the last two semicolons.
The second let also needs to be followed by an in (see the manual), e.g.,
let inc, reset =
let a = ref 0 in
let f () = a := !a + 1; !a
and g () = a := 0
in (f, g);;
But maybe you want something more like this:
let new_counter () =
let a = ref 0 in
let f () = a := !a + 1; !a
and g () = a := 0
in (f, g);;
Related
I want to write simple insertion sort function using fold_left but I also want to pass function that will specify order in my sort fun.
What I don't know, is how to pass it to fold_left..
let rec insert f l e =
match l with
| [] -> [e]
| h :: t -> if f e h then h :: insert f t e else e :: l;;
let insertion_sort f l = List.fold_left insert f [] l;;
let less x y = x < y;;
let result = insertion_sort less [2 ; 5 ; 1 ; 9 ; 7 ; -2 ; 0 ; 124];;
This what I am talking about but fold_left doesn't accept that solution.
When I make specialization of sort function then it works just fine.
let insertLess = insert less;;
let insertion_sortLess l = List.fold_left insertLess [] l;;
let result = insertion_sortLess [2 ; 5 ; 1 ; 9 ; 7 ; -2 ; 0 ; 124];;
# val result : int list = [124; 9; 7; 5; 2; 1; 0; -2]
List.fold_left insert f ... will apply insert and f as separate arguments to List.fold_left. What you want is List.fold (insert f) ..., which will apply f to insert, and then the result of that to List.fold_left.
Edit: In addition, you don't need to define less. You can pass > as a function directly by surrounding it in parentheses: insertion_sort (<) ...
For instance, how can I construct an array in ATS containing all of the letters in the upper case from A to Z? In C, this can be done as follows:
char *Letters()
{
int i;
char *cs = (char *)malloc(26);
assert(cs != 0);
for (i = 0; i < 26; i += 1) cs[i] = 'A' + i;
return cs;
}
You could use the tabulate function for creating linear arrays. For instance,
extern
fun
Letters(): arrayptr(char, 26)
implement
Letters() =
arrayptr_tabulate_cloref<char>
(i2sz(26), lam(i) => 'A' + sz2i(i))
If you don't want to use a higher-order function, you can try the following template-based solutioin:
implement
Letters() =
arrayptr_tabulate<char>(i2sz(26)) where
{
implement array_tabulate$fopr<char> (i) = 'A' + sz2i(i)
}
Well, here's one way, although it's extremely complicated, because it follows your outlined approach to the letter: it involves linear proofs for arrays (aka dataviews), memory allocation, and array initialization via a while loop.
extern
fun
Letters (): arrayptr (char, 26)
implement
Letters () = let
val (pf_arr, pf_gc | p_arr) = array_ptr_alloc<char> ((i2sz)26)
var i: int = 0
prval [larr:addr] EQADDR () = eqaddr_make_ptr (p_arr)
var p = p_arr
prvar pf0 = array_v_nil {char} ()
prvar pf1 = pf_arr
//
val () =
while* {i:nat | i <= 26} .<26-i>. (
i: int (i)
, p: ptr (larr + i*sizeof(char))
, pf0: array_v (char, larr, i)
, pf1: array_v (char?, larr+i*sizeof(char), 26-i)
) : (
pf0: array_v (char, larr, 26)
, pf1: array_v (char?, larr+i*sizeof(char), 0)
) => (
i < 26
) {
//
prval (pf_at, pf1_res) = array_v_uncons {char?} (pf1)
prval () = pf1 := pf1_res
//
val c = 'A' + (g0ofg1)i
val () = ptr_set<char> (pf_at | p, c)
val () = p := ptr1_succ<char> (p)
//
prval () = pf0 := array_v_extend {char} (pf0, pf_at)
val () = i := i + 1
//
} // end of [val]
//
prval () = pf_arr := pf0
prval () = array_v_unnil {char?} (pf1)
//
val res = arrayptr_encode (pf_arr, pf_gc | p_arr)
in
res
end // end of [Letters]
You can run the code at Glot.io
How to modify below code to Return "string" so that returned output displayed on my MVC page and also would like to accept enteredChar from user.
Is there better way to do create this pyramid?
Current code:
let enteredChar = 'F' // As Interactive window doesn't support to Read Input
let mylist = ['A'..enteredChar]
let mylistlength = mylist |> List.length
let myfunc i x tlist1 =
(for j = 0 to mylistlength-i-2 do printf "%c" ' ')
let a1 = [for p in tlist1 do if p < x then yield p]
for p in a1 do printf "%c" p
printf "%c" x
let a2 = List.rev a1
for p in a2 do printf "%c" p
printfn "%s" " "
mylist |> List.iteri(fun i x -> myfunc i x mylist)
Output:
A
ABA
ABCBA
ABCDCBA
ABCDEDCBA
ABCDEFEDCBA
A few small optimizations could be:
Use StringBuilder instead of printf which is quite slow with long strings.
Use Array instead of List since Array works better with String.
Here is a version producing a pyramid string, which is kept closely to your code:
open System
open System.Text
let generateString c =
let sb = StringBuilder()
let generate i x arr =
String.replicate (Array.length arr-i-1) " " |> sb.Append |> ignore
let a1 = Array.filter (fun p -> p < x) arr
String(a1) |> sb.Append |> ignore
sb.Append x |> ignore
String(Array.rev a1) |> sb.Append |> ignore
sb.AppendLine " " |> ignore
let arr = [|'A'..c|]
arr |> Array.iteri(fun i x -> generate i x arr)
sb.ToString()
generateString 'F' |> printfn "%s"
As an alternative to Daniel's solution, you can achieve what you want with minimal changes to the code logic. Instead of using printf that writes the output to the console, you can use Printf.bprintf which writes the output to a specified StringBuilder. Then you can simply get the resulting string from the StringBuilder.
The modified function will look like this. I added parameter str and replaced printf with Printf.bprintf str (and printfn with bprintf together with additional \n char):
let myfunc i x tlist1 str =
(for j = 0 to mylistlength-i-2 do Printf.bprintf str "%c" ' ')
let a1 = [for p in tlist1 do if p < x then yield p]
for p in a1 do Printf.bprintf str "%c" p
Printf.bprintf str "%c" x
let a2 = List.rev a1
for p in a2 do Printf.bprintf str "%c" p
Printf.bprintf str "%s\n" " "
To call the function, you first create StringBuilder and then pass it to myfunc in every call. At the end, you can get the result using ToString method:
let str = StringBuilder()
mylist |> List.iteri(fun i x -> myfunc i x mylist str)
str.ToString()
I think Daniel's solution looks nicer, but this is the most direct way to tunr your printing code into a string-building code (and it can be done, pretty much, using Search & Replace).
If I understand your question (this likely belongs on Code Review) here's one way to rewrite your function:
let showPyramid (output: TextWriter) lastChar =
let chars = [|'A' .. lastChar|]
let getRowChars n =
let rec loop acc i =
[|
if i < n then let c = chars.[i] in yield c; yield! loop (c::acc) (i+1)
else yield! List.tail acc
|]
loop [] 0
let n = chars.Length
for r = 1 to n do
output.WriteLine("{0}{1}{0}", String(' ', n - r), String(getRowChars r))
Example
showPyramid Console.Out 'F'
or, to output to a string
use output = new StringWriter()
showPyramid output 'F'
let pyramid = output.ToString()
EDIT
After seeing Tomas' answer I realized I skipped over "return a string" in your question. I updated the code and added examples to show how you could do that.
let pyramid (ch:char) =
let ar = [| 'A'..ch |]
let len = ar.Length
Array.mapi
(fun i ch ->
let ar = ar.[0..i]
String.replicate (len - i - 1) " " + new string(ar) + new string((Array.rev ar).[1..]))
ar
|> String.concat "\n"
pyramid 'F' |> printfn "%s"
Here's another approach that seems to be a good demonstration of functional composition. I bet it's the shortest solution among the answers here. :)
let charsToString = Seq.map string >> String.concat String.Empty
let pyramid lastChar =
let src = '-'::['A'..lastChar] |> List.toArray
let len = Array.length src - 1
fun row col -> row-abs(col-len+1)+1 |> max 0 |> Array.get src // (1)
>> Seq.init (len*2-1) >> charsToString // (2)
|> Seq.init len // (3)
pyramid 'X' |> Seq.iter (printfn "%s")
First, we generate an unusual array of initial data. Its element [0] contains a space or whatever separator you want to have; I preferred dash (-) for debugging purposes.
The (1) line makes a function that calculates what character to be placed. The result of row-abs(col-len+1)+1 can be either positive (and there is a char to be placed) or zeronegative, and there should be a space. Note that there is no if statement: it is hidden within the max function;
The (2) line composes a function int -> string for generating an individual row;
The (3) line passes the function above as argument for sequence initializer.
The three lines can be written in a more verbose way:
let genCell row col = row-abs(col-len+1)+1 |> max 0 |> Array.get src
let genRow = genCell >> Seq.init (len*2-1) >> charsToString
Seq.init len genRow
Note genRow needs no formal argument due to functional composition: the argument is being bound into genCell, returning a function of a single argument, exactly what Seq.init needs.
I'm having a lot of trouble with the test_modifier method in lablgtk2. I can test for Shift, but that isn't very useful for my purposes. Whenever I test if control and another key is pressed nothing happens. I've also tried this:
view#event#connect#key_press ~callback:(fun ev ->
let m = GdkEvent.Key.state ev in
let k = GdkEvent.Key.keyval ev in
if (m = [`CONTROL] && k = _F) then
...
It worked for awhile and then it stopped. What is wrong with the above code that it wouldn't do anything? How can I properly test for a Control key press in lablgtk2?
There can be several modifiers at once so comparing to [`CONTROL] is not valid.
let pr fmt = Printf.ksprintf print_endline fmt
let button label packing f =
let b = GButton.button ~label ~packing () in
let _ = b#connect#clicked ~callback:f in
()
let () =
let locale = GtkMain.Main.init () in
let window = GWindow.window ~title:"test" ~border_width:10 () in
let _ = window#connect#destroy ~callback:GMain.quit in
let mainbox = GPack.vbox ~packing:window#add () in
button "quit" mainbox#pack window#destroy;
let _ = window#event#connect#key_press ~callback:begin fun ev ->
let m = GdkEvent.Key.state ev in
let k = GdkEvent.Key.keyval ev in
if (List.mem `CONTROL m && k = GdkKeysyms._F) then pr "WOO HOO";
if (List.mem `CONTROL m && k = GdkKeysyms._f) then pr "woo hoo";
false
end in
window#event#add [`KEY_PRESS];
window#show ();
GMain.main ()
I'm trying to get the exact equivalent (not functional) of this vb.net code in F#:
Function FastPow(ByVal num As Double, ByVal exp As Integer) As Double
Dim res As Double = 1
If exp < 1 Then
If exp = 0 Then Return res
exp = -exp
num = 1 / num
End If
Do While exp > 1
If exp Mod 2 = 1 Then
res = res * num
num = num * num
exp = exp >> 1
Loop
Return res * num
End Function
I wrote this:
let FastPow num exp =
let mutable ex = exp
let mutable res = 1
let mutable n = num
if ex < 1 then
if ex = 0 then res
ex <- -ex
n <- 1 / n
while ex > 1 do
if (ex % 2 = 1) then
res <- res * n
n <- n * n
exp >>> 1
res * n
but in the line "if ex = 0 then res" at res I got an error:
"This expression has type int but is here used with type unit".
I cannot understand why it gives me that error.
Edit: i actually got a warning as well:
"This expression should have type 'unit', but has type 'int'."
at "if (ex % 2 = 1) then"
In F#, a function's return value is the last expression evaluated in the function. So, lets focus on the following:
if ex < 1 then
if ex = 0 then res (* <--- this is not an early return *)
ex <- -ex (* <--- F# evaluates this code after the *)
n <- 1 / n (* if statement *)
Additionally, if statements have return values, which also happens to be the last value executed in the if statement. If an if statement isn't the return value of a function, it should have the return type unit. Notice that variable assignment has a return type of unit.
We need to rewrite your code to accomodate your early return, so we can do this:
let FastPow2 num exp =
if exp = 0 then 1
else
let mutable ex = exp
let mutable res = 1
let mutable n = num
if ex < 1 then
ex <- -ex
n <- 1 / n
while ex > 1 do
if (ex % 2 = 1) then (* still have a bug here *)
res <- res * n
n <- n * n
exp >>> 1 (* <--- this is not a variable assignment *)
res * n
We still have a bug, although I think F# is reporting the error in the wrong place. The expression exp >>> 1 returns an int, it does not assign any variables, so its not equivalent to your original C# code. I think you meant to use the ex variable instead. We can fix your code as follows:
let FastPow2 num exp =
if exp = 0 then 1
else
let mutable ex = exp
let mutable res = 1
let mutable n = num
if ex < 1 then
ex <- -ex
n <- 1 / n
while ex > 1 do
if (ex % 2 = 1) then
res <- res * n
n <- n * n
ex <- ex >>> 1
res * n
Now your function is fixed, but its really really ugly. Lets convert it to more idiomatic F#. You can replace the if statement with pattern matching, and replace the while loop with recursion:
let FastPow2 num exp =
match exp with
| 0 -> 1
| _ ->
let rec loop ex res n =
if ex > 1 then
let newRes = if ex % 2 = 1 then res * n else res
loop (ex >>> 1) newRes (n * n)
else res * n
let ex, n = if exp < 1 then (-exp, 1 / num) else (exp, num)
loop ex 1 n
Much better! Theres still some more room to beautify this function, but you get the idea :)
The problem is for an if statment to resolve to a value rather than unit, you need both the "then" part and the "else" part, both of which resolve to the same type.
For example:
let a = if true then 1;;
Will generate the same error - expression has type int but used with type unit.
However:
let a = if true then 1 else 0;;
Will evaluate to int without an error.
This is about as close as you can get, as others have already said you can't jump out of the middle of a functional and there's one place were you don't update a variable (at the bottom of the while).
let FastPow num exp =
let mutable exp = exp
let mutable res = 1
let mutable n = num
match exp with
| O -> n <- num
| _ when exp < 1 ->
exp <- -exp
n <- 1 / n
| _ ->
while exp > 1 do
if (exp % 2 = 1) then
res <- res * n
n <- n * n
exp <- exp >>> 1
res * n
I could be more beautiful if it was written more functionally.
It means that after then there should be some expression, but you have integer value. You cannot jump out from the middle of the function.
Edit
"If" didn't work because of
ex >>> 1
should be
ex <- ex >>> 1
Here's code that works:
let FastPow num exp =
let calcExp num exp =
let mutable res = 1.0
let mutable n = num
let mutable ex = exp
while ex > 1 do
if ((ex % 2) = 1) then
res <- res * n
n <- n * n
ex <- ex >>> 1
res * n
match exp with
| ex when ex = 0 -> 1.0
| ex when ex < 0 -> calcExp (1.0/num) -exp
| _ -> calcExp num exp
I just take out calculation as separate function, and at the end there is checking for arguments
Thanks for the answers. This is the current non-functional version.
let FastPow num exp =
let mutable ex = exp
let mutable res = 1.0
let mutable n = num
if ex = 0 then 1.0
else
if ex < 1 then
ex <- -ex
n <- 1.0 / n
while ex > 1 do
if (ex % 2 = 1) then res <- res * n
n <- n * n
ex <- ex >>> 1
res * n
Now that I have a working version I will try to make it more functional but that's outside the scope of this question.
EDIT: I got better results that I expected so I will post the recursive version optimized for speed (slightly faster than the iterative version and about 10% faster than the C# iterative version (!!!) in my computer):
let rec loop res num exp =
if exp = 0 then res
elif (exp % 2) = 1 then loop (res * num) (num * num) (exp / 2)
else loop res (num * num) (exp / 2)
let FP num exp =
let n = if exp < 0 then 1.0 / num else num
loop 1.0 n (Math.Abs(exp))