I want to construct a decision tree for a two-player game (e.g. Tic-Tac-Toe) whose type ensures that it is complete. That is, I want the type of a tree's node to ensure that its children are exactly all of its successor nodes.
Here's my attempt at doing this in Idris. Tic-Tac-Toe is complicated so I made a much simpler game: there are three positions to move at (A | B | C), and the game ends after one move.
DTNode is "decision tree node."
data Player = Computer | Human
Eq Player where
Computer == Computer = True
Human == Human = True
_ == _ = False
Show Player where
show Computer = "Computer"
show Human = "Human"
opponent : Player -> Player
opponent Computer = Human
opponent Human = Computer
data Position = A | B | C
Move : Type
Move = (Player, Position)
State : Type
State = List Move
isFinal : State -> Bool
isFinal (a::_) = True
isFinal _ = False
successorStates : State -> (toMove: Player) -> List State
successorStates s toMove = case (isFinal s) of
True =>
[]
False =>
[(toMove, A)::s, (toMove, B)::s, (toMove, C)::s]
mutual
SuccessorDTNodeType : (s : State) -> (toMove: Player) -> (successors: List State) -> Type
SuccessorDTNodeType _ _ [] = the Type ()
SuccessorDTNodeType s toMove (successor::rest) = DTNode successor (opponent toMove) oneLevelDownNodeType -> SuccessorDTNodeType s toMove rest where
oneLevelDownNodeType = SuccessorDTNodeType successor (opponent $ opponent toMove) (successorStates successor toMove)
data DTNode : (s: State) -> (toMove: Player) -> SuccessorDTNodeType s toMove (successorStates s toMove) -> Type where
I'm getting the following type error:
|
45 | oneLevelDownNodeType = SuccessorDTNodeType successor (opponent $ opponent toMove) (successorStates successor toMove)
| ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When checking right hand side of Main.SuccessorDTNodeType, oneLevelDownNodeType with expected type
SuccessorDTNodeType successor (opponent toMove) (successorStates successor (opponent toMove))
Type mismatch between
Type (Type of SuccessorDTNodeType successor (opponent (opponent toMove)) (successorStates successor toMove))
and
SuccessorDTNodeType successor
(opponent toMove)
(case isFinal successor of
True => []
False => [(toMove, A) :: s, (toMove, B) :: s, (toMove, C) :: s]) (Expected type)
I only slightly understand; my guess is that Type, the return type of SuccessorDTNodeType, is not specific enough to meet the demands of my DTNode constructor.
Is this the case, and if so is there something I can do to get around it?
Related
I'm having problems to enforce the ordering in a binary search tree in Idris, and I'm not even sure I'm using the right approach.
Coming from Liquid Haskell, the idea behind the implementation is creating a simple binary tree and then refining the types in the initial structure (as it can be seen here https://ucsd-progsys.github.io/liquidhaskell-tutorial/Tutorial_12_Case_Study_AVL.html).
When trying to translate the same ordering restriction to Idris, things get a bit thorny.
Here's what I'm doing, first, I start with a simple definition of a binary tree, same as Haskell.
data Tree : (a: Type) -> Type where
Leaf : Tree a
Node : (key: a) -> (left: Tree a) -> (right: Tree a) -> Tree a
Having this in hand (and following up this question: Encoding a binary search tree in data type), I constructed another data type that should enforce the "search" part of the binary search tree, as follows:
minVal : Ord a => Tree a -> Maybe a
minVal Leaf = Nothing
minVal (Node key Leaf _) = Just key
minVal (Node key left right) = minVal left
maxVal : Ord a => Tree a -> Maybe a
maxVal Leaf = Nothing
maxVal (Node key _ Leaf) = Just key
maxVal (Node key left right) = maxVal right
lessTree : Ord a => a -> Tree a -> Bool
lessTree x node = case minVal node of
Nothing => True
Just key => x < key
moreTree : Ord a => a -> Tree a -> Bool
moreTree x node = case maxVal node of
Nothing => True
Just key => x >= key
IsLft : Ord a => (x: a) -> (left: Tree a) -> Type
IsLft x left = So (moreTree x left)
IsRgt : Ord a => (x: a) -> (right: Tree a) -> Type
IsRgt x right = So (lessTree x right)
data IsBST : (t : Tree a) -> Type where
IsBSTLeaf : IsBST Leaf
IsBSTNode : Ord a => (x: a) -> (IsBST left) -> (IsLft x left) -> (IsBST right) -> (IsRgt x right) -> (IsBST (Node x left right))
BSTree : Type -> Type
BSTree a = (t : (Tree a) ** (IsBST t))
Basically, the "proof" that a BST is a BST would be that the left tree is also a BST and should be in the left side (as in its root value is smaller than its parent), and the same idea for the right side.
This code compiles, but it doesn't work as expected, it can be seen in the implementation of an insert function, as below:
data Comp = LT | EQ | GT
comp : Ord a => a -> a -> Comp
comp x y = if x > y then GT else if x < y then LT else EQ
wrongInsert : Ord a => (x : a) -> BSTree a -> BSTree a
wrongInsert x (Leaf ** IsBSTLeaf) =
let isLftPrf = mkIsLft x Leaf
isRgtPrf = mkIsRgt x Leaf
in ((Node x Leaf Leaf) ** (IsBSTNode x IsBSTLeaf isLftPrf IsBSTLeaf isRgtPrf))
wrongInsert x ((Node y left right) ** (IsBSTNode y lPrf isLftPrf rPrf isRgtPrf)) =
case comp y x of
LT =>
let (lTree ** pl) = wrongInsert x (left ** lPrf)
isLft = mkIsLft y lTree
in ((Node y lTree right) ** (IsBSTNode y pl isLft rPrf isRgtPrf))
GT =>
let (rTree ** pr) = wrongInsert x (right ** rPrf)
isRgt = mkIsRgt y rTree
in ((Node y left rTree) ** (IsBSTNode y lPrf isLftPrf pr isRgt))
EQ => ((Node y left right) ** (IsBSTNode y lPrf isLftPrf rPrf isRgtPrf))
In that case, the "LT" and "GT" parts are inverted, as in something greater than the root is being inserted in the left side, and vice-versa, so it shouldn't be possible to create such a tree, yet it works, which implies that Idris is accepting the creation of a "So False" (which I thought shouldn't be impossible, since there's only a constructor for True from what I've looked at).
From what I read on other sources, maybe using "So" is not the better idea here, but I fail to see other way to create a restriction in Idris as I have in Liquid Haskell, so that the data type itself prevents me from implementing a wrong insert function, as in the example above. Is that even possible, or if this approach is completely wrong, what would be the right way of implementing such a restriction?
type alias Footballer =
{ name : String, age : Float, overall : Float, potential : Float }
type alias Point =
{ pointName : String, x : Float, y : Float }
pointName : Footballer -> Point
pointName x a b c=
Point x.a x.b x.c
I am trying to create points for a scatterplot and want to be able to provide the function with a Player and 3 columns I want to be able to provide variably.
I am struggling with elm, as I am trying to access fields of my List of Football players variably but I can not seem to find a way to do this without rewriting the function pointName for each Variation of Points I want to create.
Elm automatically generates polymorphic accessor functions for all the fields of the records used. (e.g. .age : { a | age : b } -> b) You can use these functions as arguments to pointName and apply them in the body of the function to extract the targeted field.
pointName :
r
-> (r -> String)
-> (r -> Float)
-> (r -> Float)
-> Point
pointName r a b c =
Point (a r) (b r) (c r)
player =
{ name = "Messi", age = 34, overall = 99, potential = 100 }
foo =
pointName player .name .age .potential
bar =
pointName player (.age >> String.fromFloat) .overall .potential
I am trying to create module/interface (i dont exactly know how its called, i am new to the language) for basic operations on BST in OCaml. My goal is to have an implementation that lets me doing something like this:
T.create();;
T.push(2);;
T.push(3);;
T.push(5);;
in order to get a bst tree consisting of 2,3,5.
But at the moment to achieve this i have to write something like this:
let teeBst = T.push(2)(T.push(3)(T.push(5)(T.create())));;
So when I am checking/using my code I have to do it like this:
let tee2 = T.push(2)(T.push(3)(T.push(5)(T.create())));;
T.postorder(tee2);;
The output is fine:
# val tee2 : T.bt = <abstr>
# - : int list = [2; 3; 5]
But, as I said before, I would like to achieve this doing as below:
T.push(2);;
T.push(3);;
T.push(5);;
T.postorder();;
(I realise this requires some changes to my postorder function but the one I am currently using is a temporary one so I can check the tree I have atm )
Below is my implementation. If you see the solution, please let me know ;)
module type Tree =
sig
type bt
val create: unit -> bt
val push: int -> bt -> bt
val find: int -> bt -> bool
val preorder: bt -> int list
val postorder: bt -> int list
val inorder: bt -> int list
end;;
module T : Tree =
struct
type bt = E | B of bt * int * bt
let create () = E
let rec push x = function
| E -> B(E, x, E)
| B (l, y, r) when x<y -> B(push x l, y, r)
| B (l, y, r) when x>y -> B(l, y, push x r)
| xs -> xs;;
let rec find x = function
| E -> false
| B(l, y,_) when x< y -> find x l
| B(_,y,r) when x>y -> find x r
| _ -> true;;
let rec preorder = function
| B(l,v,r) -> v::(preorder r) # (preorder l)
| E -> [];;
let rec inorder = function
| B(l,v,r) ->(inorder r) # v::(inorder l)
| E -> []
let rec postorder = function
| B(l,v,r) -> (postorder r) # (postorder l) # [v]
| E -> []
end;;
It seems like you want modules to be classes, but I'd advise you to consider more idiomatic solutions. Have you considered using the pipe operator?
T.create()
|> T.push(2)
|> T.push(3)
|> T.push(5)
|> T.postorder;;
Or with local open (which makes more sense if you have a module with a longer name than just T of course) you can even do
T.(
create()
|> push(2)
|> push(3)
|> push(5)
|> postorder
);
What you're asking for would require introducing global mutable state, which isn't just "some changes" but an entirely different paradigm. And one that is generally frowned upon because it makes your code unpredictable and hard to debug since it relies on state that might change at any moment from anywhere.
Another possibility is to actually use classes, since OCaml has those too. Then you'd still have mutable state, but it would at least be contained.
I want a find function for Streams of size-bounded types which is analogous to the find functions for Lists and Vects.
total
find : MaxBound a => (a -> Bool) -> Stream a -> Maybe a
The challenge is it to make it:
be total
consume no more than constant log_2 N space where N is the number of bits required to encode the largest a.
take no longer than a minute to check at compile time
impose no runtime cost
Generally a total find implementation for Streams sounds absurd. Streams are infinite and a predicate of const False would make the search go on forever. A nice way to handle this general case is the infinite fuel technique.
data Fuel = Dry | More (Lazy Fuel)
partial
forever : Fuel
forever = More forever
total
find : Fuel -> (a -> Bool) -> Stream a -> Maybe a
find Dry _ _ = Nothing
find (More fuel) f (value :: xs) = if f value
then Just value
else find fuel f xs
That works well for my use case, but I wonder if in certain specialized cases the totality checker could be convinced without using forever. Otherwise, somebody may suffer a boring life waiting for find forever ?predicateWhichHappensToAlwaysReturnFalse (iterate S Z) to finish.
Consider the special case where a is Bits32.
find32 : (Bits32 -> Bool) -> Stream Bits32 -> Maybe Bits32
find32 f (value :: xs) = if f value then Just value else find32 f xs
Two problems: it's not total and it can't possibly return Nothing even though there's a finite number of Bits32 inhabitants to try. Maybe I could use take (pow 2 32) to build a List and then use List's find...uh, wait...the list alone would take up GBs of space.
In principle it doesn't seem like this should be difficult. There's finitely many inhabitants to try, and a modern computer can iterate through all 32-bit permutations in seconds. Is there a way to have the totality checker verify the (Stream Bits32) $ iterate (+1) 0 eventually cycles back to 0 and once it does assert that all the elements have been tried since (+1) is pure?
Here's a start, although I'm unsure how to fill the holes and specialize find enough to make it total. Maybe an interface would help?
total
IsCyclic : (init : a) -> (succ : a -> a) -> Type
data FinStream : Type -> Type where
MkFinStream : (init : a) ->
(succ : a -> a) ->
{prf : IsCyclic init succ} ->
FinStream a
partial
find : Eq a => (a -> Bool) -> FinStream a -> Maybe a
find pred (MkFinStream {prf} init succ) = if pred init
then Just init
else find' (succ init)
where
partial
find' : a -> Maybe a
find' x = if x == init
then Nothing
else
if pred x
then Just x
else find' (succ x)
total
all32bits : FinStream Bits32
all32bits = MkFinStream 0 (+1) {prf=?prf}
Is there a way to tell the totality checker to use infinite fuel verifying a search over a particular stream is total?
Let's define what it means for a sequence to be cyclic:
%default total
iter : (n : Nat) -> (a -> a) -> (a -> a)
iter Z f = id
iter (S k) f = f . iter k f
isCyclic : (init : a) -> (next : a -> a) -> Type
isCyclic init next = DPair (Nat, Nat) $ \(m, n) => (m `LT` n, iter m next init = iter n next init)
The above means that we have a situation which can be depicted as follows:
-- x0 -> x1 -> ... -> xm -> ... -> x(n-1) --
-- ^ |
-- |---------------------
where m is strictly less than n (but m can be equal to zero). n is some number of steps after which we get an element of the sequence we previously encountered.
data FinStream : Type -> Type where
MkFinStream : (init : a) ->
(next : a -> a) ->
{prf : isCyclic init next} ->
FinStream a
Next, let's define a helper function, which uses an upper bound called fuel to break out from the loop:
findLimited : (p : a -> Bool) -> (next : a -> a) -> (init : a) -> (fuel : Nat) -> Maybe a
findLimited p next x Z = Nothing
findLimited p next x (S k) = if p x then Just x
else findLimited pred next (next x) k
Now find can be defined like so:
find : (a -> Bool) -> FinStream a -> Maybe a
find p (MkFinStream init next {prf = ((_,n) ** _)}) =
findLimited p next init n
Here are some tests:
-- I don't have patience to wait until all32bits typechecks
all8bits : FinStream Bits8
all8bits = MkFinStream 0 (+1) {prf=((0, 256) ** (LTESucc LTEZero, Refl))}
exampleNothing : Maybe Bits8
exampleNothing = find (const False) all8bits -- Nothing
exampleChosenByFairDiceRoll : Maybe Bits8
exampleChosenByFairDiceRoll = find ((==) 4) all8bits -- Just 4
exampleLast : Maybe Bits8
exampleLast = find ((==) 255) all8bits -- Just 255
I'm trying to translate the Haskell core library's Arrows into F# (I think it's a good exercise to understanding Arrows and F# better, and I might be able to use them in a project I'm working on.) However, a direct translation isn't possible due to the difference in paradigms. Haskell uses type-classes to express this stuff, but I'm not sure what F# constructs best map the functionality of type-classes with the idioms of F#. I have a few thoughts, but figured it best to bring it up here and see what was considered to be the closest in functionality.
For the tl;dr crowd: How do I translate type-classes (a Haskell idiom) into F# idiomatic code?
For those accepting of my long explanation:
This code from the Haskell standard lib is an example of what I'm trying to translate:
class Category cat where
id :: cat a a
comp :: cat a b -> cat b c -> cat a c
class Category a => Arrow a where
arr :: (b -> c) -> a b c
first :: a b c -> a (b,d) (c,d)
instance Category (->) where
id f = f
instance Arrow (->) where
arr f = f
first f = f *** id
Attempt 1: Modules, Simple Types, Let Bindings
My first shot at this was to simply map things over directly using Modules for organization, like:
type Arrow<'a,'b> = Arrow of ('a -> 'b)
let arr f = Arrow f
let first f = //some code that does the first op
That works, but it loses out on polymorphism, since I don't implement Categories and can't easily implement more specialized Arrows.
Attempt 1a: Refining using Signatures and types
One way to correct some issues with Attempt 1 is to use a .fsi file to define the methods (so the types enforce easier) and to use some simple type tweaks to specialize.
type ListArrow<'a,'b> = Arrow<['a],['b]>
//or
type ListArrow<'a,'b> = LA of Arrow<['a],['b]>
But the fsi file can't be reused (to enforce the types of the let bound functions) for other implementations, and the type renaming/encapsulating stuff is tricky.
Attempt 2: Object models and interfaces
Rationalizing that F# is built to be OO also, maybe a type hierarchy is the right way to do this.
type IArrow<'a,'b> =
abstract member comp : IArrow<'b,'c> -> IArrow<'a,'c>
type Arrow<'a,'b>(func:'a->'b) =
interface IArrow<'a,'b> with
member this.comp = //fun code involving "Arrow (fun x-> workOn x) :> IArrow"
Aside from how much of a pain it can be to get what should be static methods (like comp and other operators) to act like instance methods, there's also the need to explicitly upcast the results. I'm also not sure that this methodology is still capturing the full expressiveness of type-class polymorphism. It also makes it hard to use things that MUST be static methods.
Attempt 2a: Refining using type extensions
So one more potential refinement is to declare the interfaces as bare as possible, then use extension methods to add functionality to all implementing types.
type IArrow<'a,'b> with
static member (&&&) f = //code to do the fanout operation
Ah, but this locks me into using one method for all types of IArrow. If I wanted a slightly different (&&&) for ListArrows, what can I do? I haven't tried this method yet, but I would guess I can shadow the (&&&), or at least provide a more specialized version, but I feel like I can't enforce the use of the correct variant.
Help me
So what am I supposed to do here? I feel like OO should be powerful enough to replace type-classes, but I can't seem to figure out how to make that happen in F#. Were any of my attempts close? Are any of them "as good as it gets" and that'll have to be good enough?
My brief answer is:
OO is not powerful enough to replace type classes.
The most straightforward translation is to pass a dictionary of operations, as in one typical typeclass implementation. That is if typeclass Foo defines three methods, then define a class/record type named Foo, and then change functions of
Foo a => yadda -> yadda -> yadda
to functions like
Foo -> yadda -> yadda -> yadda
and at each call site you know the concrete 'instance' to pass based on the type at the call-site.
Here's a short example of what I mean:
// typeclass
type Showable<'a> = { show : 'a -> unit; showPretty : 'a -> unit } //'
// instances
let IntShowable =
{ show = printfn "%d"; showPretty = (fun i -> printfn "pretty %d" i) }
let StringShowable =
{ show = printfn "%s"; showPretty = (fun s -> printfn "<<%s>>" s) }
// function using typeclass constraint
// Showable a => [a] -> ()
let ShowAllPretty (s:Showable<'a>) l = //'
l |> List.iter s.showPretty
// callsites
ShowAllPretty IntShowable [1;2;3]
ShowAllPretty StringShowable ["foo";"bar"]
See also
https://web.archive.org/web/20081017141728/http://blog.matthewdoig.com/?p=112
Here's the approach I use to simulate Typeclasses (from http://code.google.com/p/fsharp-typeclasses/ ).
In your case, for Arrows could be something like this:
let inline i2 (a:^a,b:^b ) =
((^a or ^b ) : (static member instance: ^a* ^b -> _) (a,b ))
let inline i3 (a:^a,b:^b,c:^c) =
((^a or ^b or ^c) : (static member instance: ^a* ^b* ^c -> _) (a,b,c))
type T = T with
static member inline instance (a:'a ) =
fun x -> i2(a , Unchecked.defaultof<'r>) x :'r
static member inline instance (a:'a, b:'b) =
fun x -> i3(a, b, Unchecked.defaultof<'r>) x :'r
type Return = Return with
static member instance (_Monad:Return, _:option<'a>) = fun x -> Some x
static member instance (_Monad:Return, _:list<'a> ) = fun x -> [x]
static member instance (_Monad:Return, _: 'r -> 'a ) = fun x _ -> x
let inline return' x = T.instance Return x
type Bind = Bind with
static member instance (_Monad:Bind, x:option<_>, _:option<'b>) = fun f ->
Option.bind f x
static member instance (_Monad:Bind, x:list<_> , _:list<'b> ) = fun f ->
List.collect f x
static member instance (_Monad:Bind, f:'r->'a, _:'r->'b) = fun k r -> k (f r) r
let inline (>>=) x (f:_->'R) : 'R = T.instance (Bind, x) f
let inline (>=>) f g x = f x >>= g
type Kleisli<'a, 'm> = Kleisli of ('a -> 'm)
let runKleisli (Kleisli f) = f
type Id = Id with
static member instance (_Category:Id, _: 'r -> 'r ) = fun () -> id
static member inline instance (_Category:Id, _:Kleisli<'a,'b>) = fun () ->
Kleisli return'
let inline id'() = T.instance Id ()
type Comp = Comp with
static member instance (_Category:Comp, f, _) = (<<) f
static member inline instance (_Category:Comp, Kleisli f, _) =
fun (Kleisli g) -> Kleisli (g >=> f)
let inline (<<<) f g = T.instance (Comp, f) g
let inline (>>>) g f = T.instance (Comp, f) g
type Arr = Arr with
static member instance (_Arrow:Arr, _: _ -> _) = fun (f:_->_) -> f
static member inline instance (_Arrow:Arr, _:Kleisli<_,_>) =
fun f -> Kleisli (return' <<< f)
let inline arr f = T.instance Arr f
type First = First with
static member instance (_Arrow:First, f, _: 'a -> 'b) =
fun () (x,y) -> (f x, y)
static member inline instance (_Arrow:First, Kleisli f, _:Kleisli<_,_>) =
fun () -> Kleisli (fun (b,d) -> f b >>= fun c -> return' (c,d))
let inline first f = T.instance (First, f) ()
let inline second f = let swap (x,y) = (y,x) in arr swap >>> first f >>> arr swap
let inline ( *** ) f g = first f >>> second g
let inline ( &&& ) f g = arr (fun b -> (b,b)) >>> f *** g
Usage:
> let f = Kleisli (fun y -> [y;y*2;y*3]) <<< Kleisli ( fun x -> [ x + 3 ; x * 2 ] ) ;;
val f : Kleisli<int,int list> = Kleisli <fun:f#4-14>
> runKleisli f <| 5 ;;
val it : int list = [8; 16; 24; 10; 20; 30]
> (arr (fun y -> [y;y*2;y*3])) 3 ;;
val it : int list = [3; 6; 9]
> let (x:option<_>) = runKleisli (arr (fun y -> [y;y*2;y*3])) 2 ;;
val x : int list option = Some [2; 4; 6]
> ( (*) 100) *** ((+) 9) <| (5,10) ;;
val it : int * int = (500, 19)
> ( (*) 100) &&& ((+) 9) <| 5 ;;
val it : int * int = (500, 14)
> let x:List<_> = (runKleisli (id'())) 5 ;;
val x : List<int> = [5]
Note: use id'() instead of id
Update: you need F# 3.0 to compile this code, otherwise here's the F# 2.0 version.
And here's a detailed explanation of this technique which is type-safe, extensible and as you can see works even with some Higher Kind Typeclasses.