From 26133eac4c1771e99d3f6799ed98c167c2104a48 Mon Sep 17 00:00:00 2001 From: Benjamin Thomas Date: Mon, 6 Nov 2023 09:51:54 +0100 Subject: [PATCH] Improve the `Map` guide: (#1743) - remove references to clear text passwords - use different types for the keys and values --- data/tutorials/language/1ds_02_map.md | 121 +++++++++++++++----------- 1 file changed, 70 insertions(+), 51 deletions(-) diff --git a/data/tutorials/language/1ds_02_map.md b/data/tutorials/language/1ds_02_map.md index 80f065da16..fb3794ad56 100644 --- a/data/tutorials/language/1ds_02_map.md +++ b/data/tutorials/language/1ds_02_map.md @@ -11,40 +11,44 @@ category: "Data Structures" ## Module Map Map creates a "mapping". For instance, let's say I have some data that is -users and their associated passwords. I could with the Map module create -a mapping from user names to their passwords. The mapping module not -only does this but it does it fairly efficiently. It also does this in a +fruits and their associated quantities. I could with the Map module create +a mapping from inventory fruit items to their quantity. The mapping module not +only does this, but it does it fairly efficiently. It also does this in a functional way. In the example below I am going to do a mapping from -strings to strings. However, it is possible to do mappings with all +fruits to ints. However, it is possible to do mappings with all different types of data. +Let's first create a `fruit` type and a minimal functor: + +```ocaml +# type fruit = Apple | Orange | Banana;; +type fruit = Apple | Orange | Banana + +# module Fruit = struct + type t = fruit + + let compare = compare + end;; +module Fruit : sig type t = fruit val compare : 'a -> 'a -> int end +``` + To create a Map I can do: ```ocaml -# module MyUsers = Map.Make(String);; -module MyUsers : +# module Stock = Map.Make (Fruit);; +module Stock : sig - type key = string - type 'a t = 'a Map.Make(String).t + type key = fruit + type 'a t = 'a Map.Make(Fruit).t val empty : 'a t - val is_empty : 'a t -> bool - val mem : key -> 'a t -> bool val add : key -> 'a -> 'a t -> 'a t + val add_to_list : key -> 'a -> 'a list t -> 'a list t val update : key -> ('a option -> 'a option) -> 'a t -> 'a t val singleton : key -> 'a -> 'a t val remove : key -> 'a t -> 'a t val merge : (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val for_all : (key -> 'a -> bool) -> 'a t -> bool - val exists : (key -> 'a -> bool) -> 'a t -> bool - val filter : (key -> 'a -> bool) -> 'a t -> 'a t - val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t - val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t val cardinal : 'a t -> int val bindings : 'a t -> (key * 'a) list val min_binding : 'a t -> key * 'a @@ -53,89 +57,104 @@ module MyUsers : val max_binding_opt : 'a t -> (key * 'a) option val choose : 'a t -> key * 'a val choose_opt : 'a t -> (key * 'a) option - val split : key -> 'a t -> 'a t * 'a option * 'a t val find : key -> 'a t -> 'a val find_opt : key -> 'a t -> 'a option val find_first : (key -> bool) -> 'a t -> key * 'a val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option val find_last : (key -> bool) -> 'a t -> key * 'a val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option + val iter : (key -> 'a -> unit) -> 'a t -> unit + val fold : (key -> 'a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc val map : ('a -> 'b) -> 'a t -> 'b t val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t + val filter : (key -> 'a -> bool) -> 'a t -> 'a t + val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t + val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + val split : key -> 'a t -> 'a t * 'a option * 'a t + val is_empty : 'a t -> bool + val mem : key -> 'a t -> bool + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + val for_all : (key -> 'a -> bool) -> 'a t -> bool + val exists : (key -> 'a -> bool) -> 'a t -> bool + val to_list : 'a t -> (key * 'a) list + val of_list : (key * 'a) list -> 'a t val to_seq : 'a t -> (key * 'a) Seq.t val to_rev_seq : 'a t -> (key * 'a) Seq.t val to_seq_from : key -> 'a t -> (key * 'a) Seq.t val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t val of_seq : (key * 'a) Seq.t -> 'a t end + ``` -OK, we have created the module `MyUsers`. Now, let's start putting +OK, we have created the module `Stock`. Now, let's start putting something into it. Where do we start? Well, let's create an empty map to begin with: ```ocaml -# let m = MyUsers.empty;; -val m : 'a MyUsers.t = +# let data = Stock.empty;; +val data : 'a Stock.t = ``` Hummm. An empty map is kind of boring, so let's add some data. ```ocaml -# let m = MyUsers.add "fred" "sugarplums" m;; -val m : string MyUsers.t = +# let data = Stock.add Apple 10 data;; +val data : int Stock.t = ``` -We have now created a new map—again called `m`, thus masking the previous -one—by adding -"fred" and his password "sugarplums" to our previous empty map. +We have now created a new map—again called `data`, thus masking the previous +one—by adding `Apple` and its quantity `10` to our previous empty map. There is a fairly important point to make here. Once we have added the -string "sugarplums" we have fixed the types of mappings that we can do. -This means our mapping in our module `MyUsers` is from strings _to strings_. -If we want a mapping from strings to integers or a mapping from integers -to whatever we will have to create a different mapping. +value `10` we have fixed the types of mappings that we can do. +This means our mapping in our module `Stock` is from fruit _to int_. +If we want a mapping from fruits to strings, we will have to create a different mapping. Let's add in some additional data just for kicks. ```ocaml -# let m = MyUsers.add "tom" "ilovelucy" m;; -val m : string MyUsers.t = -# let m = MyUsers.add "mark" "ocamlrules" m;; -val m : string MyUsers.t = -# let m = MyUsers.add "pete" "linux" m;; -val m : string MyUsers.t = +# let data = data |> Stock.add Orange 30 |> Stock.add Banana 42;; +val data : int Stock.t = ``` -Now that we have some data inside of our map, wouldn't it be nice +Now that we have some data inside our map, wouldn't it be nice to be able to view that data at some point? Let's begin by creating a simple print function. ```ocaml -# let print_user key password = - print_string(key ^ " " ^ password ^ "\n");; -val print_user : string -> string -> unit = +# let string_of_fruit = function + | Apple -> "apple" + | Orange -> "orange" + | Banana -> "banana" +;; +val string_of_fruit : fruit -> string = + +# let print_fruit key value = + print_string (string_of_fruit key ^ " " ^ string_of_int value ^ "\n") +;; +val print_fruit : fruit -> int -> unit = ``` -We have here a function that will take two strings, a key, and a password, +We have here a function that will take a `fruit` key, and a quantity value, and print them out nicely, including a new line character at the end. All we need to do is to have this function applied to our mapping. Here is what that would look like. ```ocaml -# MyUsers.iter print_user m;; -fred sugarplums -mark ocamlrules -pete linux -tom ilovelucy +# Stock.iter print_fruit data;; +apple 10 +orange 30 +banana 42 - : unit = () ``` The reason we put our data into a mapping however is probably so we can quickly find the data. Let's actually show how to do a find. ```ocaml -# MyUsers.find "fred" m;; -- : string = "sugarplums" +# data |> Stock.find Banana;; +- : int = 42 ``` -This should quickly and efficiently return Fred's password: "sugarplums". +This should quickly and efficiently return the quantity of `Banana`: 42.