Functions in F# Discriminated Unions - haskell

Is there a way to use functions in Discriminated Unions? I am looking to do something like this:
Type Test<'a> = Test of 'a-> bool
I know this is possible in Haskell using newtype and I was wondering what the equivalent in F# would be.
Thanks.

type Test<'A> = Test of ('A -> bool)

As an expansion on desco's answer you can apply the function tucked into Test with pattern matching:
type Test<'a> = Test of ('a -> bool)
// let applyTest T x = match T with Test(f) -> f x
// better: (as per kvb's comment) pattern match the function argument
let applyTest (Test f) x = f x
Example:
// A Test<string>
let upperCaseTest = Test (fun (s:string) -> s.ToUpper() = s)
// A Test<int>
let primeTest =
Test (fun n ->
let upper = int (sqrt (float n))
n > 1 && (n = 2 || [2..upper] |> List.forall (fun d -> n%d <> 0))
)
In FSI:
> applyTest upperCaseTest "PIGSMIGHTFLY";;
val it : bool = true
> applyTest upperCaseTest "PIGSMIgHTFLY";;
val it : bool = false
> [1..30] |> List.filter (applyTest primeTest);;
val it : int list = [2; 3; 5; 7; 11; 13; 17; 19; 23; 29]

Related

Accessing list positions inside functions like map in Haskell

I have just tried rewriting some code, originally a short Javascript function, in Haskell. The original has 2 nested loops and the inner loop contains a check for equality against both loop counters:
function f(x, points){
var i, j;
var n = points.length;
var result = 0;
for(i=0; i<n; i++){
var xprod = 1;
for(j=0; j<n; j++){
if(j != i){
xprod *= (x - points[j][0]);
}
}
result += points[i][1] * xprod;
}
return result;
}
I was hoping to be able to simplify it in Haskell, but I couldn't figure out how get hold of the i and j values without effectively writing out every step of the original recursively. In Javascript Array.map passes the list position into the callback function as the second parameter, but it seems that map in Haskell doesn't do this. My current Haskell version looks awful to me as I'm passing in 2 copies of the array (one for each loop):
xproduct :: Int -> Int -> Double -> [(Double,Double)] -> Double
xproduct _ _ _ [] = 1
xproduct i j x (pt:todo)
| i == j = (xproduct i (j+1) x todo)
| otherwise = (xproduct i (j+1) x todo) * (x - (fst pt))
solvestep :: Int -> Double -> [(Double,Double)] -> [(Double,Double)] -> Double
solvestep _ _ _ [] = 0
solvestep i x pts (pt:todo) = ((snd pt) * xprod) + (solvestep (i+1) x pts todo)
where xprod = xproduct i 0 x pts
solve :: Double -> [(Double,Double)] -> Double
solve x points = solvestep 0 x points points
Is there a better way to do this?
I generally avoid using any indices at all, if possible. In this case, what you're really working with is: any one element of the list with all the other elements. No need to express that with index comparison, instead write a function that will give you a suitable look into the list:
pickouts :: [a] -> [(a,[a])]
pickouts [] = []
pickouts (x:xs) = (x,xs) : (second (x:) <$> pickouts xs)
Then, the actual computation becomes just
f :: Double -> [(Double,Double)] -> Double
f x points = sum [q * product [x-p | (p,_)<-ps] | ((_,q),ps) <- pickouts points]

F# - Remove duplicate characters after first in string

