Colouring problem :
Hello, I'm trying to implement a bool function that returns true when a color can be extended to a country and false otherwise but I'm having trouble working with sets as we cannot pattern match them...
My code :
type Country = string;;
type Chart = Set<Country*Country>;;
type Colour = Set<Country>;;
type Colouring = Set<Colour>;;
(* This is how you tell that two countries are neghbours. It requires a chart.*)
let areNeighbours ct1 ct2 chart =
Set.contains (ct1,ct2) chart || Set.contains (ct2,ct1) chart;;
(* val areNeighbours :
ct1:'a -> ct2:'a -> chart:Set<'a * 'a> -> bool when 'a : comparison
*)
(* The colour col can be extended by the country ct when they are no neighbours
according to chart.*)
let canBeExtBy (col:Colouring) (ct:Country) (chart:Chart) = col |> Set.fold (fun x -> (if (areNeighbours x ct chart) then true else false))
What is expected : we need to check if ct is a neighbour of any country in the col (assuming there are countries in the col), according to the neighbourhood defined in the chart.
So if
chart = set
[("Andorra", "Benin"); ("Andorra", "Canada"); ("Andorra", "Denmark");
("Benin", "Canada"); ("Benin", "Denmark"); ("Canada", "Denmark");
("Estonia", "Canada"); ("Estonia", "Denmark"); ("Estonia", "Finland");
...]
And
col = set
["Andorra"]
Then canBeExt should return false when when ct = "Benin" or "Canada" or "Denmark" etc... As Andorra share a border with those countries and thus they cannot be coloured in the same colour as Andora.
Obviously I have a type error in canBeExtBy as I'm trying to return a bool and it's expecting 'a:Colouring.
I don't know how to implement it..
Thanks for your help !
What about this?
type Country = string
type Neighbours = Set<Country*Country>
type SharesColour = Set<Country>
let areNeighbours (ns : Neighbours) (ct1 : Country) (ct2 : Country) : bool =
Set.contains (ct1,ct2) ns || Set.contains (ct2,ct1) ns
let canShareColour (ns : Neighbours) (ct : Country) (s : SharesColour) : bool =
s |> Seq.exists (areNeighbours ns ct) |> not
let neighbours : Neighbours =
set [|
("Andorra", "Benin") ; ("Andorra", "Canada") ; ("Andorra", "Denmark");
("Benin" , "Canada") ; ("Benin" , "Denmark"); ("Canada" , "Denmark");
("Estonia", "Canada") ; ("Estonia", "Denmark"); ("Estonia", "Finland");
|]
let sharesColour : SharesColour =
set [|
"Andorra"
|]
[<EntryPoint>]
let main argv =
printfn "%A" <| canShareColour neighbours "Estonia" sharesColour
printfn "%A" <| canShareColour neighbours "Benin" sharesColour
0
Changed the names to something that made more sense to me. You might not agree.
To check that no element in a collection satisfies a given condition: that's not a job for fold, but, with appropriate negation, for exists or forall.
Either of
let fornone f = Set.forall (f >> not)
let doesnotexist f = Set.exists f >> not
will do, as shown in the answer of FuleSnabel. However, it is certainly possible to build these functions from a fold, albeit nobody would do that except as an illustration of currying, function composition and pointfree style.
let fornone f = Set.fold (fun s -> f >> not >> (&&) s) true
let doesnotexist f = Set.fold (fun s -> f >> (||) s) false >> not
Related
In this program , I wanted to ask the user about number of cards and draw that number of cards from a deck (see below) and tell the user the cards and the
"total" of those cards. In this case, I mean a blackjack count of up to 21, with
counts over 21 returning Nothing. A blackjack count counts 2-10 as its face value, jacks,
queens and kings count as 10 and aces count as 1 or 11. I need two functions:
drawHand :: Int ->Deck ->([Card],Deck) and totalCards :: [Card] ->Maybe Int
import Data.List
import Data.Random
drawHand :: Int -> Deck -> ([Card], Deck)
totalCards :: [Card] -> Maybe Int
main = do
putStrLn "How many cards?"
Random :: MonadRandom m => Deck-> m Deck
Random ran = runRVar (shuffle deck) StdRandom
Random <- getLine
putStrLn "Hand of [] totalCards: " ++ totalCards
error:
Failed to load interface for ‘Data.Random’
Perhaps you meant Data.Ratio (from base-4.9.0.0)
Use -v to see a list of the files searched for.
PLEASE HELP ME
At this point we have no information about the Card and Deck data types.
However, it seems that the problem at hand is to randomly extract M cards from an initial deck of N cards.
If this interpretation of the question is correct, we can thus use the Rand monad constructor, and start by defining a monadic action that transfers just one card from the right deck to the left deck.
As we have no information about the types in use, we will assume that the “cards” are denoted by plain numbers, from 0 to 51.
Next, we define an action moving M cards recursively, moving one card and then calling ourselves with an (M-1) argument. For M=0, we define the action as a no-op.
This would be the monadic code:
import System.Random
import Control.Monad.Random
moveOneCardLeft :: RandomGen g => ([a],[a]) -> Rand g ([a],[a])
moveOneCardLeft (deck, rest) =
do
let remCount = length rest
choice <- getRandomR (0, (remCount-1))
let (top, bot) = splitAt choice rest
return $ ((head bot) : deck, top ++ (tail bot))
moveSomeCardsLeft :: RandomGen g => Int -> ([a],[a]) -> Rand g ([a],[a])
moveSomeCardsLeft 0 (deck, rest) = return (deck, rest) -- unchanged
moveSomeCardsLeft n (deck, rest) =
do
(deck1, rest1) <- moveOneCardLeft (deck, rest)
(deck2, rest2) <- moveSomeCardsLeft (n-1) (deck1, rest1)
return (deck2, rest2)
extractSomeCards :: RandomGen g => Int -> [a] -> Rand g ([a], [a])
extractSomeCards n xs =
do
(deck, rest) <- moveSomeCardsLeft n ([], xs)
return (deck, rest)
Next, the pure code and some tentative game-related utility functions:
drawSomeCards :: RandomGen g => g -> Int -> [a] -> (([a], [a]), g)
drawSomeCards gen0 n xs = runRand (extractSomeCards n xs) gen0
cardValue :: Int -> Int
cardValue n = let rank = mod n 13
in if (rank < 10) then (rank+1)
else {- Jack Queen King -} 10
deckValue :: [Int] -> Int
deckValue cards = sum (map cardValue cards)
totalOfCards :: [Int] -> Maybe Int
totalOfCards cards =
let s = deckValue cards
in if (s <= 21) then (Just s) else Nothing
Finally, the user test code:
main = do
let wholeDeck = [0..51]
randomSeed = 4243
gen0 = mkStdGen randomSeed
putStrLn "How many cards ?"
inLine <- getLine
let count = (read inLine :: Int)
putStrLn $ "Want to extract " ++ (show count) ++ " cards."
let ((deck, rest), gen1) = drawSomeCards gen0 count wholeDeck
sumw = sum wholeDeck
suma = sum deck
sumb = sum rest
sum0 = (suma + sumb) - sumw
putStrLn $ "Must be zero: " ++ (show sum0) -- sanity check
putStrLn $ "deck: " ++ (show deck)
putStrLn $ "rest: " ++ (show rest)
putStrLn $ "Deck value: " ++ (show $ deckValue deck)
Program execution:
$ q67025780.x
How many cards ?
10
Want to extract 10 cards.
Must be zero: 0
deck: [8,47,38,49,4,31,9,30,28,23]
rest: [0,1,2,3,5,6,7,10,11,12,13,14,15,16,17,18,19,20,21,22,24,25,26,27,29,32,33,34,35,36,37,39,40,41,42,43,44,45,46,48,50,51]
Deck value: 77
$
Note: if deemed appropriate, the above code beyond moveOneCardLeft can be simplified using the nest :: Monad m => Int -> (a -> m a) -> a -> m a function from the Control.Monad.HT package.
Like this:
import Control.Monad.HT (nest)
moveOneCardLeft :: RandomGen g => ([a],[a]) -> Rand g ([a],[a])
moveOneCardLeft (deck, rest) =
do
let remCount = length rest
choice <- getRandomR (0, (remCount-1))
let (top, bot) = splitAt choice rest
return $ ((head bot) : deck, top ++ (tail bot))
drawSomeCards :: RandomGen g => g -> Int -> [a] -> (([a], [a]), g)
drawSomeCards gen0 n xs = let action = nest n moveOneCardLeft ([], xs)
in runRand action gen0
module Dfs = struct
let rec dfslsts g paths final =
let l = PrimePath.removeDuplicates (PrimePath.extendPaths g paths)
in
let f elem =
if (List.mem "%d" (List.flatten final) = false) then (dfslsts g ["%d"] (List.flatten l)::final)
else final
in
List.iter f (Graph.nodes g)
end
Error: This expression has type string but an expression was expected of type int list
This error occurred when I called dfslsts function, which is recursive, inside the if condition.
The function dfslsts returns a list of lists.
If I try to replace the complex expression in if statement to
if (List.mem "%d" (List.flatten final) = false) then "%d"
else "%d"
then I get
Error: This expression has type 'a -> string
but an expression was expected of type 'a -> unit
Type string is not compatible with type unit
at List.iter line.
How do I solve this problem and are we allowed to call a recursive function inside the if expression.
This is the definition of my graph type:
module Graph = struct
exception NodeNotFound of int
type graph = {
nodes : int list;
edges : (int * int) list;
}
let makeGraph () =
{
nodes = [];
edges = [];
}
let rec isNodeOf g n = List.mem n g.nodes
let nodes g = g.nodes
let edges g = g.edges
let addNode g n =
let nodes = n::g.nodes and edges = g.edges in
{
nodes;
edges;
}
let addEdge g (n1, n2) =
if ((isNodeOf g n1) = false) then
raise (NodeNotFound n1)
else if ((isNodeOf g n2) = false) then
raise (NodeNotFound n2)
else
let nodes = g.nodes
and edges = (n1, n2) :: g.edges in
{
nodes;
edges;
}
let nextNodes g n =
let rec findSuccessors edges n =
match edges with
[] -> []
| (n1, n2) :: t ->
if n1 = n then n2::findSuccessors t n
else findSuccessors t n
in
findSuccessors g.edges n
let rec lastNode path =
match path with
[] -> raise (NodeNotFound 0)
| n :: [] -> n
| _ :: t -> lastNode t
end
module Paths = struct
let extendPath g path =
let n = (Graph.lastNode path) in
let nextNodes = Graph.nextNodes g n in
let rec loop path nodes =
match nodes with
[] -> []
| h :: t -> (List.append path [h]) :: (loop path t)
in
loop path nextNodes
let rec extendPaths g paths =
match paths with
[] -> []
| h :: t -> List.append (extendPath g h) (extendPaths g t)
(* Given a list lst, return a new list with all duplicate entries removed *)
let rec removeDuplicates lst =
match lst with
[]
| _ :: [] -> lst
| h :: t ->
let trimmed = removeDuplicates t in
if List.mem h trimmed then trimmed
else h :: trimmed
end
Any expression can be a recursive function call. There are no limitations like that. Your problem is that some types don't match.
I don't see any ints in this code, so I'm wondering where the compiler sees the requirement for an int list. It would help to see the type definition for your graphs.
As a side comment, you almost certainly have a precedence problem with this code:
dfslsts g ["%d"] (List.flatten l)::final
The function call to dfslsts has higher precedence that the list cons operator ::, so this is parsed as:
(dfslsts g ["%d"] (List.flatten l)) :: final
You probably need to parenthesize like this:
dfslsts g ["%d"] ((List.flatten l) :: final)
Lets say you had a requirement to group a sequence into a sequence of tuples. Each tuple is a key*seq. So in a sense, the result is a sequence of sequences.
All pretty standard so far.
What if you wanted to further group each sub sequence by some other key? It would be easy enough to map another groupby function onto each element of your sequence of sequences. You would then have a sequence of sequences of sequences.
Starting to get slightly hairy.
What if you wanted to group it even further?
Would it be possible to write a function that can take in a key generating function and an arbitrary sequence, and recursively unwraps the layers and then adds another layer of grouping using the keyFunction?
I suspect the answer is no, because the recursive function would not have a well defined type.
My attempt at this, to further illustrate the idea:
let rec recursiveGrouper keyFunction aSeq =
let first = Seq.head aSeq
match first with
| ((a:'a), _) -> Seq.map (fun (b,(c:seq<'c>)) -> (b, recursiveGrouper keyFunction c)) aSeq
| _ -> Seq.groupBy keyFunction aSeq
EDIT:
Lets add an example of how this might work, it it were possible
type FruitRecord = {Fruit:string; Number:int; SourceFarm:string; Grade:float}
let key1 fr =
fr.Fruit
let key2 fr =
fr.SourceFarm
let key3 fr =
match fr.Grade with
|f when f > 5.0 -> "Very Good"
|f when f > 2.5 -> "Not bad"
|_ -> "Garbage"
Lets say we have a whole bunch of fruit records in a sequence. We want to group them by type of fruit.
One way would be to say
let group1 = fruitRecs |> Seq.groupBy key1
Using our recursive function, this would be
let group1 = recursiveGrouper key1 fruitRecs
Next, lets say we want to group each of the items in the groups of group1 by source farm.
We could say
let group2 =
group1
|> Seq.map (fun (f, s) -> (f, Seq.groupBy key2 s))
Using our recursive function it would be
let group2 = recursiveGrouper key2 group1
And we could go further and group by Grade by saying
let group3 = recursiveGrouper key3 group2
Actually there are some ways to make that recursive function work, using static constraints. Here's a small example:
// If using F# lower than 4.0, use this definition of groupBy
module List =
let groupBy a b = Seq.groupBy a (List.toSeq b) |> Seq.map (fun (a, b) -> a, Seq.toList b) |> Seq.toList
type A = class end // Dummy type
type B = class end // Dummy type
type C =
inherit B
static member ($) (_:C, _:A ) = fun keyFunction -> () // Dummy overload
static member ($) (_:C, _:B ) = fun keyFunction -> () // Dummy overload
static member ($) (_:B, aSeq) = fun keyFunction -> List.groupBy keyFunction aSeq // Ground case overload
static member inline ($) (_:C, aSeq) = fun keyFunction -> List.map (fun (b, c) -> b, (Unchecked.defaultof<C> $ c) keyFunction) aSeq
let inline recursiveGrouper keyFunction aSeq = (Unchecked.defaultof<C> $ aSeq) keyFunction
// Test code
type FruitRecord = {Fruit:string; Number:int; SourceFarm:string; Grade:float}
let key1 fr = fr.Fruit
let key2 fr = fr.SourceFarm
let key3 fr =
match fr.Grade with
|f when f > 5.0 -> "Very Good"
|f when f > 2.5 -> "Not bad"
|_ -> "Garbage"
let fruitRecs = [
{Fruit = "apple" ; Number = 8; SourceFarm = "F"; Grade = 5.5}
{Fruit = "apple" ; Number = 5; SourceFarm = "F"; Grade = 4.5}
{Fruit = "orange"; Number = 8; SourceFarm = "F"; Grade = 5.5}
]
let group1 = recursiveGrouper key1 fruitRecs
let group2 = recursiveGrouper key2 group1
let group3 = recursiveGrouper key3 group2
I don't think you could write it as a recursive function with the sort of constraints you put on yourself - that is:
A tuple 'key * seq<'value> representing the grouping,
A heterogeneous key function (or a collection thereof) - this is what I understand by "group each sub sequence by some other key".
You could make some leeway if you would represent the grouping as an actual tree type (rather than an ad-hoc tree built from tuples) - that way you'd have a well-defined recursive result type to go with your recursive function.
If at that point you would be able to also compromise on the key function to make it homogeneous (worst case - producing a hashcode), you should be able to express what you want within the type system.
You certainly could have a non-recursive grouping function that takes a grouped sequence and puts another level of grouping on top of it - like the one below:
module Seq =
let andGroupBy (projection: 't -> 'newKey) (source: seq<'oldKey * seq<'t>>) =
seq {
for key, sub in source do
let grouped = Seq.groupBy projection sub
for nkey, sub in grouped do
yield (key, nkey), sub
}
Using your FruitRecord example:
values
|> Seq.groupBy key1
|> Seq.andGroupBy key2
|> Seq.andGroupBy key3
I have this function:
let rec som a b acc =
if a > b then acc else
som (a+1) b (acc+(comb b a));;
And what I am trying to do is to save acc value in a hashtable, so my first try was:
let rec som a b acc =
if a > b then acc else
som (a+1) b (acc+(comb b a)) Hashtbl.add a acc;;
but it does not work... How can I save the values?
This is skeleton, you can try to add you code into it to get what you want. Maybe it will be helpful.
module Key = struct
type t=int
let compare: t->t->int = fun a b -> (* return -1 if a<b, 0 if a=b,and 1 if a>b *)
let equal = (=)
end
module H=Hashtbl.Make(Key)
let som =
let h = H.create () in
let rec f a b acc =
try H.find h acc
with Not_found ->
let ans = (* your evaluation code *) in
H.add h acc ans;
ans
in
f
First, let's take a look at the signature of Hashtbl.add
('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = <fun>
The first argument of the function is an hash table, then you need to create one. To do it, write let h_table = Hashtbl.create 123456;;. And to put it in context your add instruction become HashTbl.add h_table a acc
Next, you can't call this function at the same level of the recursive call. Indeed the function som take three arguments and you will face the following error message, It is applied to too many arguments ....
And as you want to trace the value of acc you need to put it before the recursive call. Doing this can lead you to face some difficulty, then I've added below a hint.
let _ = Printf.printf "a\n" in
let _ = Printf.printf "b\n" in
(1+2)
;;
a
b
- : int = 3
Is there any way in F# how to get a name of a variable passed into a function?
Example:
let velocity = 5
let fn v = v.ParentName
let name = fn velocity // this would return "velocity" as a string
Thank you in advance
EDIT:
Why this code does not work? It is matched as value, so I can not retrieve the "variable" name.
type Test() =
let getName (e:Quotations.Expr) =
match e with
| Quotations.Patterns.PropertyGet (_, pi, _) -> pi.Name + " property"
| Quotations.Patterns.Value(a) -> failwith "Value matched"
| _ -> failwith "other matched"
member x.plot v = v |> getName |> printfn "%s"
let o = new Test()
let display () =
let variable = 5.
o.plot <# variable #>
let runTheCode fn = fn()
runTheCode display
For completing Marcelo's answer, yes you can use quotations for this task:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
let velocity = 5
let fn (e:Expr) =
match e with
| PropertyGet (e, pi, li) -> pi.Name
| _ -> failwith "not a let-bound value"
let name = fn <#velocity#>
printfn "%s" name
As you can see in the code, F# let-bound top definition values (functions or variables) are implemented as properties of a class.
I can't find anymore the link that shows how a piece of F# code could be rewritten in a functional way with C#. Seeing the code, it becomes obvious why you need a PropertyGet pattern.
Now if you want to evaluate the expression too, you will need to install F# powerpack and reference FSharp.PowerPack.Linq in your project.
It adds an EvalUntyped method on Expr class..
open Microsoft.FSharp.Linq.QuotationEvaluation
let velocity = 5
let fn (e:Expr) =
match e with
| PropertyGet (eo, pi, li) -> pi.Name, e.EvalUntyped
| _ -> failwith "not a let-bound value"
let name, value = fn <#velocity#>
printfn "%s %A" name value
If you need to do it for the method of an instance, here's how I would do it:
let velocity = 5
type Foo () =
member this.Bar (x:int) (y:single) = x * x + int y
let extractCallExprBody expr =
let rec aux (l, uexpr) =
match uexpr with
| Lambda (var, body) -> aux (var::l, body)
| _ -> uexpr
aux ([], expr)
let rec fn (e:Expr) =
match e with
| PropertyGet (e, pi, li) -> pi.Name
| Call (e, mi, li) -> mi.Name
| x -> extractCallExprBody x |> fn
| _ -> failwith "not a valid pattern"
let name = fn <#velocity#>
printfn "%s" name
let foo = new Foo()
let methodName = fn <#foo.Bar#>
printfn "%s" methodName
Just to come back on the code snippet showing usage of EvalUntyped, you can add an explicit type parameter for Expr and a downcast (:?>) if you want/need to keep things type-safe:
let fn (e:Expr<'T>) =
match e with
| PropertyGet (eo, pi, li) -> pi.Name, (e.EvalUntyped() :?> 'T)
| _ -> failwith "not a let-bound value"
let name, value = fn <#velocity#> //value has type int here
printfn "%s %d" name value
You might be able to achieve this with code quotations:
let name = fn <# velocity #>
The fn function will be passed an Expr object, which it must cast to Quotations.Var (which it will only be if you pass a single variable) and extract the Name instance member.
Based on the previous solutions I came out with a more generic solution where you can get the name of functions, lambdas, values, properties, methods, static methods, public fields, Union types:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
let cout (s:string)= System.Console.WriteLine (s)
let rec getName exprs =
let fixDeclaringType (dt:string) =
match dt with
| fsi when fsi.StartsWith("FSI_") -> "Fsi"
| _ -> dt
let toStr (xDeclType: System.Type) x = sprintf "%s.%s" (fixDeclaringType xDeclType.Name) x
match exprs with
| Patterns.Call(_, mi, _) ->
toStr mi.DeclaringType mi.Name
| Patterns.Lambda(_, expr) ->
getName expr
| Patterns.PropertyGet (e, pi, li) ->
toStr pi.DeclaringType pi.Name
| Patterns.FieldGet (_, fi) ->
toStr fi.DeclaringType fi.Name
| Patterns.NewUnionCase(uci, _) ->
toStr uci.DeclaringType uci.Name
| expresion -> "unknown_name"
let value = ""
let funcky a = a
let lambdy = fun(x) -> x*2
type WithStatic =
| A | B
with static member StaticMethod a = a
let someIP = System.Net.IPAddress.Parse("10.132.0.48")
getName <# value #> |> cout
getName <# funcky #> |> cout
getName <# lambdy #> |> cout
getName <# WithStatic.A #> |> cout
getName <# WithStatic.StaticMethod #> |> cout
getName <# someIP.MapToIPv4 #> |> cout
getName <# System.Net.IPAddress.Parse #> |> cout
getName <# System.Net.IPAddress.Broadcast #> |> cout