I am trying to write a generalised condition evaluator, similar to what the Lisp/Scheme people call cond, using quotations because they are the easiest way to get call-by-name semantics. I'm having trouble pattern-matching against the list cons operation, and can't seem to find out exactly how to represent it. Here's what I have so far:
open FSharp.Quotations.Evaluator
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
let rec cond = function
| NewUnionCase (Cons, [NewTuple [condition; value]; tail]) ->
if QuotationEvaluator.Evaluate <| Expr.Cast(condition)
then QuotationEvaluator.Evaluate <| Expr.Cast(value)
else cond tail
| _ -> raise <| MatchFailureException ("cond", 0, 0
The problem is with the Cons identifier in the first branch of the pattern match--it doesn't exist, and I can't figure out how to represent the list :: data constructor.
What is the correct way to pattern match against the list cons data constructor?
I don't think there is any easy way of writing Cons in the pattern directly, but you can use when clause to check whether the union case is a case named "Cons" of the list<T> type:
let rec cond = function
| NewUnionCase (c, [NewTuple [condition; value]; tail])
when c.Name = "Cons" && c.DeclaringType.IsGenericType &&
c.DeclaringType.GetGenericTypeDefinition() = typedefof<_ list> ->
Some(condition, value, tail)
| _ ->
None
Related
I created a nested Discriminated Union (DU) as follows:
type OptimizationPeriod = | All
| Long
| Short
type OptimizationCriterion = | SharpeRatio of OptimizationPeriod
| InformationRatio of OptimizationPeriod
| CalmarRatio of OptimizationPeriod
and also a non-nested DU:
type Parallelism = Sequential | PSeq
I have a JSON configuration file with strings that define the DU cases. The following function manages to identify the case of the non-nested Parallelism DU :
let stringToDUCase<'t> (name: string) : 't =
let dUCase =
Reflection.FSharpType.GetUnionCases( typeof<'t> )
|> Seq.tryFind (fun uc -> uc.Name = name)
|> Option.map (fun uc -> Reflection.FSharpValue.MakeUnion( uc, [||] ) :?> 't)
match dUCase with
| Some x -> x
| _ -> let msg = sprintf "config.json - %s is not a case in DU %A" name typeof<'t>
failwith msg
Note: I certainly copied it from somewhere as the function is a bit over my head, apologies to the author for not remembering where it came from.
Unfortunately this function fails to identify the case for the nested DU:
stringToDUCase<OptimizationCriterion> config.Trading.Criterion
System.Exception: config.json - SharpeRatio All is not a case in DU FractalTypes.OptimizationCriterion
Two questions:
1) I was able to write a function that deals specifically with the OptimizationCriterion DU and is able to identify the case. Is there a generic function along the lines of stringToDUCase that could do the same?
2) Would it be better to use a tuple of type OptimizationCriterion*OptimizationPeriod instead of a nested DU? (I probably would have to call stringToDUCase twice, but that is not a problem)
An "empty" DU case like All is just a value, but a "non-empty" DU case like SharpeRatio is actually a function that takes one value and returns the type. In this case, SharpeRatio has the type OptimizationPeriod -> OptimizationCriterion.
Your existing stringToDUCase function always passes an empty array into MakeUnion (implying an empty DU case). So here's a modified version of the function that works for any DU case:
let stringToParamDUCase<'t> (name: string) =
Reflection.FSharpType.GetUnionCases(typeof<'t>)
|> Seq.tryFind (fun uc -> uc.Name = name)
|> Option.map (fun uc ->
fun (parameters:obj []) -> Reflection.FSharpValue.MakeUnion(uc, parameters) :?> 't)
|> Option.defaultWith (fun () ->
failwith (sprintf "config.json - %s is not a case in DU %A" name typeof<'t>))
Note that it returns a function of obj [] -> 't. I've also simplified the error handling a little bit.
This is how you might use it:
let myOptimizationPeriod = stringToParamDUCase<OptimizationPeriod> "All" [||]
let f = stringToParamDUCase<OptimizationCriterion> "SharpeRatio"
let myOptimizationCriterion = f [|All|]
I think the existing answer should answer your question directly. However, I think it is worth making two additional points. First, it might be easier if you represented your OptimizationCriterion as a record, because all your DU cases contain the same value:
type OptimizationPeriod =
| All | Long | Short
type OptimizationRatio =
| SharpeRatio | InformationRatio | CalmanRatio
type OptimizationCriterion =
{ Ratio : OptimizationRatio
Period : OptimizationPeriod }
This happens to solve your problem too, because now you only need DUs without parameters, but I think it is also better design, because you avoid duplicating the second parameter.
Second, I don't think you really need to go with a fancy custom reflection-based function for deserialization. If you want to store your data in a JSON, you should either use standard library (Newtonsoft.JSON or Chiron will do just fine), or you can write this directly using something like JsonValue from F# Data, but using custom reflection code is a quick way leading to unmaintainable code.
Suppose I have a DU like so:
type DU = Number of int | Word of string
And suppose I create a list of them:
[Number(1); Word("abc"); Number(2)]
How can I write a function that would return true for a list of DUs where all the elements are the same case. For the above list it should return false.
The general approach I'd use here would be to map the union values into tags identifying the cases, and then check if the resulting set of tags has at most one element.
let allTheSameCase (tagger: 'a -> int) (coll: #seq<'a>) =
let cases =
coll
|> Seq.map tagger
|> Set.ofSeq
Set.count cases <= 1
For the tagger function, you can assign the tags by hand:
allTheSameCase (function Number _ -> 0 | Word _ -> 1) lst
or use reflection (note that you might need to set binding flags as necessary):
open Microsoft.FSharp.Reflection
let reflectionTagger (case: obj) =
let typ = case.GetType()
if FSharpType.IsUnion(typ)
then
let info, _ = FSharpValue.GetUnionFields(case, typ)
info.Tag
else -1 // or fail, depending what makes sense in the context.
In case you wanted to check that the elements of a list are of a specific union case, it's straightforward to provide a predicate function.
let isNumbers = List.forall (function Number _ -> true | _ -> false)
If you do not care which union case, as long as they are all the same, you need to spell them all out explicitly. Barring reflection magic to get a property not exposed inside F#, you also need to assign some value to each case. To avoid having to think up arbitrary values, we can employ an active pattern which maps to a different DU behind the scenes.
let (|IsNumber|IsWord|) = function
| Number _ -> IsNumber
| Word _ -> IsWord
let isSameCase src =
src |> Seq.groupBy (|IsNumber|IsWord|) |> Seq.length <= 1
I had the exact same use case recently and the solution can be done much simpler than complicated reflections or explicit pattern matching, GetType does all the magic:
let AreAllElementsOfTheSameType seq = // seq<'a> -> bool
if Seq.isEmpty seq then true else
let t = (Seq.head seq).GetType ()
seq |> Seq.forall (fun e -> (e.GetType ()) = t)
I'm trying to create a Monadic parser using uu_parsinglib. I thought I had it covered, but I'm getting some unexpected results in testing
A cut down example of my parser is:
pType :: Parser ASTType
pType = addLength 0 $
do (Amb n_list) <- pName
let r_list = filter attributeFilter n_list
case r_list of
(ASTName_IdName a : [] ) -> return (ASTType a)
(ASTName_TypeName a : [] ) -> return (ASTType a)
_ -> pFail
where nameFilter :: ASTName' -> Bool
nameFilter a =
case a of
(ASTName_IDName _) -> True
(ASTName_TypeName _) -> True
_ -> False
data ASTType = ASTType ASTName
data ASTName = Amb [ASTName']
data ASTName' =
ASTName_IDName ASTName
ASTName_TypeName ASTName
ASTName_OtherName ASTName
ASTName_Simple String
pName is an ambiguous parser. What I want type parser to do is apply a post filter, and return all alternatives that satisfy nameFilter, wrapped as ASTType.
If there are none, it should fail.
(I realise the example I've given will fail if there is more than one valid match in the list, but the example serves its purpose)
Now, this all works as far as I can see. The problem lies when you use it in more complicated Grammars, where odd matches seem to occur. What I suspect is the problem is the addLength 0 part
What I would like to do is separate out the monadic and applicative parts. Create a monadic parser with the filtering component, and then apply pName using the <**> operator.
Alternatively
I'd settle for a really good explanation of what addLength is doing.
I've put together a fudge/workaround to use for monadic parsing with uu-parsinglib. The only way I ever use Monadic parsers is to analysis a overly generous initial parser, and selectively fail its results.
bind' :: Parser a -> (a -> Parser b) -> Parser b
bind' a#(P _ _ _ l') b = let (P t nep e _) = (a >>= b) in P t nep e l'
The important thing to remember when using this parser is that
a -> M b
must consume no input. It must either return a transformed version of a, or fail.
WARNING
Testing on this is only minimal currently, and its behaviour is not enforced by type. It is a fudge.
I am trying to write a code to remove stopwords like "the", "this" in a string list etc.
I wrote this code:
let rec public stopword (a : string list, b :string list) =
match [a.Head] with
|["the"]|["this"] -> stopword (a.Tail, b)
|[] -> b
|_ -> stopword (a.Tail, b#[a.Head])
I ran this in the interactive:
stopword (["this";"is";"the"], []);;
I got this error:
This expression was expected to have type string list but here has type 'a * 'b
Match expressions in F# are very powerful, although the syntax is confusing at first
You need to match the list like so:
let rec stopword a =
match a with
|"the"::t |"this"::t -> stopword t
|h::t ->h::(stopword t)
|[] -> []
The actual error is due to the function expecting a tuple argument. You would have to call the function with:
let result = stopword (["this";"is";"the"], [])
Edit: since the original question was changed, the above answer is not valid anymore; the logical error in the actual function is that you end up with a single element list of which the tail is taken, resulting in an empty list. On the next recursive call the function chokes on trying to get the head of this empty list
The function in itself is not correctly implemented though and much more complicated than necessary.
let isNoStopword (word:string) =
match word with
| "the"|"this" -> false
| _ -> true
let removeStopword (a : string list) =
a |> List.filter(isNoStopword)
let test = removeStopword ["this";"is";"the"]
Others have mentioned the power of pattern matching in this case. In practice, you usually have a set of stopwords you want to remove. And the when guard allows us to pattern match quite naturally:
let rec removeStopwords (stopwords: Set<string>) = function
| x::xs when Set.contains x stopwords -> removeStopwords stopwords xs
| x::xs -> x::(removeStopwords stopwords xs)
| [] -> []
The problem with this function and #John's answer is that they are not tail-recursive. They run out of stack on a long list consisting of a few stopwords. It's a good idea to use high-order functions in List module which are tail-recursive:
let removeStopwords (stopwords: Set<string>) xs =
xs |> List.filter (stopwords.Contains >> not)
On my journey to learning F#, I've run into a problem I cant solve. I have defined a custom type:
type BinTree =
| Node of int * BinTree * BinTree
| Empty
I have made a function which takes a tree, traverses it, and adds the elements it visits to a list, and returns it:
let rec inOrder tree =
seq{
match tree with
| Node (data, left, right) ->
yield! inOrder left
yield data;
yield! inOrder right
| Empty -> ()
}
|> Seq.to_list;
Now I want to create a function, similar to this, which takes a tree and a function, traverses it and applies a function to each node, then returns the tree:
mapInOrder : ('a -> 'b) -> 'a BinTree -> 'b BinTree
This seems easy, and it probably is! But I'm not sure how to return the tree. I've tried this:
let rec mapInOrder f tree =
match tree with
| Node(data, left, right) ->
mapInOrder f left
Node(f(data), left, right)
mapInOrder f right
| Empty -> ()
but this returns a unit. I havent worked with custom types before, so I'm probably missing something there!
Try this:
let rec mapInOrder f = function
| Node(a,l,r) ->
let newL = mapInOrder f l
let b = f a
let newR = mapInOrder f r
Node(b,newL,newR)
| Empty -> Empty
If the function is side-effect free, then traversal order is unimportant and you can instead write:
let rec map f = function
| Node(a,l,r) -> Node(f a, map f l, map f r)
| Empty -> Empty
A match is an expression. It returns the value of the matching case. That implies that all match cases must have the same type. The match expression itself then has that type.
In your first attempt, your Empty clause returned (), and thus had unit type--not the tree type you were looking for.
Since mapInOrder just returns the match result, it too took on unit return type.
The Node clause was fine because its return value is the result of calling mapInOrder, so it also took on unit type and the requirement that all match clauses have the same type was satisfied.
A key change in kvb's suggestion was making the Empty clause return a tree instead of unit. Once you do that, you get compiler errors and warnings pointing to the other problems.
You can often work through issues like this by explicitly coding the type you'd like, and then seeing where the compile errors and warnings show up.