I am trying to generalize the concept of a Set in F#. Among other things I want to define sets using inequalities. This would help me simplifying some sections of my code. So I created a type MySet as follows:
type Comparison = | GE
| GT
| LE
| LT
| EQ
type ComparisonOps<'t> = { gt: 't->'t->bool
ge: 't->'t->bool
eq: 't->'t->bool
le: 't->'t->bool
lt: 't->'t->bool }
type MySet<'t when 't : comparison> =
| List of list<'t>
| Sequence of seq<'t>
| Array of 't []
| String of string
| Set of Set<'t>
| Compare of (ComparisonOps<'t>*Comparison*'t)
Note: I intend to make MySet recursive later, allowing for unions and intersections, but for the purposes of this question this is not necessary.
The whole point of the new MySet type is to allow checking if elements of different types belong to sets of different cases. This is implemented by this function:
let elementOf<'t when 't : comparison> (st: MySet<'t>) (x: 't) : bool =
match st with
| List xs -> List.contains x xs
| Sequence s -> Seq.contains x s
| Array a -> Array.contains x a
| Set st -> Set.contains x st
| String str -> match box str with
| :? string as s -> match box x with
| :? string as z -> s.Contains z
| _ -> false
| _ -> false
| Compare (comp: ComparisonOps<'t>*Comparison*'t) ->
let compOps, cmp, y = comp
match cmp with
| GT -> compOps.gt x y
| GE -> compOps.ge x y
| EQ -> compOps.eq x y
| LE -> compOps.le x y
| LT -> compOps.lt x y
Note: I also plan to generalize elementOf allowing for function application, but again this is not needed here.
The function works:
let myStringSet = MySet.String("XYZ")
let strb = "X" |> elementOf<string> myStringSet
printfn "strb = %b" strb // strb = true
let myListSet = MySet.List([0..10])
let listb = 5 |> elementOf<int> myListSet
printfn "listb = %b" listb // listb = true
let myCompSet = MySet.Compare((ComparisonFloat, GT, 0.0))
let compb = -1.0 |> elementOf<float> myCompSet
printfn "compb = %b" compb // compb = false
let myCompSet2 = MySet.Compare((ComparisonString, LT, "XYZ"))
let compb2 = "XA" |> elementOf<string> myCompSet2
printfn "compb2 = %b" compb2 // compb2 = true
That is great, but I wonder if I really need to create the dictionary of operations ComparisonOps, since operations like < are polymorphic on the types int, float and string anyway.
Eliminating ComparisonOps could considerably simplify the code. Is that possible?
As Fyodor Soikin notes, it sounds like maybe what you want is to define a set as all elements satisfying a predicate:
type MySet<'t> = | MySet of ('t -> bool)
Then set operations are easy to define:
let intersect (MySet p1) (MySet p2) = MySet(fun t -> p1 t && p2 t)
And all of your specific constructors can just be turned into simple functions:
let ofList l = MySet(fun t -> List.contains t l)
let lt x = MySet(fun t -> t < x)
Related
I'm looking for a standard F# function that takes a sequence of 2-choices and returns a pair of sequences:
let separate (choices : seq<Choice<'T1, 'T2>>) : seq<'T1> * seq<'T2> = ...
A naive implementation is pretty simple:
let separate choices =
let ones =
choices
|> Seq.choose (function
| Choice1Of2 one -> Some one
| _ -> None)
let twos =
choices
|> Seq.choose (function
| Choice2Of2 two -> Some two
| _ -> None)
ones, twos
This works fine, but iterates the sequence twice, which is less than ideal. Is this function defined in one of the semi-standard libraries? I looked around, but couldn't find it. (If it exists, I'm sure it goes by some other name.)
For bonus points, versions that work with 3-choices, 4-choices, and so on, would also be nice, as would versions for List, Array, etc. Thanks.
I can't find builtin implementation but can write my own.
It uses IEnumerator<> based approach, so it will work with any collection type but it's not optimal (e.g. arrays will work slower than could be). Order is reversed (easy to fix with ResizeArray but more code). Also this version is not lazy, but can be easily adapted to work with Choice<'a, 'b, 'c> and others
let splitChoices2 (choices: Choice<'a, 'b> seq) =
let rec inner (it: IEnumerator<_>) acc1 acc2 =
if it.MoveNext() then
match it.Current with
| Choice1Of2 c1 -> inner it (c1 :: acc1) acc2
| Choice2Of2 c2 -> inner it acc1 (c2 :: acc2)
else
acc1, acc2
inner (choices.GetEnumerator()) [] []
let choices = [
Choice1Of2 11
Choice2Of2 "12"
Choice1Of2 21
Choice2Of2 "22"
]
choices |> splitChoices2 |> printfn "%A"
Update: ResizeArray based approach without reversed order and potentially less expensive enumeration
let splitChoices2 (choices: Choice<'a, 'b> seq) =
let acc1 = ResizeArray()
let acc2 = ResizeArray()
for el in choices do
match el with
| Choice1Of2 c1 -> acc1.Add c1
| Choice2Of2 c2 -> acc2.Add c2
acc1, acc2
This is sort of inspired by TraverseA but has come out quite different. Here is a single pass solution (UPDATE: however while the core algorithm might be single pass from List to List, but getting it to match your type signature, and ordering the result the same way makes it 3*O(n), it depends how important the ordering and type signature are to you)
let choices = seq {Choice1Of2(1) ; Choice2Of2(2) ; Choice2Of2(3) ; Choice1Of2(4)}
let seperate' choices =
let rec traverse2ChoicesA tupleSeq choices =
match choices with
| [] -> fst tupleSeq |> List.rev |>Seq.ofList , snd tupleSeq |> List.rev |> Seq.ofList
| (Choice1Of2 f)::tl -> traverse2ChoicesA (f::fst tupleSeq, snd tupleSeq) tl
| (Choice2Of2 s)::tl -> traverse2ChoicesA (fst tupleSeq, s::snd tupleSeq) tl
traverse2ChoicesA ([],[]) <| List.ofSeq choices
seperate' choices;;
val seperate' : choices:seq<Choice<'a,'b>> -> seq<'a> * seq<'b>
val it : seq<int> * seq<int> = ([1; 4], [2; 3])
Update: To be clear, if ordering and List instead of Seq are ok then this is a single pass:
let choices = [Choice1Of2(1) ; Choice2Of2(2) ; Choice2Of2(3) ; Choice1Of2(4)]
let seperate' choices =
let rec traverse2ChoicesA (tupleSeq) choices =
match choices with
| [] -> tupleSeq
| (Choice1Of2 f)::tl -> traverse2ChoicesA (f :: fst tupleSeq, snd tupleSeq) tl
| (Choice2Of2 s)::tl -> traverse2ChoicesA (fst tupleSeq, s:: snd tupleSeq) tl
traverse2ChoicesA ([],[]) choices
seperate' choices;;
val choices : Choice<int,int> list =
[Choice1Of2 1; Choice2Of2 2; Choice2Of2 3; Choice1Of2 4]
val seperate' : choices:Choice<'a,'b> list -> 'a list * 'b list
val it : int list * int list = ([4; 1], [3; 2])
You might find something more general, performant and with appropriate type signature in the FSharpPlus "semi-standard" library using TraverseA?
I would like to extend the W algorithm to the inference of tuples and lists in F#, a priori, there are only two rules to add, which I did, however, the result is partially bad.
Indeed, if I test a code like these:
test = (8, "Hello", 0.3) -- test :: (TInt, TString, TFloat)
id :: a -> a
id x = x -- id :: a -> a
foo = id 8 -- foo :: TInt
it works, on the other hand, as detailed in the examples below, a code like this one will not work:
makePair = (\x -> (x, x)) -- makePair :: a -> (a, a)
pair = makePair 7
and pair will be inferred as (a, a) instead of (TInt, TInt).
Same for the lists.
I used this paper to write my type checker.
I really don't understand what's jamming.
Here is the minimum functional program used for these examples:
Inference.fs
module Typechecker
type Identifier = string
and Expr =
| Var of Identifier
| Lambda of Identifier * Expr
| Apply of Expr * Expr
| Let of Identifier * Expr * Expr
| Literal of Literal
| Tuple of Expr list
| List of Expr list
and Literal =
| Int of int
| Float of float
| String of string
and Statement =
| Signature of Identifier * Type
| Declaration of Identifier * Expr
and Type =
| TVar of Identifier
| TInt
| TFloat
| TString
| TArrow of Type * Type
| TTuple of Type list
| TList of Type
type Program = Program of Statement list
type Scheme = Scheme of string list * Type
and TypeEnv = Map<Identifier, Scheme>
and Subst = Map<string, Type>
type Env =
{ mutable _functions: Function list }
with
member this.containsFunction name =
this._functions |> List.exists (fun f -> f._name = name)
member this.getFunction name =
this._functions
|> List.find (fun (f: Function) -> f._name = name)
member this.getFunctionType name =
(this.getFunction name)._type
member this.hasFunctionImplementation name =
if this.containsFunction name
then (this.getFunction name)._value.IsSome
else false
member this.getFunctionValue name =
(this.getFunction name)._value.Value
/// Updates the value of a function in the environment
member this.updateFunction_value name value =
(this.getFunction name)._value <- Some value
this
/// Updates the type of a function in the environment
member this.updateFunction_type name ty =
(this.getFunction name)._type <- ty
this
member this.addFunction name ty value =
{ _functions =
List.append
this._functions
[{ _name = name;
_type = ty;
_value = value }] }
and Function =
{ _name: Identifier;
mutable _type: Type;
mutable _value: Expr option }
and DataType =
{ _name: Identifier;
_isAlias: bool;
_constructors: Ctor list option
_alias: Type option }
and Ctor = Term of Identifier | Product of Type list
let newEnv = { _functions = [] }
module Type =
let rec ftv = function
| TInt -> Set.empty
| TFloat -> Set.empty
| TString -> Set.empty
| TVar name -> Set.singleton name
| TArrow(t1, t2) -> Set.union (ftv t1) (ftv t2)
| TTuple ts -> List.fold (fun acc t -> Set.union acc (ftv t)) Set.empty ts
| TList t -> Set.singleton (toString t)
and apply s t =
match t with
| TVar name ->
match Map.tryFind name s with
| Some t -> t
| None -> TVar name
| TArrow (t1, t2) ->
TArrow(apply s t1, apply s t2)
| TInt | TFloat | TString -> t
| _ -> t
and parens s =
sprintf "(%s)" s
and braces s =
sprintf "{ %s }" s
and toString t =
let rec parenType t' =
match t' with
| TArrow(_, _) -> parens (toString t')
| _ -> toString t'
match t with
| TVar name -> name
| TInt -> "Integer"
| TFloat -> "Float"
| TString -> "String"
| TArrow(t1, t2) ->
(parenType t1) + " -> " + (toString t2)
| TTuple ts -> sprintf "(%s)" (System.String.Join(", ", List.map toString ts))
| TList t -> sprintf "[%s]" (toString t)
module Scheme =
let rec ftv (scheme: Scheme) =
match scheme with
| Scheme(variables, t) ->
Set.difference(Type.ftv t) (Set.ofList variables)
and apply (s: Subst) (scheme: Scheme) =
match scheme with
| Scheme(variables, t) ->
let newSubst = List.foldBack (fun key currentSubst -> Map.remove key currentSubst) variables s
let newType = Type.apply newSubst t
Scheme(variables, newType)
module TypeEnv =
let rec remove (env: TypeEnv) (var: Identifier) =
Map.remove var env
and ftv (typeEnv: TypeEnv) =
Seq.foldBack (fun (KeyValue(_, v)) state ->
Set.union state (Scheme.ftv v)) typeEnv Set.empty
and apply (s: Subst) (env: TypeEnv) =
Map.map (fun _ value -> Scheme.apply s value) env
module Subst =
let compose s1 s2 =
Map.union (Map.map (fun _ (v: Type) -> Type.apply s1 v) s2) s1
let rec generalize (env: TypeEnv) (t: Type) =
let variables =
Set.difference (Type.ftv t) (TypeEnv.ftv env)
|> Seq.toList
Scheme(variables, t)
and private currentId = ref 'a'
and nextId () =
let id = !currentId
currentId := (char ((int !currentId) + 1))
id
and resetId () = currentId := 'a'
and newTyVar () =
TVar(sprintf "%c" (nextId ()))
and instantiate (ts: Scheme) =
match ts with
| Scheme(variables, t) ->
let nvars = variables |> List.map (fun name -> newTyVar ())
let s = List.zip variables nvars |> Map.ofList
Type.apply s t
and varBind a t =
match t with
| TVar name when name = a -> Map.empty
| _ when Set.contains a (Type.ftv t) ->
failwithf "Occur check fails: `%s` vs `%s`" a (Type.toString t)
| _ -> Map.singleton a t
and unify (t1: Type) (t2: Type) : Subst =
match t1, t2 with
| TVar a, t | t, TVar a -> varBind a t
| TInt, TInt -> Map.empty
| TFloat, TFloat -> Map.empty
| TString, TString -> Map.empty
| TArrow(l, r), TArrow(l', r') ->
let s1 = unify l l'
let s2 = unify (Type.apply s1 r) (Type.apply s1 r')
Subst.compose s2 s1
| TTuple ts, TTuple ts' ->
if ts.Length <> ts'.Length
then failwithf "Types do not unify: `%s` vs `%s`" (Type.toString t1) (Type.toString t2)
else List.fold Subst.compose Map.empty (List.map2 unify ts ts')
| TList t, TList t' ->
unify t t'
| _ -> failwithf "Types do not unify: `%s` vs `%s`" (Type.toString t1) (Type.toString t2)
and tiLit = function
| Literal.Int _ -> Type.TInt
| Literal.Float _ -> Type.TFloat
| Literal.String _ -> Type.TString
and tiExpr (env: TypeEnv) (exp: Expr) : Subst * Type =
match exp with
| Var name ->
match Map.tryFind name env with
| Some sigma ->
let t = instantiate sigma
(Map.empty, t)
| None -> failwithf "Unbound variable: `%s`" name
| Literal lit -> (Map.empty, tiLit lit)
| Let(id, expr, in') ->
let s1, t1 = tiExpr env expr
let env1 = TypeEnv.remove env id
let scheme = generalize (TypeEnv.apply s1 env) t1
let env2 = Map.add id scheme env1
let s2, t2 = tiExpr (TypeEnv.apply s1 env2) in'
(Subst.compose s2 s1, t2)
| Lambda(id, value) ->
let tv = newTyVar ()
let env1 = TypeEnv.remove env id
let env2 = Map.union env1 (Map.singleton id (Scheme([], tv)))
let s1, t1 = tiExpr env2 value
(s1, TArrow(Type.apply s1 tv, t1))
| Tuple values ->
(Map.empty, TTuple(List.map (fun v -> snd (tiExpr env v)) values))
| List ts ->
let tv = newTyVar ()
if ts.IsEmpty
then (Map.empty, TList tv)
else
let _, t1 = tiExpr env ts.[0]
if List.forall (fun t -> snd (tiExpr env t) = t1) ts
then (Map.empty, TList t1)
else failwith "Not all items in the list are of the same type"
| Apply(e1, e2) ->
let s1, t1 = tiExpr env e1
let s2, t2 = tiExpr (TypeEnv.apply s1 env) e2
let tv = newTyVar ()
let s3 = unify (Type.apply s2 t1) (TArrow(t2, tv))
(Subst.compose (Subst.compose s3 s2) s1, Type.apply s3 tv)
and expression_typeInference env exp =
let s, t = tiExpr env exp
Type.apply s t
and updateExprEnv (env: Env) =
let mutable env' = Map.empty
List.iter
(fun (f: Function) ->
env' <- env'.Add(f._name, Scheme([f._name], f._type))
) env._functions
env'
let rec public statement_typecheck (env: Env) stmt =
let exprEnv = updateExprEnv env
match stmt with
| Signature(id, dastType) ->
typecheck_signature env id dastType
| Declaration(id, value) ->
typecheck_decl env id value exprEnv
and private typecheck_signature (env: Env) id ty =
if env.hasFunctionImplementation id
then failwithf "The type of a function cannot be defined after its implementation (`%s`)" id
else env.addFunction id ty None
and private typecheck_decl (env: Env) id value exprEnv =
let _, t_exp = tiExpr exprEnv value
if env.containsFunction id
then if env.hasFunctionImplementation id
then failwithf "Already declared function: `%s`" id
else
let t_sgn = (env.getFunction id)._type
let unapp = try (Type.apply ((unify t_sgn t_exp)) t_exp)
|> Ok with exn -> failwithf "%s" exn.Message
if match unapp with Result.Ok _ -> true
then env.updateFunction_value id value
else failwithf "The signature of `%s` is different than the type of its value\n (`%s` vs `%s`)"
id (Type.toString t_sgn) (Type.toString t_exp)
else env.addFunction id t_exp (Some value)
let typecheck_document (document: Program) =
let mutable docenv = newEnv
match document with Program stmts ->
List.iter (fun stmt -> docenv <- statement_typecheck docenv stmt) stmts
docenv
Main.fs
module Main
open Inference
[<EntryPoint>]
let main _ =
let test1 =
[Declaration("makePair", Lambda("x", Tuple([Var "x"; Var "x"]))); // makePair = (\x -> (x, x))
Declaration("pair", Apply(Var "makePair", Literal (Int 7)))] // pair = makePair 7
let infer1 = typecheck_document (Program test1)
printfn "Env1: %A" infer1
let test2 =
[Signature("id", TArrow(TVar "a", TVar "a")); // id :: a -> a
Declaration("id", Lambda("x", Var "x")) // id x = x
Declaration("foo", Apply(Var "id", Literal (Int 7)))] // foo = id 7
let infer2 = typecheck_document (Program test2)
printfn "Env2: %A" infer2
0
Here is the output:
Env1: {_functions =
[{_name = "makePair";
_type = TArrow (TVar "a",TTuple [TVar "a"; TVar "a"]);
_value = Some (Lambda ("x",Tuple [Var "x"; Var "x"]));};
{_name = "pair";
_type = TTuple [TVar "a"; TVar "a"];
_value = Some (Apply (Var "makePair",Literal (Int 7)));}];}
Env2: {_functions =
[{_name = "id";
_type = TArrow (TVar "a",TVar "a");
_value = Some (Lambda ("x",Var "x"));};
{_name = "test";
_type = TInt;
_value = Some (Apply (Var "id",Literal (Int 7)));}];}
So we can see that the inference works correctly for the first test, but not for the second (as shown above).
I would like to solve and understand this bug, and I thank you in advance for your help.
As far as I read in your code, it seems like you're missing a branch in apply.
Indeed, when t is a Tuple [], you're basically only returning it...which well will of course not work. :)
I suggest adding one branch to the match, with t as a Tuple types, with a map (\t -> apply s t) types (sorry, I don't know much F# syntax).
Hope it helps. :)
I have many programs written in OCaml, some of them use functors. Now, I am considering of writing and re-writing a part of code in F# (to benefit some advantages that OCaml does not have). One thing I am afraid of is to write code in F# for what functors do in OCaml.
For instance, how could we emulate this example from OCaml manual in F#?
type comparison = Less | Equal | Greater
module type ORDERED_TYPE = sig
type t
val compare: t -> t -> comparison
end
module Set =
functor (Elt: ORDERED_TYPE) -> struct
type element = Elt.t
type set = element list
let empty = []
let rec add x s =
match s with
[] -> [x]
| hd::tl ->
match Elt.compare x hd with
Equal -> s (* x is already in s *)
| Less -> x :: s (* x is smaller than all elements of s *)
| Greater -> hd :: add x tl
end
module OrderedString = struct
type t = string
let compare x y = if x = y then Equal else if x < y then Less else Greater
end
module OrderedInt = struct
type t = int
let compare x y = if x = y then Equal else if x < y then Less else Greater
end
module StringSet = Set(OrderedString)
module IntSet = Set(OrderedInt)
let try1 () = StringSet.add "foo" StringSet.empty
let try2 () = IntSet.add 2 IntSet.empty
Here is a bit different approach that achieves same outcome using a generic class and one object per type.
type Comparison = Less | Equal | Greater
type Set<'a>(compare : 'a -> 'a -> Comparison) =
member this.Empty : 'a list = []
member this.Add x s =
match s with
| [] -> [x]
| hd::tl ->
match compare x hd with
| Equal -> s (* x is already in s *)
| Less -> x :: s (* x is smaller than all elements of s *)
| Greater -> hd :: this.Add x tl
let compare x y = if x = y then Equal else if x < y then Less else Greater
let compareFloats (x : float) (y : float) = if x = y then Equal else if x < y then Less else Greater
// Note that same generic compare function can be used for stringSet and intSet
// as long as the type parameter is explicitly given
let stringSet = Set<string>(compare)
let intSet = Set<int>(compare)
// Type parameter not needed, because compareFloats is not generic
let floatSet = Set(compareFloats)
let try1 () = stringSet.Add "foo" stringSet.Empty // -> ["foo"]
let try2 () = intSet.Add 2 intSet.Empty // -> [2]
let try3 () = floatSet.Add 3.0 floatSet.Empty // -> [3.0]
As you noticed, F# doesn't have functors - F# modules cannot be parameterized by types. You can get similar results in F# using the object oriented parts of the language - interfaces, generic classes and inheritance.
Here's a heavy handed approach at emulating your example.
type Comparison = Less | Equal | Greater
/// Interface corresponding to ORDERED_TYPE signature
type IOrderedType<'a> =
abstract Value: 'a
abstract Compare: IOrderedType<'a> -> Comparison
/// Type that implements ORDERED_TYPE signature, different instantiations
/// of this type correspond to your OrderedInt/OrderedString modules.
/// The 't: comparison constraint comes from the fact that (<) operator
/// is used in the body of Compare.
type Ordered<'t when 't: comparison> (t: 't) =
interface IOrderedType<'t> with
member this.Value = t
member this.Compare (other: IOrderedType<'t>) =
if t = other.Value then Equal else if t < other.Value then Less else Greater
/// A generic type that works over instances of IOrderedType interface.
type Set<'t, 'ot when 't: comparison and 'ot :> IOrderedType<'t>> (coll: IOrderedType<'t> list) =
member this.Values =
coll |> List.map (fun x -> x.Value)
member this.Add(x: 't) =
let rec add (x: IOrderedType<'t>) s =
match coll with
| [] -> [x]
| hd::tl ->
match x.Compare(hd) with
| Equal -> s (* x is already in s *)
| Less -> x :: s (* x is smaller than all elements of s *)
| Greater -> hd :: add x tl
Set<'t, 'ot>(add (Ordered(x)) coll)
static member Empty = Set<'t, 'ot>(List.empty)
/// A helper function for Set.Add. Useful in pipelines.
module Set =
let add x (s: Set<_,_>) =
s.Add(x)
/// Type aliases for different instantiations of Set
/// (these could have easily been subtypes of Set as well)
type StringSet = Set<string, Ordered<string>>
type IntSet = Set<int, Ordered<int>>
let try1 () = Set.add "foo" StringSet.Empty
let try2 () = Set.add 2 IntSet.Empty
try1().Values
try2().Values
The functional way in F# would rely mostly on type inference avoiding OOP structures like interface or types with member.
type Comparison = Less | Equal | Greater
type OrderedSet<'t> = 't list // type alias, not really necessary
module OrderedSet =
let empty : OrderedSet<_> = List.empty // just an empty list
let values (s : OrderedSet<_>) : OrderedSet<_> = s // identity function
let add compare x (s : OrderedSet<_>) : OrderedSet<_> =
let rec addR s =
match s with
| [] -> [x]
| hd::tl ->
match compare x hd with
| Equal -> s (* x is already in s *)
| Less -> x :: s (* x is smaller than all elements of s *)
| Greater -> hd :: addR tl
addR s
let compare x y = if x = y then Equal else if x < y then Less else Greater
let compareFloats (x : float) y = if x = y then Equal else if x < y then Less else Greater
let addGeneric v = add compare v
let addFloat v = add compareFloats v
And it is used like this:
let try1 () = OrderedSet.addGeneric "foo" OrderedSet.empty |> OrderedSet.addGeneric "bar"
let try2 () = OrderedSet.addGeneric 2 OrderedSet.empty |> OrderedSet.addGeneric 3
let try3 () = OrderedSet.empty
|> OrderedSet.addFloat 3.0
|> OrderedSet.addFloat 1.0
|> OrderedSet.addFloat 2.0
try1() |> printfn "%A" // OrderedSet<string> = ["bar"; "foo"]
try2() |> printfn "%A" // OrderedSet<int> = [2; 3]
try3() |> printfn "%A" // OrderedSet<float> = [1.0; 2.0; 3.0]
The type alias type OrderedSet<'t> = 't list and the functions empty and values are not really necessary but they help to mask the actual implementation (in case that is desirable).
I need to check if a list starts with another, shorter list. The function, when using when guards is trivial:
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| x::xs, y::ys when x = y -> startsWith xs ys
| _ -> false
let lst1 = [ 1; 2; 1 ]
let lst2 = [ 1; 2; 1; 2; 3; ]
let lst3 = [ 1; 3; 1; 2; 3; ]
let c1 = startsWith lst1 lst2 // true
let c2 = startsWith lst1 lst3 // false
But whatever I tried along the lines of an Active Pattern:
let (|HeadsMatch|) (l1 : ('a) list) (l2 : ('a) list) =
if l1.Head = l2.Head then Some(l1.Tail, l2.Tail) else None
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| HeadsMatch /* need to capture the result */ -> startsWith t1 t2
| _ -> false
I could not make to compile. How to make a version of this function using Active pattern? And if this is not possible, can you explain why?
P.S. Any other nice ways to write the above function?
EDIT: I took the snippet from Daniel's answer to not distract from the real question.
EDIT: My problems started in the beginning. I have defined the active pattern function as
let (|HeadsMatch|_|) lst1 lst2 =
but it should have been
let (|HeadsMatch|_|) (lst1, lst2) =
In which case it would match as in the accepted answer.
I suppose the nicest way might be
let startsWith = Seq.forall2 (=)
If you want to write it from scratch, you need to match on both lists:
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| x::xs, y::ys when x = y -> startsWith xs ys
| _ -> false
If you want to write it with an active pattern for learning purposes, using Tarmil's definition it would be
let rec startsWith l1 l2 =
match l1, l2 with
| [], _ | _, [] -> true
| HeadsMatch(xs, ys) -> startsWith xs ys
| _ -> false
There are two errors in the definition of your active pattern:
It's a partial active pattern (since it is possible that it doesn't match) so the syntax is (|HeadsMatch|_|).
You need to take the two lists as a pair, since you want to match lst1, lst2.
With these, the code will compile. But it will throw an exception at runtime, because you use .Head and .Tail on lists when you don't know if they have any element; you're not defining the behavior if one of the lists is empty.
Here is an idiomatic implementation of HeadsMatch:
let (|HeadsMatch|_|) (lst1, lst2) =
match (lst1, lst2) with
| (x :: xs, y :: ys) when x = y -> Some (xs, ys)
| _ -> None
Without guard:
let (|HeadsMatch|_|) (lst1, lst2) =
match (lst1, lst2) with
| (x :: xs, y :: ys) ->
if x = y then Some (xs, ys) else None
| _ -> None
As a side-note, your first implementation has the same problem. The following will throw a runtime exception:
startsWith [1;2] [1]
because you don't check that lst2 is not empty before using .Head and .Tail on it. In general, you should avoid these two methods almost all the time.
I am having trouble groking F#'s Map class. I created a simple, naive lambda calculus evaluation function,
type Name = string
type Term =
| Var of Name
| Lit of int
| App of Term * Term
| Lam of Name * Term
let rec lookup(v, e) =
match e with
| (v1, t)::tl -> if v1 = v then t else lookup(v, tl)
| [] -> failwith "unknown variable %s" v
let rec eval(x, e) =
match x with
| Var x -> lookup(x, e)
| Lit x -> Lit x
| App (Lam(v, f), t2) -> eval(f, ((v, t2)::e))
| _ -> failwith "Invalid"
The obvious optimization to this is to change the list to a Map so I came up with,
let rec eval2(x, e: Map<Name,Term>) =
match x with
| Var v -> e.[v]
| Lit l -> x
| App (Lam (v, f), t) -> eval2(f, e.Add(v, t))
| _ -> failwith "Invalid term"
Given the values,
let ident = Lam ("x", Var "x")
let prog = App (ident, Lit 3)
why does,
let x = eval(prog, [])
succeed but,
let x2 = eval2(prog, Map [])
throw a key not found exception?
I don't repro this behavior (using F# 1.9.6.2, it works for me):
#light
type Name = string
type Term =
| Var of Name
| Lit of int
| App of Term * Term
| Lam of Name * Term
let rec eval2(x, e: Map<Name,Term>) =
match x with
| Var v -> e.[v]
| Lit l -> x
| App (Lam (v, f), t) -> eval2(f, e.Add(v, t))
| _ -> failwith "Invalid term"
let ident = Lam ("x", Var "x")
let prog = App (ident, Lit 3)
let x2 = eval2(prog, Map [])
printfn "%A" x2 // Lit 3