The exercise is to code a function in ML that deletes an element from a binary search tree.
Here's the code:
datatype 'a tree = Lf | Br of 'a * 'a tree * 'a tree;
fun deleteTop (Br(_, Lf, t2)) = t2
| deleteTop (Br(_, t1, Lf)) = t1
| deleteTop (Br(_, Br(v, u1, u2), t2)) =
Br(v, deleteTop (Br(v, u1, u2)), t2);
fun delete (Lf, k : string) = Lf
| delete (Br((a,b),t1,t2), k) =
if a=k then deleteTop(Br((a,b),t1,t2))
else if k<a then Br((a,b),delete(t1,k),t2)
else Br((a,b),t1,delete(t2,k));
When I load this into Poly/ML it warns me of incomplete pattern matching in deleteTop but that doesn't matter because delete only ever passes deleteTop a branch.
val deleteTop = fn: 'a tree -> 'a tree
val delete = fn: (string * 'a) tree * string -> (string * 'a) tree
I created a (string * int) tree and ran
> delete(a,"they");
Error-Type error in function application.
Function: delete : (string * 'a) tree * string -> (string * 'a) tree
Argument: (a, "they") : (string * int) tree * string
Reason:
Can't unify (string * 'a) tree with (string * int) tree
(Different type constructors)
Found near delete (a, "they")
Static Errors
Let me re-iterate one of those lines:
Can't unify (string * 'a) tree with (string * int) tree
Why can't ML unify 'a with int?
You can get a message like that if you have redefined tree and delete at the top level since you defined a. It's complaining that the tree in a is not the same as the tree in delete.
For example
> datatype 'a t = T of 'a;
datatype 'a t = T of 'a
> val x = T 1;
val x = T 1: int t
> datatype 'a t = T of 'a;
datatype 'a t = T of 'a
> val T y = x;
Pattern and expression have incompatible types.
Pattern: T y : 'a t
Expression: x : int t
Reason: Can't unify 'a t with int t (Different type constructors)
Found near val T y = x
Static Errors
>
Related
I am not sure yet what the problem is, I am trying to go through a ResizeArray and matching the item with the data type, and depending on this, take away the value in a specific field (iSpace) from thespace(which is how much space the inventory has), before returning the final value.
A snippet of my code :
let spaceleft =
let mutable count = 0 //used to store the index to get item from array
let mutable thespace = 60 //the space left in the inventory
printf "Count: %i \n" inventory.Count //creates an error
while count < inventory.Count do
let item = inventory.[count]
match item with
|Weapon weapon ->
thespace <- (thespace - weapon.iSpace)
|Bomb bomb ->
thespace <-(thespace - bomb.iSpace)
|Potion pot ->
thespace <- (thespace - pot.iSpace)
|Armour arm ->
thespace <- (thespace - arm.iSpace)
count <- count+1
thespace
I get an error about Int32, that has to do with the
printf "Count: %i \n" inventory.Count
line
Another problem is that thespace doesn't seem to change, and always returns as 60, although I have checked and inventory is not empty, it always has at least two items, 1 weapon and 1 armour, so thespace should atleast decrease yet it never does.
Other snippets that may help:
let inventory = ResizeArray[]
let initialise =
let mutable listr = roominit
let mutable curroom = 3
let mutable dead = false
inventory.Add(Weapon weap1)
inventory.Add(Armour a1)
let spacetogo = spaceleft //returns 60, although it should not
Also, apart from the iniitialise function, other functions seem not to be able to add items to the inventory properly, eg:
let ok, input = Int32.TryParse(Console.ReadLine())
match ok with
|false ->
printf "The weapon was left here \n"
complete <- false
|true ->
if input = 1 && spaceleft>= a.iSpace then
inventory.Add(Weapon a)
printf "\n %s added to the inventory \n" a.name
complete <- true
else
printf "\n The weapon was left here \n"
complete <- false
complete
You have spaceLeft as a constant value. To make it a function you need to add unit () as a parameter. Here's that change including a modification to make it much simpler (I've included my dummy types):
type X = { iSpace : int }
type Item = Weapon of X | Bomb of X | Potion of X | Armour of X
let inventory = ResizeArray [ Weapon {iSpace = 2}; Bomb {iSpace = 3} ]
let spaceleft () =
let mutable thespace = 60 //the space left in the inventory
printf "Count: %i \n" inventory.Count
for item in inventory do
let itemSpace =
match item with
| Weapon w -> w.iSpace
| Bomb b -> b.iSpace
| Potion p -> p.iSpace
| Armour a -> a.iSpace
thespace <- thespace - itemSpace
thespace
spaceleft () // 55
The above code is quite imperative. If you want to make it more functional (and simpler still) you can use Seq.sumBy:
let spaceleft_functional () =
printf "Count: %i \n" inventory.Count
let spaceUsed =
inventory
|> Seq.sumBy (function
| Weapon w -> w.iSpace
| Bomb b -> b.iSpace
| Potion p -> p.iSpace
| Armour a -> a.iSpace)
60 - spaceUsed
Just adding to the accepted answer: you can also match against record labels, as long as your inner types are records. Combine with an intrinsic type extension on the outer DU:
type X = { iSpace : int }
type Y = { iSpace : int }
type Item = Weapon of X | Bomb of Y | Potion of X | Armour of X
let inventory = ResizeArray [ Weapon {iSpace = 2}; Bomb {iSpace = 3} ]
let itemSpace = function
| Weapon { iSpace = s } | Bomb { iSpace = s }
| Potion { iSpace = s } | Armour { iSpace = s } -> s
type Item with static member (+) (a, b) = a + itemSpace b
60 - (Seq.fold (+) 0 inventory)
// val it : int = 55
Otherwise, you could resort to member constraint invocation expressions.
let inline space (x : ^t) = (^t : (member iSpace : int) (x))
I have very little knowledge about OCaml as a whole and just received an assignment to take one of the source files in the project and allow it to take a new data type (Array). I am not asking for someone to solve this problem for me, but instead I would appreciate someone walking me through this code. I would also appreciate any input on how difficult it is going to be to implement this new data type.
The file itself lacks a lot of documentation which doesn't make it any easier either.
(* * Types (hashconsed) *)
(* ** Imports *)
open Abbrevs
open Util
(* ** Identifiers *)
module Lenvar : (module type of Id) = Id
module Tysym : (module type of Id) = Id
module Groupvar : (module type of Id) = Id
module Permvar : (module type of Id) = Id
(* ** Types and type nodes *)
type ty = {
ty_node : ty_node;
ty_tag : int
}
and ty_node =
| BS of Lenvar.id
| Bool
| G of Groupvar.id
| TySym of Tysym.id
| Fq
| Prod of ty list
| Int
(* ** Equality, hashing, and hash consing *)
let equal_ty : ty -> ty -> bool = (==)
let hash_ty t = t.ty_tag
let compare_ty t1 t2 = t1.ty_tag - t2.ty_tag
module Hsty = Hashcons.Make (struct
type t = ty
let equal t1 t2 =
match t1.ty_node, t2.ty_node with
| BS lv1, BS lv2 -> Lenvar.equal lv1 lv2
| Bool, Bool -> true
| G gv1, G gv2 -> Groupvar.equal gv1 gv2
| TySym ts1, TySym ts2 -> Tysym.equal ts1 ts2
| Fq, Fq -> true
| Prod ts1, Prod ts2 -> list_eq_for_all2 equal_ty ts1 ts2
| _ -> false
let hash t =
match t.ty_node with
| BS lv -> hcomb 1 (Lenvar.hash lv)
| Bool -> 2
| G gv -> hcomb 3 (Groupvar.hash gv)
| TySym gv -> hcomb 4 (Tysym.hash gv)
| Fq -> 5
| Prod ts -> hcomb_l hash_ty 6 ts
| Int -> 7
let tag n t = { t with ty_tag = n }
end)
(** Create [Map], [Set], and [Hashtbl] modules for types. *)
module Ty = StructMake (struct
type t = ty
let tag = hash_ty
end)
module Mty = Ty.M
module Sty = Ty.S
module Hty = Ty.H
(* ** Constructor functions *)
let mk_ty n = Hsty.hashcons {
ty_node = n;
ty_tag = (-1)
}
let mk_BS lv = mk_ty (BS lv)
let mk_G gv = mk_ty (G gv)
let mk_TySym ts = mk_ty (TySym ts)
let mk_Fq = mk_ty Fq
let mk_Bool = mk_ty Bool
let mk_Int = mk_ty Int
let mk_Prod tys =
match tys with
| [t] -> t
| _ -> mk_ty (Prod tys)
(* ** Indicator and destructor functions *)
let is_G ty = match ty.ty_node with
| G _ -> true
| _ -> false
let is_Fq ty = match ty.ty_node with
| Fq -> true
| _ -> false
let is_Prod ty = match ty.ty_node with
| Prod _ -> true
| _ -> false
let destr_G_exn ty =
match ty.ty_node with
| G gv -> gv
| _ -> raise Not_found
let destr_BS_exn ty =
match ty.ty_node with
| BS lv -> lv
| _ -> raise Not_found
let destr_Prod_exn ty =
match ty.ty_node with
| Prod ts -> ts
| _ -> raise Not_found
let destr_Prod ty =
match ty.ty_node with
| Prod ts -> Some ts
| _ -> None
(* ** Pretty printing *)
let pp_group fmt gv =
if Groupvar.name gv = ""
then F.fprintf fmt "G"
else F.fprintf fmt "G_%s" (Groupvar.name gv)
let rec pp_ty fmt ty =
match ty.ty_node with
| BS lv -> F.fprintf fmt "BS_%s" (Lenvar.name lv)
| Bool -> F.fprintf fmt "Bool"
| Fq -> F.fprintf fmt "Fq"
| TySym ts -> F.fprintf fmt "%s" (Tysym.name ts)
| Prod ts -> F.fprintf fmt "(%a)" (pp_list " * " pp_ty) ts
| Int -> F.fprintf fmt "Int"
| G gv ->
if Groupvar.name gv = ""
then F.fprintf fmt "G"
else F.fprintf fmt "G_%s" (Groupvar.name gv)
It's hard to walk through this code because quite a bit is missing (definitions of Id, Hashcons, StructMake). But in general this code manipulates data structures that represent types.
You can read about hash consing here: https://en.wikipedia.org/wiki/Hash_consing (which is what I just did myself). In essence it is a way of maintaining a canonical representation for a set of structures (in this case, structures representing types) so that two structures that are equal (having constituents that are equal) are represented by the identical value. This allows constant-time comparison for equality. When you do this with strings, it's called "interning" (a technique from Lisp I've used many times).
To add arrays, you need to know whether the array type will include the length of the array or just the type of its elements. The semi-mysterious type BS seems to include a length, which suggests you may want to include the length in your reprsentation.
If I were doing this project I would look for every occurence of Prod (which represents tuples) and I'd add a type representing Array in an analogous way. Instead of a list of constituent types (as for a tuple) you have one constituent type and (I would guess) a variable representing the length of the array.
Before starting out I'd look for some documentation, on what BS represents for one thing. I also have no idea what "groups" are, but maybe you could worry about it later.
Update
Here's what I mean by copying Prod. Keep in mind that I am basing this almost entirely on guesswork. So, many details (or even the entire idea) could be wrong.
The current definition of a type looks like this:
and ty_node =
| BS of Lenvar.id
| Bool
| G of Groupvar.id
| TySym of Tysym.id
| Fq
| Prod of ty list
| Int
If you add a representation for Array after Prod you get something like this:
and ty_node =
| BS of Lenvar.id
| Bool
| G of Groupvar.id
| TySym of Tysym.id
| Fq
| Prod of ty list
| Array of Lenvar.id * ty
| Int
You would then go through the rest of the code adding support for the new Array variant. The compiler will help you find many of the places that need fixing.
With help from many sources, I have a working generic thing for a ring-buffer, with push and read of single elements:
q.ads:
generic
Q_SIZE : POSITIVE;
type T is private;
package Q is
subtype SIZE_TYPE is NATURAL range 0 .. Q_SIZE;
subtype Q_INDEX_TYPE is SIZE_TYPE range 1 .. SIZE_TYPE'last;
type Q_ARRAY_TYPE is array (Q_INDEX_TYPE) of T;
procedure INITIALIZE;
procedure PUSH(element : T);
function READ return T;
end Q;
q.adb:
package body Q is
Q_ARRAY : Q_ARRAY_TYPE;
TAIL : Q_INDEX_TYPE;
HEAD : Q_INDEX_TYPE;
...
end Q;
My test program instantiates the above for bytes and exercises the ring. It is basically as follows:
package body main is
package RING is new Q (15, UNSIGNED.BYTE);
procedure TEST is
byteval : UNSIGNED.BYTE;
begin
byteval := 16;
RING.PUSH(byteval);
...
I would now like to add the ability to pass an array of T in. I've add this to the ADS and ADB files:
procedure PUSH_ARRAY(DATA_ARRAY : Q_ARRAY_TYPE; COUNT : SIZE_TYPE);
My problem is in the test program. I've changed it to this:
BYTE_ARRAY : array (1 .. 10) of UNSIGNED.BYTE;
procedure TEST is begin
-- initialize the first 5 elements of BYTE_ARRAY, then
RING.PUSH_ARRAY(BYTE_ARRAY, 5);
this last line gives me an error message: expected type Q_ARRAY_TYPE defined at Q.ADS:xx. How do I pass a BYTE ARRAY to my method which expects an instance of the generic array?
Question: What is the purpose of SIZE_TYPE?
In Ada, the 'Length attribute will return the size of the array in Natural (the nonnegative Integer subtype). With that in mind, it doesn't seem to make sense to declare an extra subtype with an extra value for the index.
Ring_Buffer.ads
Generic
Type T is private;
Default : T;
Size : Positive;
Package Ring_Buffer is
SubType Index is Positive range 1..Size;
Type Ring is private;
Function Length( Obj : Ring ) return Natural;
Function Pop( Obj : in out Ring ) return T
with Pre => Length(Obj) in Positive,
Post => Length(Obj'Old)-1 = Length(Obj); --' --Highlight fix
Procedure Push( Obj : in out Ring; Item : in T )
with Pre => Length(Obj) < Size,
Post => Length(Obj'Old)+1 = Length(Obj); --'
Private
Type Internal_Data is Array(Index) of T;
Type Ring is record
Start : Positive:= Internal_Data'First; --'
Size : Natural:= 0;
Data : Internal_Data:= (Others => Default);
end record
with Type_Invariant => Ring.Size <= Size;
Function Length( Obj : Ring ) return Natural is
( Obj.Size );
End Ring_Buffer;
Ring_Buffer.adb
Package Body Ring_Buffer is
Function Pop( Obj : in out Ring ) return T is
Begin
return Result : constant T := Obj.Data(Obj.Start) do
Obj.Size:= Natural'Pred( Obj.Size ); --'
Obj.Start:= (if Obj.Start = Size then 1 else Obj.Start + 1);
end return;
End Pop;
Procedure Push( Obj : in out Ring; Item : in T ) is
Begin
Obj.Data( Natural'Succ((Obj.Start-1) + Obj.Size mod Size) ):= Item; --'
Obj.Size:= Obj.Size + 1;
End Push;
End Ring_Buffer;
I want to use the datatype sequence that is defined as follows:
datatype 'a seq = Nil | Cons of 'a * (unit-> 'a seq);
exception EmptySeq;
fun head(Cons(x,_)) = x | head Nil = raise EmptySeq;
fun tail(Cons(_,xf)) = xf() | tail Nil = raise EmptySeq;
which has to option to iterate over functions backward and forward:
datatype direction = Back | Forward;
datatype 'a bseq = bNil | bCons of 'a * (direction -> 'a bseq);
and i defined those as well:
fun bHead(bCons(x,_)) = x | bHead bNil = raise EmptySeq;
fun bForward(bCons(_,xf)) = xf(Forward) | bForward bNil = raise EmptySeq;
fun bBack(bCons(_,xf)) = xf(Back) | bBack bNil = raise EmptySeq;
Now, what I'm trying to do is to create a function "create_seq" that gets an int "k" and returns an infinte sequence which can be iterated back and forth.
for example:
- create_seq 2;
val it = bCons (2,fn) : int bseq
- bForward it;
val it = bCons (3,fn) : int bseq
- bForward it;
val it = bCons (4,fn) : int bseq
- bBack it;
val it = bCons (3,fn) : int bseq
- bBack it;
val it = bCons (2,fn) : int bseq
- bBack it;
val it = bCons (1,fn) : int bseq
- bBack it;
val it = bCons (0,fn) : int bseq
- bBack it;
val it = bCons (~1,fn) : int bseq
this is what I've been trying to do and can't figure out why it doesn't work:
fun create_seq k = (k,fun check Forward = create_seq(k+1)
| check Back = create_seq(k-1));
nor this:
fun create_seq k = (k,fn x => case x of Forward => create_seq(k+1)
| Back => create_seq(k-1));
or even this:
fun create_seq k = (k,fn Forward => create_seq(k+1)
| Back => create_seq(k-1));
It seems I forgot the constructor:
fun intbseq(k:int) = bCons(k,fn Forward => intbseq(k+1)| Back => intbseq(k-1));
this should work.
I'm trying to write a CLR user-defined function in F#, but CREATE ASSEMBLY gives the error:
CREATE ASSEMBLY failed because type 'StringMetrics' in safe assembly 'MyNamespace.SqlServer.Text' has a static field 'field1776#'. Attributes of static fields in safe assemblies must be marked readonly in Visual C#, ReadOnly in Visual Basic, or initonly in Visual C++ and intermediate language.
Here's how it looks in Reflector. This is not a field I've explicitly created.
[DebuggerBrowsable(DebuggerBrowsableState.Never)]
internal static <PrivateImplementationDetails$MyNamespace-SqlServer-Text>.T1775_18Bytes# field1776#; // data size: 18 bytes
I've tried using a module and a class. Both generate the field, just in different places. What is this field for? Is there a way to avoid its creation? Is there another approach I should be using to create a CLR function in F#? Is it even possible?
Complete Code
namespace MyNamespace.SqlServer.Text
module StringMetrics =
open System
open System.Collections.Generic
open System.Data
open System.Data.SqlTypes
[<CompiledName("FuzzyMatch")>]
let fuzzyMatch (strA:SqlString) (strB:SqlString) =
if strA.IsNull || strB.IsNull then SqlInt32.Zero
else
let comparer = StringComparer.OrdinalIgnoreCase
let wordBoundaries = [|' '; '\t'; '\n'; '\r'; ','; ':'; ';'; '('; ')'|]
let stringEquals a b = comparer.Equals(a, b)
let isSubstring (search:string) (find:string) = find.Length >= search.Length / 2 && search.IndexOf(find, StringComparison.OrdinalIgnoreCase) >= 0
let split (str:string) = str.Split(wordBoundaries)
let score (strA:string) (strB:string) =
if stringEquals strA strB then strA.Length * 3
else
let lenA, lenB = strA.Length, strB.Length
if strA |> isSubstring strB then lenA * 2
elif strB |> isSubstring strA then lenB * 2
else 0
let arrA, arrB = split strA.Value, split strB.Value
let dictA, dictB = Dictionary(), Dictionary()
arrA |> Seq.iteri (fun i a ->
arrB |> Seq.iteri (fun j b ->
match score a b with
| 0 -> ()
| s ->
match dictB.TryGetValue(j) with
| true, (s', i') -> //'
if s > s' then //'
dictA.Add(i, j)
dictB.[j] <- (s, i)
| _ ->
dictA.Add(i, j)
dictB.Add(j, (s, i))))
let matchScore = dictB |> Seq.sumBy (function (KeyValue(_, (s, _))) -> s)
let nonMatchA =
arrA
|> Seq.mapi (fun i a -> i, a)
|> Seq.fold (fun s (i, a) ->
if dictA.ContainsKey(i) then s
else s + a.Length) 0
let wordsB = HashSet(seq { for (KeyValue(i, _)) in dictB -> arrB.[i] }, comparer)
let nonMatchB =
arrB |> Seq.fold (fun s b ->
if wordsB.Add(b) then s + b.Length
else s) 0
SqlInt32(matchScore - nonMatchA - nonMatchB)
It seems it's generated by the wordBoundaries array. If you express it as a list instead, and convert it to an array at runtime, this internal static field is not generated:
let wordBoundaries = Array.ofList [' '; '\t'; '\n'; '\r'; ','; ':'; ';'; '('; ')']
However, it seems that also the function itself is represented as a static, non-readonly
field:
public static SqlInt32 fuzzyMatch(SqlString strA, SqlString strB);
Maybe using a class instead of a module cures this.