What I am trying to do is to remove duplicates of a specific given char in a string but letting the first char to remain. I.e:
let myStr = "hi. my .name."
//a function that gets a string and the element to be removed in the string
someFunc myStr "."
where someFunc returns the string showen as below:
"hi. my name"
It is easy to remove duplicates from a string, but is there a way to remove the duplicates but letting the first duplicated element remain in the string?
Here's one approach:
let keepFirst c s =
Seq.mapFold (fun k c' -> (c', k||c<>c'), k&&c<>c') true s
|> fst
|> Seq.filter snd
|> Seq.map fst
|> Array.ofSeq
|> System.String
let example = keepFirst '.' "hi. my .name."
let someFunc (str : string) c =
let parts = str.Split([| c |])
if Array.length parts > 1 then
seq {
yield Array.head parts
yield string c
yield! Array.tail parts
}
|> String.concat ""
else
str
Note that the character is given as char instead of a string.
let someFunc chr (str:string) =
let rec loop (a: char list) b = function
| [] -> a |> List.rev |> System.String.Concat
| h::t when h = chr -> if b then loop a b t
else loop (h::a) true t
| h::t -> loop (h::a) b t
loop [] false (str.ToCharArray() |> Array.toList)
Note that the character is given as char instead of a string.
Edit: Another way would be using regular expressions
open System.Text.RegularExpressions
let someOtherFunc c s =
let pat = Regex.Escape(c)
Regex.Replace(s, sprintf "(?<=%s.*)%s" pat pat, "")
Note that, in this case the character is given as string.
Edit 2:
let oneMoreFunc (c:char) (s:string) =
let pred = (<>) c
[ s |> Seq.takeWhile pred
seq [c]
s |> Seq.skipWhile pred |> Seq.filter pred ]
|> Seq.concat
|> System.String.Concat
When devising a function, think about gains from making its arguments generic. To pass state through the iteration, barring mutable variables, Seq.scan could be a weapon of choice. It folds into a tuple of new state and an option, then Seq.choose strips out the state and the unwanted elements.
In terms of functional building blocks, make it accept a predicate function 'a -> bool and let it return a function seq<'a> -> seq<'a>.
let filterDuplicates predicate =
Seq.scan (fun (flag, _) x ->
let p = predicate x in flag || p,
if flag && p then None else Some x ) (false, None)
>> Seq.choose snd
This can then easily reused to do other things as well, like 0 together with odd numbers.
filterDuplicates (fun i -> i % 2 = 0) [0..10]
// val it : seq<int> = seq [0; 1; 3; 5; ...]
Supplied with a call to the equality operator and fed into the constructor of System.String, you'll get near the signature you want, char -> seq<char> -> System.String.
let filterDuplicatesOfChar what s =
System.String(Array.ofSeq <| filterDuplicates ((=) what) s)
filterDuplicatesOfChar '.' "hi. my .name."
// val it : string = "hi. my name"

A module with a store

It happens quite often that it is costly to calculate a property from a value. So it would be better to be able to store the property once it is calculated. I am wondering how to code this properly.
Let's take an example. Assume we have a type integer, and very often we need to calculate prime factors of a value of such type (let's assume the prime factors of a negative integer is None):
module I =
struct
type t = C of int
type pf = (int list) option
let calculate_prime_factors (x: t) : pf =
(* a costly function to calculate prime factors *)
... ...
let get_prime_factors (x: t) : pf =
calculate_prime_factors x
end
let () =
let v = I.C 100 in
let pf_1 = I.get_prime_factors v in
let pf_2 = I.get_prime_factors v in
let pf_3 = I.get_prime_factors v in
...
At the moment, get_prime_factors just calls calculate_prime_factors, as a consequence, all the calculations of pf_1, pf_2, pf_3 are time consuming. I would like to have a mechanism to enable storing prime factors inside the module, so that as long as the integer does not change, the second and third times of get_prime_factors just read what have been stored.
Does anyone know how to modify the module I to achieve this?
It is possible that we need references to make this mechanism possible (eg, let vr = ref (I.C 100) in ...). It is OK for me to use references. But I don't know how to trigger automatically calculate_prime_factors if the hold value (ie, !vr) is changed.
What you want to do is memoization, no ?
You could try this :
module I =
struct
type t = C of int
type pf = (int list) option
let calculate_prime_factors (x: t) : pf =
(* a costly function to calculate prime factors *)
... ...
module HI = Hashtbl.Make (struct
type t = C of int
let equal = (=)
let hash (C x) = x
end)
let get_prime_factors =
let h = Hashtbl.create 17 in
fun x ->
try Hashtbl.find h x
with
Not_found -> let pf = calculate_prime_factors x in
Hashtbl.add h x pf;
pf
end
let () =
let v = I.C 100 in
let pf_1 = I.get_prime_factors v in
let pf_2 = I.get_prime_factors v in
let pf_3 = I.get_prime_factors v in
...
You could adapt it for negative integers (with exceptions, for example, which is better than options) but I hope you get the idea.
Looks like, that you're looking for this solution:
module I = struct
type t = {
c : int;
mutable result : int option;
}
let create c = {c; result = None}
let calculate_prime_factors t = match t.result with
| Some r -> r
| None ->
let r = do_calculate t.c in
t.result <- Some r;
r
end
This is called memoizing. And this particular example can be solved even easier, with Lazy computations.
module I = struct
type t = int Lazy.t
let create c = lazy (do_calculate c)
let calculate_prime_factors = Lazy.force
end
I would do the following :
let get_prime_factors x =
match get x with
| None ->
let res = calculate_prime_factors x
in
begin
set x res ;
res
end
| Some res -> res
;;
You need a mutable data structure accessed by get and set. For instance, with a reference on a list (but you may prefer a hashtable) :
let my_storage = ref [] (* or something mutable *)
let get x =
if List.mem_assoc x !my_storage
then Some (List.assoc x !my_storage)
else None
let set x r =
my_storage := (x,r) :: !my_storage ;;
You can also use exceptions instead of the option type (None and Some _).

