From ae63193921e0e15a9c2db03c1120ae7aacd59b49 Mon Sep 17 00:00:00 2001 From: Jakub Svec Date: Wed, 26 Feb 2025 09:16:55 -0800 Subject: [PATCH] update option.md with small tweaks and additional examples --- data/tutorials/language/3ds_00_options.md | 297 ++++++++++++++++++++-- 1 file changed, 270 insertions(+), 27 deletions(-) diff --git a/data/tutorials/language/3ds_00_options.md b/data/tutorials/language/3ds_00_options.md index 703cef6c4b..cabd183b23 100644 --- a/data/tutorials/language/3ds_00_options.md +++ b/data/tutorials/language/3ds_00_options.md @@ -8,7 +8,7 @@ category: "Data Structures" ## Introduction -An [option](https://en.wikipedia.org/wiki/Option_type) value wraps another value or contains nothing if there isn't anything to wrap. The predefined type `option` represents such values. +An [option](https://en.wikipedia.org/wiki/Option_type) value wraps another value or contains nothing if there isn't anything to wrap. The predefined variant type `option` represents such values. ```ocaml @@ -16,7 +16,7 @@ An [option](https://en.wikipedia.org/wiki/Option_type) value wraps another value type 'a option = None | Some of 'a ``` -Here are option values: +Here are examples of option values: ```ocaml # Some 42;; @@ -30,7 +30,7 @@ Here we have: * 42, stored inside an `option` using the `Some` constructor and * the `None` value, which doesn't store anything. -The option type is useful when the lack of data is better handled as the special value `None` rather than an exception. It is the type-safe version of returning error values. Since no wrapped data has any special meaning, confusion between regular values and the absence of value is impossible. +The option type is useful when the lack of data is better handled as the special value `None` rather than an exception. It is the type-safe version of returning error values. Since data wrapped in an option has a special meaning, confusion between values and the absence of values is impossible. ## Exceptions _vs_ Options @@ -52,7 +52,7 @@ Most of the functions in this section, as well as other useful ones, are provide ### Map Over an Option -Using pattern matching, it is possible to define functions, allowing to work with option values. Here is `map` of type `('a -> 'b) -> 'a option -> 'b option`. It allows to apply a function to the wrapped value inside an `option`, if present: +Using pattern matching, it is possible to define functions, allowing us to work with option values. For example, lets define a custom `map` function of type `('a -> 'b) -> 'a option -> 'b option` that allows us to apply a function to the wrapped value inside an `option` (if present): ```ocaml let map f = function @@ -60,7 +60,7 @@ let map f = function | Some v -> Some (f v) ``` -In the standard library, this is `Option.map`. +Our custom `map` function is the same a the standard library's `Option.map`: ```ocaml # Option.map (fun x -> x * x) (Some 3);; @@ -70,9 +70,47 @@ In the standard library, this is `Option.map`. - : int option : None ``` -### Peel-Off Doubly Wrapped Options +The following are a few simple examples demonstrating how the `Option.map` function works with different types and transformations: -Here is `join` of type `'a option option -> 'a option`. It peels off one layer from a doubly wrapped option: +**Example 1**: Incrementing an Integer + +If there is a value inside `Some`, it gets incremented. If `None`, it remains `None`. + +```ocaml +# Option.map (fun x -> x + 1) (Some 5);; +- : int option = Some 6 + +# Option.map (fun x -> x + 1) None;; +- : int option = None +``` + +**Example 2**: Extracting the First Character of a String + +If there is a string inside `Some`, it extracts the first character. If `None`, it stays `None`. + +```ocaml +# Option.map (fun s -> String.get s 0) (Some "hello");; +- : char option = Some 'h' + +# Option.map (fun s -> String.get s 0) None;; +- : char option = None +``` + +**Example 3**: Doubling Each Element in an Option of a List + +Here, `map` is applied to a list inside `Some`, doubling each number. If `None`, the list transformation doesn't occur. + +```ocaml +# Option.map (List.map (fun x -> x * 2)) (Some [1; 2; 3]);; +- : int list option = Some [2; 4; 6] + +# Option.map (List.map (fun x -> x * 2)) None;; +- : int list option = None +``` + +### Peel Off Doubly Wrapped Options + +Sometimes we may encounter a value that is wrapped in multiple options. Lets define a custom `join` function of type `'a option option -> 'a option` that peels off one layer from a doubly wrapped option: ```ocaml let join = function @@ -81,7 +119,7 @@ let join = function | None -> None ``` -In the standard library, this is `Option.join`. +Our custom `join` function is the same a the standard library's `Option.join`: ```ocaml # Option.join (Some (Some 42));; @@ -94,31 +132,120 @@ In the standard library, this is `Option.join`. - : 'a option = None ``` -### Access the Content of an Option +Here are additional examples demonstrating how `Option.join` works in different scenarios: + +**Example 1**: Removing One Layer of Wrapping -The function `get` of type `'a option -> 'a` allows access to the value contained inside an `option`. +If `Some (Some v)`, `join` extracts `v` and returns `Some v`. If `Some None` or `None`, it returns `None`. ```ocaml -let get = function - | Some v -> v - | None -> raise (Invalid_argument "option is None") +# Option.join (Some (Some "hello"));; +- : string option = Some "hello" + +# Option.join (Some None);; +- : 'a option = None + +# Option.join None;; +- : 'a option = None +``` + +**Example 2**: Nested Option with a Computation + +Here, `safe_divide` may return `Some` or `None`. `Option.join` ensures we don’t get `Some None`. + +```ocaml +# let safe_divide x y = if y = 0 then None else Some (x / y);; +val safe_divide : int -> int -> int option = + +# Option.join (Some (safe_divide 10 2));; +- : int option = Some 5 + +# Option.join (Some (safe_divide 10 0));; +- : int option = None + +# Option.join None;; +- : int option = None +``` + +### Extract the Content of an Option + +We will also want to extract the contents of a value wrapped in an option. Lets define a custom `get` function of type `'a option -> 'a` that allows us to access to the value contained inside an `option`: + +```ocaml +# let get = function + | Some v -> v + | None -> raise (Invalid_argument "option is None");; +val get : 'a option -> 'a = ``` Beware, `get o` throws an exception if `o` is `None`. To access the content of an `option` without the risk of raising an exception, the function `value` of type `'a option -> 'a -> 'a` can be used: ```ocaml -let value opt ~default = match opt with - | Some v -> v - | None -> default +# let value opt ~default = match opt with + | Some v -> v + | None -> default;; +val value : 'a option -> default:'a -> 'a = ``` However, it needs a default value as an additional parameter. In the standard library, these functions are `Option.get` and `Option.value`. +Here are examples demonstrating the usage of `Option.get` and `Option.value`: + +**Example 1**: Extracting a Value with `Option.get` + +```ocaml +# Option.get (Some 42);; +- : int = 42 +``` + +The function successfully retrieves the value inside `Some 42`. + +```ocaml +# Option.get None;; +Exception: Invalid_argument "Option.get". +``` + +Since `None` has no value, `Option.get` raises an exception. + +**Example 2**: Extracting a Value with `Option.value` and a Default + +```ocaml +# Option.value (Some "hello") ~default:"default";; +- : string = "hello" +``` + +The function returns `"hello"` because the option contains a value. + +```ocaml +# Option.value None ~default:"default";; +- : string = "default" +``` + +Since the option is `None`, it returns the provided default value. + +**Example 3**: Using `Option.value` for Safe Extraction + +```ocaml +# let username = Some "alice";; +val username : string option = Some "alice" + +# let display_name = Option.value username ~default:"Guest";; +val display_name : string = "alice" + +# let missing_username = None;; +val missing_username : string option = None + +# let display_name = Option.value missing_username ~default:"Guest";; +val display_name : string = "Guest" +``` + +These examples highlight the difference: `Option.get` is unsafe and raises an exception on `None`, while `Option.value` allows fallback behavior. + ### Fold an Option -The function `fold` of type `none:'a -> some:('b -> 'a) -> 'b option -> 'a` can be seen as a combination of `map` and `value` +The function `fold` of type `none:'a -> some:('b -> 'a) -> 'b option -> 'a` can be seen as a combination of `map` and `value`: ```ocaml let fold ~none ~some o = o |> Option.map some |> Option.value ~default:none @@ -138,7 +265,7 @@ The `Option.fold` function can be used to implement a fall-back logic without wr val path : unit -> string list = ``` -Here is the same function, using `Option.fold`: +Here is the same function, using the standard library's `Option.fold`: ```ocaml # let path () = @@ -147,23 +274,139 @@ Here is the same function, using `Option.fold`: val path : unit -> string list = ``` -### Bind an Option +The following are additional examples demonstrating the use of `Option.fold`: + +**Example 1**: Applying a Function to `Some`, Using a Default for `None` -The `bind` function of type `'a option -> ('a -> 'b option) -> 'b option` works a bit like `map`. But whilst `map` expects a function parameter `f` that returns an unwrapped value of type `b`, `bind` expects an `f` that returns a value already wrapped in an option `'b option`. +```ocaml +# Option.fold ~none:0 ~some:(fun x -> x * 2) (Some 5);; +- : int = 10 +``` +Since the option contains `Some 5`, `fold` applies the function `fun x -> x * 2`, resulting in `10`. + +```ocaml +# Option.fold ~none:0 ~some:(fun x -> x * 2) None;; +- : int = 0 +``` -Here, we display the type of `Option.map`, with parameters flipped and show a possible implementation of `Option.bind`. +Since the option is `None`, `fold` returns the default value `0`. +**Example 2**: Extracting String Length or Defaulting to Zero ```ocaml -# Fun.flip Option.map;; -- : 'a option -> ('a -> 'b) -> 'b option = +# let string_length_opt = Some "hello";; +val string_length_opt : string option = Some "hello" + +# Option.fold ~none:0 ~some:String.length string_length_opt;; +- : int = 5 +``` + +Here, `Option.fold` applies `String.length` to `"hello"`, returning `5`. + +```ocaml +# let missing_string = None;; +val missing_string : string option = None + +# Option.fold ~none:0 ~some:String.length missing_string;; +- : int = 0 +``` + +Since `None` is given, it returns the default `0`. + +**Example 3**: Handling Optional User Input + +This function safely handles optional names by providing a fallback greeting: + +```ocaml +# let greet name_opt = + Option.fold ~none:"Hello, Guest!" ~some:(fun name -> "Hello, " ^ name ^ "!") +;; +val greet : string option -> string = + +# greet (Some "Alice");; +- : string = "Hello, Alice!" + +# greet None;; +- : string = "Hello, Guest!" +``` + +### Bind an Option + +The `bind` function of type `'a option -> ('a -> 'b option) -> 'b option` works a bit like `map`. But whilst `map` expects a function parameter `f` that returns an unwrapped value of type `b`, `bind` expects a function `f` that returns a value already wrapped in an option `'b option`. -# let bind o f = o |> Option.map f |> Option.join;; +Lets try to implement a custom `bind` function: + +```ocaml +# let bind o f = + match o with + | Some v -> (f v) + | None -> None;; val bind : 'a option -> ('a -> 'b option) -> 'b option = ``` +In the standard library, this function is `Option.fold`. -Observe that the types are the same, except for the codomain of the function parameter. +The following are simple examples demonstrating the use of `Option.bind`: -## Conclusion +**Example 1**: Safe Division + +Here, `bind` ensures that division by zero safely returns `None` instead of raising an exception: + +```ocaml +# let safe_div x y = + if y = 0 then None else Some (x / y);; +val safe_div : int -> int -> int option = + +# Option.bind (Some 10) (fun x -> safe_div x 2);; +- : int option = Some 5 + +# Option.bind (Some 10) (fun x -> safe_div x 0);; +- : int option = None + +# Option.bind None (fun x -> safe_div x 2);; +- : int option = None +``` + +**Example 2**: Extracting and Transforming Nested Options + +Here, `bind` is used to wrap a value returned by a function in an option: + +```ocaml +# let find_user user_id = + if user_id = 1 then Some "Alice" else None;; +val find_user : int -> string option = -By the way, any type where `map` and `join` functions can be implemented, with similar behaviour, can be called a _monad_, and `option` is often used to introduce monads. But don't freak out! You don't need to know what a monad is to use the `option` type. +# let user_to_email username = + if username = "Alice" then Some "alice@example.com" else None;; +val user_to_email : string -> string option = + +# Option.bind (find_user 1) user_to_email;; +- : string option = Some "alice@example.com" + +# Option.bind (find_user 2) user_to_email;; +- : string option = None +``` + +Notice how the function `user_to_email` does not require explicit pattern-matching on the option returned by `find_user`. With `Option.bind`, we can let the `bind` function handle the unwrapping for us. + +**Example 3**: Chaining Computations + +This example retrieves a configuration value and ensures it falls within a valid range. + +```ocaml +# let lookup_config key = + if key = "timeout" then Some 30 else None;; +val lookup_config : string -> int option = + +# let validate_timeout t = + if t > 0 && t < 60 then Some t else None;; +val validate_timeout : int -> int option = + +# Option.bind (lookup_config "timeout") validate_timeout;; +- : int option = Some 30 + +# Option.bind (lookup_config "unknown_key") validate_timeout;; +- : int option = None +``` + +## Conclusion +The `option` type in OCaml provides a powerful and type-safe way to represent values that may be absent, avoiding the pitfalls of exceptions. By leveraging functions such as `map`, `join`, `get`, `value`, `fold`, and `bind`, we can work with optional values in a structured and expressive manner. These utilities enable functional-style programming while maintaining safety and composability. The `Option` module in the standard library encapsulates these patterns, making it easier to write clear, concise, and robust code when dealing with optional values.