group by until changed sequence

I have a big Excel file, which i read with Excel Provider in F#.
The rows should be grouped by some column. Processing crashes with OutOfMemoryException. Not sure whether the Seq.groupBy call is guilty or excel type provider.
To simplify it I use 3D Point here as a row.
type Point = { x : float; y: float; z: float; }
let points = seq {
for x in 1 .. 1000 do
for y in 1 .. 1000 do
for z in 1 .. 1000 ->
{x = float x; y = float y; z = float z}
}
let groups = points |> Seq.groupBy (fun point -> point.x)
The rows are already ordered by grouped column, e.g. 10 points with x = 10, then 20 points with x = 20 and so one. Instead of grouping them I need just to split the rows in chunks until changed. Is there some way to enumerate the sequence just once and get sequence of rows splitted, not grouped, by some column value or some f(row) value?
If the rows are already ordered then this chunkify function will return a seq<'a list>. Each list will contain all the points with the same x value.
let chunkify pred s = seq {
let values = ref []
for x in s do
match !values with
|h::t -> if pred h x then
values := x::!values
else
yield !values
values := [x]
|[] -> values := [x]
yield !values
}
let chunked = points |> chunkify (fun x y -> x.x = y.x)
Here chunked has a type of
seq<Point list>
Another solution, along the same lines as Kevin's
module Seq =
let chunkBy f src =
seq {
let chunk = ResizeArray()
let mutable key = Unchecked.defaultof<_>
for x in src do
let newKey = f x
if (chunk.Count <> 0) && (newKey <> key) then
yield chunk.ToArray()
chunk.Clear()
key <- newKey
chunk.Add(x)
}
// returns 2 arrays, each with 1000 elements
points |> Seq.chunkBy (fun pt -> pt.y) |> Seq.take 2
Here's a purely functional approach, which is surely slower, and much harder to understand.
module Seq =
let chunkByFold f src =
src
|> Seq.scan (fun (chunk, (key, carry)) x ->
let chunk = defaultArg carry chunk
let newKey = f x
if List.isEmpty chunk then [x], (newKey, None)
elif newKey = key then x :: chunk, (key, None)
else chunk, (newKey, Some([x]))) ([], (Unchecked.defaultof<_>, None))
|> Seq.filter (snd >> snd >> Option.isSome)
|> Seq.map fst
Lets start with the input
let count = 1000
type Point = { x : float; y: float; z: float; }
let points = seq {
for x in 1 .. count do
for y in 1 .. count do
for z in 1 .. count ->
{x = float x; y = float y; z = float z}
}
val count : int = 1000
type Point =
{x: float;
y: float;
z: float;}
val points : seq<Point>
If we try to evalute points then we get a OutOfMemoryException:
points |> Seq.toList
System.OutOfMemoryException: Exception of type 'System.OutOfMemoryException' was thrown.
at Microsoft.FSharp.Collections.FSharpList`1.Cons(T head, FSharpList`1 tail)
at Microsoft.FSharp.Collections.SeqModule.ToList[T](IEnumerable`1 source)
at <StartupCode$FSI_0011>.$FSI_0011.main#()
Stopped due to error
It might be same reason that groupBy fails, but I'm not sure. But it tells us that we have to use seq and yield to return the groups with. So we get this implementation:
let group groupBy points =
let mutable lst = [ ]
seq { for p in points do match lst with | [] -> lst <- [p] | p'::lst' when groupBy p' p -> lst <- p::lst | lst' -> lst <- [p]; yield lst' }
val group : groupBy:('a -> 'a -> bool) -> points:seq<'a> -> seq<'a list>
It is not the most easily read code. It takes each point from the points sequence and prepends it to an accumulator list while the groupBy function is satisfied. If the groupBy function is not satisfied then a new accumulator list is generated and the old one is yielded. Note that the order of the accumulator list is reversed.
Testing the function:
for g in group (fun p' p -> p'.x = p.x ) points do
printfn "%f %i" g.[0].x g.Length
Terminates nicely (after some time).
Other implementation with bug fix and better formatting.
let group (groupBy : 'a -> 'b when 'b : equality) points =
let mutable lst = []
seq {
yield! seq {
for p in points do
match lst with
| [] -> lst <- [ p ]
| p' :: lst' when (groupBy p') = (groupBy p) -> lst <- p :: lst
| lst' ->
lst <- [ p ]
yield (groupBy lst'.Head, lst')
}
yield (groupBy lst.Head, lst)
}
Seems there is no one line purely functional solution or already defined Seq method which I have overseen.
Therefore as an alternative here my own imperative solution. Comparable to #Kevin's answer but actually satisfies more my need. The ref cell contains:
The group key, which is calculated just once for each row
The current chunk list (could be seq to be conform to Seq.groupBy), which contains the elements in the input order for which the f(x) equals to the sored group key (requires equality).
.
let splitByChanged f xs =
let acc = ref (None,[])
seq {
for x in xs do
match !acc with
| None,_ ->
acc := Some (f x),[x]
| Some key, chunk when key = f x ->
acc := Some key, x::chunk
| Some key, chunk ->
let group = chunk |> Seq.toList |> List.rev
yield key, group
acc := Some (f x),[x]
match !acc with
| None,_ -> ()
| Some key,chunk ->
let group = chunk |> Seq.toList |> List.rev
yield key, group
}
points |> splitByChanged (fun point -> point.x)
The function has the following signature:
val splitByChanged :
f:('a -> 'b) -> xs:seq<'a> -> seq<'b * 'a list> when 'b : equality
Correctures and even better solutions are welcome

'where' inside other expression

I can use let inside other expression.
foo n = (let a = True in (\x -> a)) 3
foo' n | n == 1 = let a = True in a
| n /= 1 = False
But I can't do the same with where
foo n = ((\x -> a) where a = True) 3
foo' n | n == 1 = a where a = True
| n /= 1 = False
1:20: parse error on input `where'
Is it really impossible in haskell or just my mistake?
let is an expression while where is a clause. where is bound to syntactic constructs, let can be used anywhere expressions can.
You could of course write it like this:
foo n = ((\x -> a)) 3 where a = True
foo' n | n == 1 = a
| n /= 1 = False
where a = True
or like this:
foo n = (\a -> (\x -> a) 3) True
You need to put the where clause at the end:
foo n = ((\x -> a)) 3
where a = True
foo' n | n == 1 = a
| n /= 1 = False
where a = True
The difference is that let is an expression, whereas where requires some other construct to be bound to. See let vs where
let ... in ... is for introducing name bindings in an expression.
where is convenience syntax for giving local auxiliary definitions along with an equation. You can only use it as part of an equation (at the end), not in the middle of an arbitrary expression.
Their usage is not the same.
The claim that let is an expression is a bit off, it seems to me; in a do block it is a statement, though we say that there it abbreviates let ... in. The thing to say, I think, is
let_in_ :: Statement -> Expression -> Expression
_where_ :: Statement -> Statement -> Statement
Thus the first part of a let is a statement and can be modified by a where. So for example
foo n = (let a = b where b = True in (\x -> a)) 3
bip = do
let a = b where b = let c = d where d = True in c
return a
Similarly we can maybe say something like this:
case_of_ :: Expression -> [Statement] -> Expression
so that e.g.
z x = case even x of
True -> d where d = x + 1
False -> w - 1 where w = let a = x in a + 1

Resources