From e3beb5ea1d259ecb34e560f93c9e598e5c268007 Mon Sep 17 00:00:00 2001 From: Sanchayan Maity Date: Sun, 26 Jan 2020 21:23:28 +0530 Subject: [PATCH] Add folds chapter Some exercises we need to finish and some we also need to revisit. Signed-off-by: Sanchayan Maity --- folds.ipynb | 4748 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 4748 insertions(+) create mode 100644 folds.ipynb diff --git a/folds.ipynb b/folds.ipynb new file mode 100644 index 0000000..87f09a6 --- /dev/null +++ b/folds.ipynb @@ -0,0 +1,4748 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 2, + "metadata": {}, + "outputs": [], + "source": [ + "{-# LANGUAGE TemplateHaskell #-}\n", + "{-# LANGUAGE FlexibleInstances #-}\n", + "{-# LANGUAGE FlexibleContexts #-}\n", + "{-# LANGUAGE RankNTypes #-}\n", + "{-# LANGUAGE ScopedTypeVariables #-}\n", + "{-# LANGUAGE TypeApplications #-}\n", + "{-# LANGUAGE TypeFamilies #-}\n", + "{-# LANGUAGE InstanceSigs #-}\n", + "{-# LANGUAGE OverloadedStrings #-}\n", + "\n", + "import Control.Lens\n", + "import Numeric.Lens\n", + "import Data.Bits.Lens\n", + "import Data.Data.Lens\n", + "\n", + "import Control.Applicative\n", + "import Data.Char as C\n", + "import qualified Data.Map as M\n", + "import qualified Data.Set as S\n", + "import qualified Data.Text as T\n", + "import qualified Data.List as L\n", + "\n", + "data Role\n", + " = Gunner\n", + " | PowderMonkey\n", + " | Navigator\n", + " | Captain\n", + " | FirstMate\n", + " deriving (Show, Eq, Ord)\n", + " \n", + "data CrewMember =\n", + " CrewMember { _name :: String\n", + " , _role :: Role\n", + " , _talents :: [String]\n", + " } deriving (Show, Eq, Ord)\n", + " \n", + "makeLenses ''CrewMember\n", + "\n", + "roster :: S.Set CrewMember\n", + "roster = S.fromList\n", + " [ CrewMember \"Grumpy Roger\" Gunner [\"Juggling\", \"Arbitrage\"]\n", + " , CrewMember \"Long-John Bronze\" PowderMonkey [\"Origami\"]\n", + " , CrewMember \"Salty Steve\" PowderMonkey [\"Charcuterie\"]\n", + " , CrewMember \"One-eyed jack\" Navigator []\n", + " ]" + ] + }, + { + "cell_type": "code", + "execution_count": 17, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "folded :: forall (p :: * -> * -> *) (f1 :: * -> *) (f2 :: * -> *) a. (Indexable Int p, Contravariant f1, Foldable f2, Applicative f1) => p a (f1 a) -> f2 a -> f1 (f2 a)" + ], + "text/plain": [ + "folded :: forall (p :: * -> * -> *) (f1 :: * -> *) (f2 :: * -> *) a. (Indexable Int p, Contravariant f1, Foldable f2, Applicative f1) => p a (f1 a) -> f2 a -> f1 (f2 a)" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "ename": "", + "evalue": "", + "output_type": "error", + "traceback": [ + ":1:11: error:\n • No instance for (Monoid CrewMember) arising from a use of ‘crewMembers’\n • In the second argument of ‘(^.)’, namely ‘crewMembers’\n In the expression: roster ^. crewMembers\n In an equation for ‘it’: it = roster ^. crewMembers" + ] + } + ], + "source": [ + "rosterRoles :: Fold (S.Set CrewMember) Role\n", + "rosterRoles = undefined\n", + "\n", + "crewMembers :: Fold (S.Set CrewMember) CrewMember\n", + "crewMembers = folded\n", + "\n", + ":t folded\n", + "\n", + "-- folded :: Foldable f => Fold (f a) a\n", + "\n", + "roster ^. crewMembers" + ] + }, + { + "cell_type": "code", + "execution_count": 16, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "toListOf :: forall a s. Getting (Endo [a]) s a -> s -> [a]" + ], + "text/plain": [ + "toListOf :: forall a s. Getting (Endo [a]) s a -> s -> [a]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "(^..) :: forall s a. s -> Getting (Endo [a]) s a -> [a]" + ], + "text/plain": [ + "(^..) :: forall s a. s -> Getting (Endo [a]) s a -> [a]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[CrewMember {_name = \"Grumpy Roger\", _role = Gunner, _talents = [\"Juggling\",\"Arbitrage\"]},CrewMember {_name = \"Long-John Bronze\", _role = PowderMonkey, _talents = [\"Origami\"]},CrewMember {_name = \"One-eyed jack\", _role = Navigator, _talents = []},CrewMember {_name = \"Salty Steve\", _role = PowderMonkey, _talents = [\"Charcuterie\"]}]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t toListOf\n", + ":t (^..)\n", + "\n", + "-- toListOf :: Fold s a -> s -> [a]\n", + "-- (^..) :: s -> Fold s a -> [a]\n", + "\n", + "toListOf crewMembers roster" + ] + }, + { + "cell_type": "code", + "execution_count": 18, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "[\"Buried Treasure\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Cutlass\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Gold\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Captain\",\"First Mate\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "Just \"Buried Treasure\" ^.. folded\n", + "\n", + "Nothing ^.. folded\n", + "\n", + "Identity \"Cutlass\" ^.. folded\n", + "\n", + "(\"Rubies\", \"Gold\") ^.. folded\n", + "\n", + "M.fromList [(\"Jack\", \"Captain\"), (\"Will\", \"First Mate\")] ^.. folded" + ] + }, + { + "cell_type": "code", + "execution_count": 23, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "role :: forall (f :: * -> *). Functor f => (Role -> f Role) -> CrewMember -> f CrewMember" + ], + "text/plain": [ + "role :: forall (f :: * -> *). Functor f => (Role -> f Role) -> CrewMember -> f CrewMember" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[PowderMonkey]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[Gunner,PowderMonkey,Navigator,PowderMonkey]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t role\n", + "\n", + "crewRole :: Fold CrewMember Role\n", + "crewRole = role\n", + "\n", + "let jerry = CrewMember \"Jerry\" PowderMonkey [\"Ice Cream Making\"]\n", + "\n", + "jerry ^.. crewRole\n", + "\n", + "-- Lens' s a\n", + "-- becomes\n", + "-- Fold s a\n", + "\n", + "roster ^.. folded . role\n", + "\n", + "-- folded :: Fold (S.Set CrewMember) CrewMember\n", + "-- role :: Fold CrewMember Role" + ] + }, + { + "cell_type": "code", + "execution_count": 25, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "both :: forall (r :: * -> * -> *) (f :: * -> *) a b. (Bitraversable r, Applicative f) => (a -> f b) -> r a a -> f (r b b)" + ], + "text/plain": [ + "both :: forall (r :: * -> * -> *) (f :: * -> *) a b. (Bitraversable r, Applicative f) => (a -> f b) -> r a a -> f (r b b)" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Gemini\",\"Leo\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Albuquerque\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Yosemite\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Leo\",\"Libra\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t both\n", + "\n", + "-- both :: Bitraversable r => Traversal (r a a) (r b b) a b\n", + "-- both :: Bitraversable r => Fold (r a a) a\n", + "\n", + "(\"Gemini\", \"Leo\") ^.. both\n", + "\n", + "Left \"Albuquerque\" ^.. both\n", + "\n", + "Right \"Yosemite\" ^.. both\n", + "\n", + "(\"Gemini\", \"Leo\", \"Libra\") ^.. both" + ] + }, + { + "cell_type": "code", + "execution_count": 31, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "each :: forall s t a b (f :: * -> *). (Each s t a b, Applicative f) => (a -> f b) -> s -> f t" + ], + "text/plain": [ + "each :: forall s t a b (f :: * -> *). (Each s t a b, Applicative f) => (a -> f b) -> s -> f t" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "traverse :: forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)" + ], + "text/plain": [ + "traverse :: forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3,4,5]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3,4,5]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"Made him an offer he couldn't refuse\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t each\n", + "\n", + "-- each :: Each s t a b => Traversal s t a b\n", + "-- each :: Each s s a a => Fold s a\n", + "\n", + ":t traverse\n", + "\n", + "(1, 2, 3, 4, 5) ^.. each\n", + "\n", + "[1, 2, 3, 4, 5] ^.. each\n", + "\n", + "(\"Made him an offer he couldn't refuse\" :: T.Text) ^.. each" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Exercises" + ] + }, + { + "cell_type": "code", + "execution_count": 58, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "[(3,\"Sirens\"),(882,\"Kraken\"),(92,\"Ogopogo\")]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Sirens\",\"Kraken\",\"Ogopogo\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"SirensKrakenOgopogo\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Sirens\",\"Kraken\",\"Ogopogo\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3,4,5,6]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Captain\",\"First Mate\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Why\",\"So\",\"Serious?\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"HelloIt's me\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[(\"Why\",\"So\",\"Serious?\"),(\"This\",\"is\",\"SPARTA\")]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Why\",\"So\",\"Serious?\",\"This\",\"is\",\"SPARTA\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"WhySoSerious?ThisisSPARTA\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Light\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Light\",\"Dark\",\"Happy\",\"Sad\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Light\",\"Happy\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"DarkSad\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Bond\",\"James\",\"Bond\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- 1.\n", + "\n", + "beastSizes :: [(Int, String)]\n", + "beastSizes = [(3, \"Sirens\"), (882, \"Kraken\"), (92, \"Ogopogo\")]\n", + "\n", + "beastSizes ^.. folded\n", + "\n", + "beastSizes ^.. folded . folded\n", + "\n", + "beastSizes ^.. folded . folded . folded\n", + "\n", + "beastSizes ^.. folded . _2\n", + "\n", + "toListOf (folded . folded) [[1, 2, 3], [4, 5, 6]]\n", + "\n", + "toListOf (folded . folded) (S.fromList [(\"Jack\", \"Captain\"), (\"Will\", \"First Mate\")])\n", + "\n", + "(\"Why\", \"So\", \"Serious?\") ^.. each\n", + "\n", + "(\"Hello\" :: String, \"It's me\" :: String) ^.. both . folded\n", + "\n", + "quotes :: [(T.Text, T.Text, T.Text)]\n", + "quotes = [(\"Why\", \"So\", \"Serious?\"), (\"This\", \"is\", \"SPARTA\")]\n", + "\n", + "quotes ^.. each\n", + "quotes ^.. each . each\n", + "quotes ^.. each . each . each\n", + "\n", + "-- 3.\n", + "\n", + "[1, 2, 3] ^.. each\n", + "\n", + "(\"Light\" :: String, \"Dark\" :: String) ^.. _1\n", + "\n", + "[(\"Light\", \"Dark\"), (\"Happy\", \"Sad\")] ^.. each . each\n", + "\n", + "[(\"Light\", \"Dark\"), (\"Happy\", \"Sad\")] ^.. each . _1\n", + "\n", + "[(\"Light\", \"Dark\") :: (String, String), (\"Happy\", \"Sad\") :: (String, String)] ^.. each . _2 . each\n", + "\n", + "(\"Bond\", \"James\", \"Bond\") ^.. each" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Custom Folds" + ] + }, + { + "cell_type": "code", + "execution_count": 62, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "folding :: forall (f1 :: * -> *) (f2 :: * -> *) s a. (Foldable f1, Contravariant f2, Applicative f2) => (s -> f1 a) -> (a -> f2 a) -> s -> f2 s" + ], + "text/plain": [ + "folding :: forall (f1 :: * -> *) (f2 :: * -> *) s a. (Foldable f1, Contravariant f2, Applicative f2) => (s -> f1 a) -> (a -> f2 a) -> s -> f2 s" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[Name {getName = \"Grumpy Roger\"},Name {getName = \"Long-John Breeze\"},Name {getName = \"One-eyed jack\"},Name {getName = \"Filthy Frank\"}]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "newtype Name = Name\n", + " { getName :: String\n", + " } deriving Show\n", + " \n", + "data ShipCrew = ShipCrew\n", + " { _shipName :: Name\n", + " , _captain :: Name\n", + " , _firstMate :: Name\n", + " , _conscripts :: [Name]\n", + " } deriving (Show)\n", + " \n", + "makeLenses ''ShipCrew\n", + "\n", + "-- folding :: Foldable f => (s -> f a) -> Fold s a\n", + ":t folding\n", + "\n", + "collectCrewMembers :: ShipCrew -> [Name]\n", + "collectCrewMembers crew =\n", + " [_captain crew, _firstMate crew] ++ _conscripts crew\n", + " \n", + "crewMembers :: Fold ShipCrew Name\n", + "crewMembers = folding collectCrewMembers\n", + "\n", + "myCrew :: ShipCrew\n", + "myCrew =\n", + " ShipCrew\n", + " { _shipName = Name \"Purple Pearl\"\n", + " , _captain = Name \"Grumpy Roger\"\n", + " , _firstMate = Name \"Long-John Breeze\"\n", + " , _conscripts = [Name \"One-eyed jack\", Name \"Filthy Frank\"]\n", + " }\n", + " \n", + "myCrew ^.. crewMembers" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Mapping over folds" + ] + }, + { + "cell_type": "code", + "execution_count": 67, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "to :: forall (p :: * -> * -> *) (f :: * -> *) s a. (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a" + ], + "text/plain": [ + "to :: forall (p :: * -> * -> *) (f :: * -> *) s a. (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"Two-faced Tony\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"TWO-FACED TONY\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"TWO-FACED TONY\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Grumpy Roger\",\"Long-John Breeze\",\"One-eyed jack\",\"Filthy Frank\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t to\n", + "\n", + "-- Map the end of our fold\n", + "-- to :: (s -> a) -> Fold s a\n", + "\n", + "-- Technically to is actually a Getter rather than a fold, a Getter is just a fold which has this 1-to-1\n", + "-- mapping property, it’s basically the “getter” half of a lens. A Getter can ALWAYS transform an input\n", + "-- into an output. A pure function s -> a shouldn’t ever fail, so we can make this stronger guarantee.\n", + "-- Since we’re guaranteed an output from to we can use it with view or ^. directly.\n", + "\n", + "Name \"Two-faced Tony\" ^. to getName\n", + "\n", + "Name \"Two-faced Tony\" ^. to getName . to (fmap C.toUpper)\n", + "\n", + "Name \"Two-faced Tony\" ^. to (fmap C.toUpper . getName)\n", + "\n", + "myCrew ^.. crewMembers . to getName" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Combining multiple folds" + ] + }, + { + "cell_type": "code", + "execution_count": 70, + "metadata": { + "scrolled": true + }, + "outputs": [ + { + "data": { + "text/html": [ + "shipName :: forall (f :: * -> *). Functor f => (Name -> f Name) -> ShipCrew -> f ShipCrew" + ], + "text/plain": [ + "shipName :: forall (f :: * -> *). Functor f => (Name -> f Name) -> ShipCrew -> f ShipCrew" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "captain :: forall (f :: * -> *). Functor f => (Name -> f Name) -> ShipCrew -> f ShipCrew" + ], + "text/plain": [ + "captain :: forall (f :: * -> *). Functor f => (Name -> f Name) -> ShipCrew -> f ShipCrew" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "firstMate :: forall (f :: * -> *). Functor f => (Name -> f Name) -> ShipCrew -> f ShipCrew" + ], + "text/plain": [ + "firstMate :: forall (f :: * -> *). Functor f => (Name -> f Name) -> ShipCrew -> f ShipCrew" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "conscripts :: forall (f :: * -> *). Functor f => ([Name] -> f [Name]) -> ShipCrew -> f ShipCrew" + ], + "text/plain": [ + "conscripts :: forall (f :: * -> *). Functor f => ([Name] -> f [Name]) -> ShipCrew -> f ShipCrew" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Grumpy Roger\",\"Long-John Breeze\",\"One-eyed jack\",\"Filthy Frank\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t shipName\n", + ":t captain\n", + ":t firstMate\n", + ":t conscripts\n", + "\n", + "crewNames :: Fold ShipCrew Name\n", + "crewNames =\n", + " folding (\\s -> s ^.. captain\n", + " <> s ^.. firstMate\n", + " <> s ^.. conscripts . folded)\n", + " \n", + "myCrew ^.. crewNames . to getName" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "## Exercises - Custom Folds" + ] + }, + { + "cell_type": "code", + "execution_count": 100, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "\"YerawizardHarry\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,4,5]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[[1,2],[4,5]]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"bob\",\"otto\",\"hannah\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"cbafed\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[100,200,300,400,500]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"one\",\"two\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[2]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3,4,5,6,7,8]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[Left 1,Right 2,Left 3,Right 4]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3,4,5,6]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- 1.\n", + "\n", + "-- folding :: Foldable f => (s -> f a) -> Fold s a\n", + "-- Map the end of our fold\n", + "-- to :: (s -> a) -> Fold s a\n", + "\n", + "([\"Yer\", \"a\", \"wizard\", \"Harry\"] :: [String]) ^.. folded . each\n", + "-- ([\"Yer\", \"a\", \"wizard\", \"Harry\"] :: [String]) ^.. folded . folded\n", + "\n", + "[[1, 2, 3], [4, 5, 6]] ^.. folded . folding (take 2)\n", + "\n", + "[[1, 2, 3], [4, 5, 6]] ^.. folded . to (take 2)\n", + "\n", + "[\"bob\", \"otto\", \"hannah\"] ^.. folded . to reverse\n", + "\n", + "(\"abc\", \"def\") ^.. folding (\\(a, b) -> [a, b]). to reverse . folded\n", + "\n", + "-- 2.\n", + "\n", + "[1..5] ^.. folded . to (* 100)\n", + "\n", + "(1, 2) ^.. both\n", + "\n", + "[(1, \"one\"), (2, \"two\")] ^.. folded . _2\n", + "\n", + "(Just 1, Just 2, Just 3) ^.. each . _Just\n", + "\n", + "[Left 1, Right 2, Left 3] ^.. each . _Right\n", + "\n", + "[([1, 2], [3, 4]), ([5, 6], [7, 8])] ^.. folded . each . folded\n", + "\n", + "[1, 2, 3, 4] ^.. folded . to (\\x -> if even x then Right x else Left x)\n", + "\n", + "[(1, (2, 3)), (4, (5, 6))] ^.. folded . folding (\\(a, (b, c)) -> [a, b, c])\n", + "\n", + "-- Couldn't think of these last three by myself :( :(\n", + "\n", + "[(Just 1, Left \"one\"), (Nothing, Right 2)] ^.. folded . folding (\\(a, b) -> a ^.. folded <> b ^.. folded)\n", + "\n", + "[(1, \"one\"), (2, \"two\")] ^.. folded . folding (\\(a, b) -> [Left a, Right b])\n", + "\n", + "S.fromList [\"apricots\", \"apples\"] ^.. folded . folding reverse\n", + "\n", + "-- 3. Bonus\n", + "\n", + "-- [(12, 45, 66), (91, 123, 87)] ^.. _\n", + "-- \"54321\"\n", + "\n", + "-- [(1, \"a\"), (2, \"b\"), (3, \"c\"), (4, \"d\")] ^.. _\n", + "-- [\"b\", \"d\"]" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Fold Actions" + ] + }, + { + "cell_type": "code", + "execution_count": 106, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "False" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "False" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "False" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "False" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 2" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 2" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "False" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "False" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "4" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "10" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "24" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Nothing" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 1" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 1" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 1" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 4" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 1" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 4" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Nothing" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Nothing" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "elemOf folded 3 [1,2,3,4]\n", + "\n", + "elemOf folded 99 [1,2,3,4]\n", + "\n", + "anyOf folded even [1,2,3,4]\n", + "\n", + "anyOf folded (> 10) [1,2,3,4]\n", + "\n", + "allOf folded even [1,2,3,4]\n", + "\n", + "allOf folded (> 10) [1,2,3,4]\n", + "\n", + "findOf folded even [1, 2, 3, 4]\n", + "\n", + "findOf folded even [1, 2, 3, 4]\n", + "\n", + "has folded []\n", + "\n", + "has folded [1, 2]\n", + "\n", + "hasn't folded []\n", + "\n", + "hasn't folded [1, 2]\n", + "\n", + "lengthOf folded [1, 2, 3, 4]\n", + "\n", + "sumOf folded [1, 2, 3, 4]\n", + "\n", + "productOf folded [1, 2, 3, 4]\n", + "\n", + "firstOf folded []\n", + "\n", + "firstOf folded [1, 2, 3, 4]\n", + "\n", + "preview folded [1, 2, 3, 4]\n", + "\n", + "[1, 2, 3, 4] ^? folded\n", + "\n", + "lastOf folded [1, 2, 3, 4]\n", + "\n", + "minimumOf folded [2, 1, 4, 3]\n", + "\n", + "maximumOf folded [2, 1, 4, 3]\n", + "\n", + "minimumOf folded []\n", + "\n", + "maximumOf folded []" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Queries case study" + ] + }, + { + "cell_type": "code", + "execution_count": 107, + "metadata": {}, + "outputs": [], + "source": [ + "data Actor =\n", + " Actor { _name :: String\n", + " , _birthYear :: Int \n", + " } deriving (Show, Eq)\n", + "makeLenses ''Actor\n", + "\n", + "data TVShow =\n", + " TVShow { _title :: String\n", + " , _numEpisodes :: Int\n", + " , _numSeasons :: Int\n", + " , _criticScore :: Double\n", + " , _actors :: [Actor]\n", + " } deriving (Show, Eq)\n", + " \n", + "makeLenses ''TVShow\n", + "\n", + "howIMetYourMother :: TVShow\n", + "howIMetYourMother = TVShow\n", + " { _title = \"How I Met your mother\"\n", + " , _numEpisodes = 208\n", + " , _numSeasons = 9\n", + " , _criticScore = 83\n", + " , _actors =\n", + " [ Actor \"Josh Radnor\" 1974\n", + " , Actor \"Cobie Smulders\" 1982\n", + " , Actor \"Neil Patrick Harris\" 1973\n", + " , Actor \"Alyson Hannigan\" 1974\n", + " , Actor \"Jason Segel\" 1980\n", + " ]\n", + " }\n", + " \n", + "buffy :: TVShow\n", + "buffy = TVShow\n", + " { _title = \"Buffy the Vampire Slayer\"\n", + " , _numEpisodes = 144\n", + " , _numSeasons = 7\n", + " , _criticScore = 81\n", + " , _actors =\n", + " [ Actor \"Sarah Michelle Gellar\" 1977\n", + " , Actor \"Alysson Hannigan\" 1974\n", + " , Actor \"Nicholas Brendon\" 1971\n", + " , Actor \"David Boreanaz\" 1969\n", + " , Actor \"Anthony Head\" 1954\n", + " ]\n", + " }\n", + " \n", + "tvShows :: [TVShow]\n", + "tvShows = [ howIMetYourMother\n", + " , buffy\n", + " ]" + ] + }, + { + "cell_type": "code", + "execution_count": 117, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "352" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 83.0" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "maximumByOf :: forall a s. Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a" + ], + "text/plain": [ + "maximumByOf :: forall a s. Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just \"How I Met your mother\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just (Actor {_name = \"Anthony Head\", _birthYear = 1954})" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just (Actor {_name = \"Anthony Head\", _birthYear = 1954})" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "sumOf (folded . numEpisodes) tvShows\n", + "\n", + "maximumOf (folded . criticScore) tvShows\n", + "\n", + "-- maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a\n", + "-- maximumByOf :: Fold s a -> (a -> a -> Ordering) -> s -> Maybe a\n", + "\n", + ":t maximumByOf\n", + "\n", + "import Data.Ord (comparing)\n", + "\n", + "_title <$> maximumByOf folded (comparing _criticScore) tvShows\n", + "\n", + "minimumByOf (folded . actors . folded) (comparing _birthYear) tvShows\n", + "\n", + "comparingOf :: Ord a => Lens' s a -> s -> s -> Ordering\n", + "comparingOf l = comparing (view l)\n", + "\n", + "minimumByOf (folded . actors . folded) (comparingOf birthYear) tvShows" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Folding with Effects" + ] + }, + { + "cell_type": "code", + "execution_count": 121, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "traverseOf_ :: forall (f :: * -> *) r s a. Functor f => Getting (Traversed r f) s a -> (a -> f r) -> s -> f ()" + ], + "text/plain": [ + "traverseOf_ :: forall (f :: * -> *) r s a. Functor f => Getting (Traversed r f) s a -> (a -> f r) -> s -> f ()" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "forOf_ :: forall (f :: * -> *) r s a. Functor f => Getting (Traversed r f) s a -> s -> (a -> f r) -> f ()" + ], + "text/plain": [ + "forOf_ :: forall (f :: * -> *) r s a. Functor f => Getting (Traversed r f) s a -> s -> (a -> f r) -> f ()" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Josh Radnor: 56\n", + "Cobie Smulders: 48\n", + "Neil Patrick Harris: 57\n", + "Alyson Hannigan: 56\n", + "Jason Segel: 50\n", + "Sarah Michelle Gellar: 53\n", + "Alysson Hannigan: 56\n", + "Nicholas Brendon: 59\n", + "David Boreanaz: 61\n", + "Anthony Head: 76" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()\n", + "-- for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()\n", + "\n", + ":t traverseOf_\n", + ":t forOf_\n", + "\n", + "-- traverseOf_ :: Functor f => Fold s a -> (a -> f r) -> s -> f ()\n", + "-- forOf_ :: Functor f => Fold s a -> s -> (a -> f r) -> f ()\n", + "\n", + "calcAge :: Actor -> Int\n", + "calcAge actor = 2030 - _birthYear actor\n", + "\n", + "showActor :: Actor -> String\n", + "showActor actor = _name actor <> \": \" <> show (calcAge actor)\n", + "\n", + "traverseOf_ (folded . actors . folded . to showActor) putStrLn tvShows" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Combining fold results" + ] + }, + { + "cell_type": "code", + "execution_count": 131, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "foldOf :: forall a s. Getting a s a -> s -> a" + ], + "text/plain": [ + "foldOf :: forall a s. Getting a s a -> s -> a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "foldMapOf :: forall r s a. Getting r s a -> (a -> r) -> s -> r" + ], + "text/plain": [ + "foldMapOf :: forall r s a. Getting r s a -> (a -> r) -> s -> r" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "(Sum {getSum = 10},Sum {getSum = 572})" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "57.2" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "57.2" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- foldOf :: Monoid a => Fold s a -> s -> a\n", + "-- foldMapOf :: Monoid r => Fold s a -> (a -> r) -> s -> r\n", + "\n", + ":t foldOf\n", + ":t foldMapOf\n", + "\n", + "import Data.Monoid\n", + "\n", + "ageSummary :: Actor -> (Sum Int, Sum Int)\n", + "ageSummary actor = (Sum 1, Sum (calcAge actor))\n", + "\n", + "computeAverage :: (Sum Int, Sum Int) -> Double\n", + "computeAverage (Sum count, Sum total) = fromIntegral total / fromIntegral count\n", + "\n", + "foldOf (folded . actors . folded . to ageSummary) tvShows\n", + "computeAverage $ foldOf (folded . actors . folded . to ageSummary) tvShows\n", + "\n", + "computeAverage $ foldMapOf (folded . actors . folded) ageSummary tvShows" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Using view on folds" + ] + }, + { + "cell_type": "code", + "execution_count": 135, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "\"do it\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"do it\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"onetwothree\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "Just \"do it\" ^. folded\n", + "\n", + "-- Just (42 :: Int) ^. folded\n", + "\n", + "-- When there's a single focus, we just return it\n", + "Just \"do it\" ^. folded\n", + "\n", + "-- When there aren't any focuses, return 'mempty'\n", + "Nothing ^. folded :: String\n", + "\n", + "-- When there are multiple focuses, combine them with (<>).\n", + "(\"one\", \"two\", \"three\") ^. each\n", + "\n", + "-- If we want to fold all focusses together, use foldOf" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Customizing monoidal folds" + ] + }, + { + "cell_type": "code", + "execution_count": 137, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "foldByOf :: forall s a. Fold s a -> (a -> a -> a) -> a -> s -> a" + ], + "text/plain": [ + "foldByOf :: forall s a. Fold s a -> (a -> a -> a) -> a -> s -> a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "foldMapByOf :: forall s a r. Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r" + ], + "text/plain": [ + "foldMapByOf :: forall s a r. Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "foldrOf :: forall r s a. Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r" + ], + "text/plain": [ + "foldrOf :: forall r s a. Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "foldlOf :: forall r s a. Getting (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r" + ], + "text/plain": [ + "foldlOf :: forall r s a. Getting (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "fromList [(\"Alyson Hannigan\",1),(\"Alysson Hannigan\",1),(\"Anthony Head\",1),(\"Cobie Smulders\",1),(\"David Boreanaz\",1),(\"Jason Segel\",1),(\"Josh Radnor\",1),(\"Neil Patrick Harris\",1),(\"Nicholas Brendon\",1),(\"Sarah Michelle Gellar\",1)]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t foldByOf\n", + ":t foldMapByOf\n", + ":t foldrOf\n", + ":t foldlOf\n", + "\n", + "foldMapByOf\n", + " (folded . actors . folded . name) -- Focus each actor's name\n", + " (M.unionWith (+)) -- Combine duplicate keys with addition\n", + " mempty -- start with the empty Map\n", + " (\\n -> M.singleton n 1) -- inject names into Maps with a count of 1\n", + " tvShows" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Exercises - Fold Actions" + ] + }, + { + "cell_type": "code", + "execution_count": 168, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "False" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"YoAdrian\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 2" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 11" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just 22" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just \"racecar\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "True" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just (3,\"Be\")" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "3" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "Just \"there\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"cba\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"54321\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"b\",\"d\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- elemOf :: Eq a => Fold s a -> a -> s -> Bool\n", + "-- has :: Fold s a -> s -> Bool\n", + "-- lengthOf :: Fold s a -> s -> Int\n", + "-- sumOf :: Num n => Fold s n -> s -> n\n", + "-- productOf:: Num n => Fold s n -> s -> n\n", + "-- foldOf :: Monoid a => Fold s a -> s -> a\n", + "-- preview :: Fold s a => s -> Maybe a\n", + "-- lastOf :: Fold s a => s -> Maybe a\n", + "-- minimumOf:: Ord a => Fold s a -> s -> Maybe a\n", + "-- maximumOf:: Ord a => Fold s a -> s -> Maybe a\n", + "-- anyOf :: Fold s a -> (a -> Bool) -> s -> Bool\n", + "-- allOf :: Fold s a -> (a -> Bool) -> s -> Bool\n", + "-- findOf :: Fold s a -> (a -> Bool) -> s -> Maybe a\n", + "-- foldrOf :: Fold s a -> (a -> r -> r) -> r -> s -> r\n", + "-- foldMapOf:: Monoid r => Fold s a -> (a -> r) -> s -> r\n", + "\n", + "-- 1.\n", + "\n", + "has folded []\n", + "\n", + "foldOf both (\"Yo\", \"Adrian\")\n", + "\n", + "elemOf each \"phone\" (\"E.T\", \"phone\", \"home\")\n", + "\n", + "findOf folded even [5,7,2,3,13,17,11]\n", + "\n", + "lastOf folded [5,7,2,3,13,17,11]\n", + "\n", + "anyOf folded ((> 9) . length) [\"Bulbasaur\", \"Charmander\", \"Squirtle\"]\n", + "\n", + "findOf folded even [11, 22, 3, 5, 6]\n", + "\n", + "-- 2.\n", + "\n", + "findOf folded (\\xs -> xs == reverse xs) [\"umbrella\", \"olives\", \"racecar\", \"hammer\"]\n", + "\n", + "allOf each even (2, 4, 6)\n", + "\n", + "import Data.Function\n", + "\n", + "maximumByOf folded (compare `on` fst) [(2, \"I'll\"), (3, \"Be\"), (1, \"Back\")]\n", + "\n", + "getSum $ foldMapOf both Sum (1, 2)\n", + "\n", + "-- 3. Could not solve. Copied :(\n", + "\n", + "maximumByOf (folding words) (compare `on` (length . filter (`elem` \"aeiouy\"))) \"Do or do not, there is no try.\"\n", + "\n", + "foldByOf folded (flip (++)) \"\" [\"a\", \"b\", \"c\"]\n", + "\n", + "[(12, 45, 66), (91, 123, 87)] ^.. folded . _2 . to show . to reverse . folded\n", + "\n", + "[(1, \"a\"), (2, \"b\"), (3, \"c\"), (4, \"d\")] ^.. folded . folding (\\(a, b) -> if (even a) then return b else [])" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Higher Order Folds" + ] + }, + { + "cell_type": "code", + "execution_count": 194, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "taking :: forall (p :: * -> * -> *) (f :: * -> *) s t a. (Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a" + ], + "text/plain": [ + "taking :: forall (p :: * -> * -> *) (f :: * -> *) s t a. (Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "dropping :: forall (p :: * -> * -> *) (f :: * -> *) s t a. (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a" + ], + "text/plain": [ + "dropping :: forall (p :: * -> * -> *) (f :: * -> *) s t a. (Conjoined p, Applicative f) => Int -> Over p (Indexing f) s t a a -> Over p f s t a a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[3,4]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,10,20,100,200]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"AlbDum\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"Alb\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "\"AlbusDumbledore\"" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3,10,20,30]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[3,10,20,30,100,200,300]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[3,30,300]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[100,200,300]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "backwards :: forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) s t a b. (Profunctor p, Profunctor q) => Optical p q (Backwards f) s t a b -> Optical p q f s t a b" + ], + "text/plain": [ + "backwards :: forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) s t a b. (Profunctor p, Profunctor q) => Optical p q (Backwards f) s t a b -> Optical p q f s t a b" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[3,2,1]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"two\",\"one\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[4,3,2,1]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[3,4,1,2]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[2,1,4,3]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "takingWhile :: forall (p :: * -> * -> *) (f :: * -> *) a s t. (Conjoined p, Applicative f) => (a -> Bool) -> Over p (TakingWhile p f a a) s t a a -> Over p f s t a a" + ], + "text/plain": [ + "takingWhile :: forall (p :: * -> * -> *) (f :: * -> *) a s t. (Conjoined p, Applicative f) => (a -> Bool) -> Over p (TakingWhile p f a a) s t a a -> Over p f s t a a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "droppingWhile :: forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a s t. (Conjoined p, Profunctor q, Applicative f) => (a -> Bool) -> Optical p q (Compose (State Bool) f) s t a a -> Optical p q f s t a a" + ], + "text/plain": [ + "droppingWhile :: forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a s t. (Conjoined p, Profunctor q, Applicative f) => (a -> Bool) -> Optical p q (Compose (State Bool) f) s t a a -> Optical p q f s t a a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,2,3,4,5,6,7,8,9]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[1,5]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[90,91,92,93,94,95,96,97,98,99,100]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[15,5,1]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + ":t taking\n", + ":t dropping\n", + "\n", + "-- taking :: Int -> Fold s a -> Fold s a \n", + "-- dropping :: Int -> Fold s a -> Fold s a\n", + "\n", + "[1, 2, 3, 4] ^.. taking 2 folded\n", + "\n", + "[1, 2, 3, 4] ^.. dropping 2 folded\n", + "\n", + "[[1, 2, 3], [10, 20, 30], [100, 200, 300]] ^.. folded . taking 2 folded\n", + "\n", + "(\"Albus\" :: String, \"Dumbledore\" :: String) ^.. both . taking 3 folded\n", + "\n", + "[[1, 2, 3], [10, 20, 30], [100, 200, 300]] ^.. taking 2 (folded . folded)\n", + "\n", + "(\"Albus\" :: String, \"Dumbledore\" :: String) ^.. taking 3 (both . folded)\n", + "\n", + "(\"Albus\" :: String, \"Dumbledore\" :: String) ^.. taking 3 both . folded\n", + "\n", + "[[1, 2, 3], [10, 20, 30], [100, 200, 300]] ^.. (taking 2 folded) . folded\n", + "\n", + "-- ([\"Albus\", \"Dumbledore\"], [\"Severus\", \"Snape\"]) ^.. taking 3 (both . folded)\n", + "\n", + "-- ([\"Albus\", \"Dumbledore\"], [\"Severus\", \"Snape\"]) ^.. taking 3 (both . folded) . folded\n", + " \n", + "[[1, 2, 3], [10, 20, 30], [100, 200, 300]] ^.. dropping 2 (folded . folded)\n", + " \n", + "[[1, 2, 3], [10, 20, 30], [100, 200, 300]] ^.. folded . dropping 2 folded\n", + " \n", + "[[1, 2, 3], [10, 20, 30], [100, 200, 300]] ^.. dropping 2 folded . folded\n", + " \n", + "-- (\"Albus\", \"Dumbledore\") ^.. both . dropping 2 folded\n", + " \n", + "-- (\"Albus\", \"Dumbledore\") ^.. dropping 2 (both . folded)\n", + "\n", + "-- backwards :: Fold s a -> Fold s a\n", + "\n", + ":t backwards\n", + "\n", + "[1, 2, 3] ^.. backwards folded\n", + "\n", + "(\"one\", \"two\") ^.. backwards both\n", + "\n", + "[(1, 2), (3, 4)] ^.. backwards (folded . both)\n", + "\n", + "[(1, 2), (3, 4)] ^.. backwards folded . both\n", + "\n", + "[(1, 2), (3, 4)] ^.. folded . backwards both\n", + "\n", + "-- takingWhile :: (a -> Bool) -> Fold s a -> Fold s a\n", + "-- droppingWhile :: (a -> Bool) -> Fold s a -> Fold s a\n", + "\n", + ":t takingWhile\n", + ":t droppingWhile\n", + "\n", + "[1..100] ^.. takingWhile (<10) folded\n", + "\n", + "[1, 5, 15, 5, 1] ^.. takingWhile (<10) folded\n", + "\n", + "[1..100] ^.. droppingWhile (<90) folded\n", + "\n", + "[1, 5, 15, 5, 1] ^.. droppingWhile (<10) folded" + ] + }, + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Filtering Folds" + ] + }, + { + "cell_type": "code", + "execution_count": 5, + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "filtered :: forall (p :: * -> * -> *) (f :: * -> *) a. (Choice p, Applicative f) => (a -> Bool) -> Optic' p f a a" + ], + "text/plain": [ + "filtered :: forall (p :: * -> * -> *) (f :: * -> *) a. (Choice p, Applicative f) => (a -> Bool) -> Optic' p f a a" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[2,4]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"passionfruit\",\"pomegranate\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "-- filtered :: (s -> Bool) -> Fold s s\n", + "\n", + ":t filtered\n", + "\n", + "[1, 2, 3, 4] ^.. folded . filtered even\n", + "\n", + "[\"apple\", \"passionfruit\", \"orange\", \"pomegranate\"] ^.. folded . filtered ((> 6) . length)\n", + "\n", + "data Card = \n", + " Card { _name :: String\n", + " , _aura :: Aura\n", + " , _holo :: Bool\n", + " , _moves :: [Move]\n", + " } deriving (Show, Eq)\n", + " \n", + "data Aura\n", + " = Wet\n", + " | Hot\n", + " | Spark\n", + " | Leafy\n", + " deriving (Show, Eq)\n", + "\n", + "data Move =\n", + " Move { _moveName :: String\n", + " , _movePower :: Int\n", + " } deriving (Show, Eq)\n", + " \n", + "makeLenses ''Card\n", + "makeLenses ''Move\n", + "\n", + "deck :: [Card]\n", + "deck = [ Card \"Skwortul\" Wet False [Move \"Squirt\" 20]\n", + " , Card \"Scorchander\" Hot False [Move \"Scord\" 20]\n", + " , Card \"Seedasaur\" Leafy False [Move \"Allergize\" 20]\n", + " , Card \"Kapichu\" Spark False [Move \"Poke\" 10, Move \"Zap\" 30]\n", + " , Card \"Elecdude\" Spark False [Move \"Asplode\" 50]\n", + " , Card \"Garydose\" Wet True [Move \"Gary's move\" 40]\n", + " , Card \"Moisteon\" Wet False [Move \"Soggy\" 3]\n", + " , Card \"Grasseon\" Leafy False [Move \"Leaf Cut\" 30]\n", + " , Card \"Spicyeon\" Hot False [Move \"Capsaicisize\" 40]\n", + " , Card \"Sparkeon\" Spark True [Move \"Shock\" 40, Move \"Battery\" 50]\n", + " ]" + ] + }, + { + "cell_type": "code", + "execution_count": 12, + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "3" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "5" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Elecdude\",\"Sparkeon\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "5" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/plain": [ + "[\"Asplode\",\"Shock\",\"Battery\"]" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "lengthOf (folded . aura . filtered (== Spark)) deck\n", + "\n", + "lengthOf (folded . moves . folded . movePower . filtered (> 30)) deck\n", + "\n", + "deck ^.. folded . filtered (anyOf (moves . folded . movePower) (> 40)) . name\n", + "\n", + "lengthOf (folded . filtered ((== Spark) . _aura) . moves . folded) deck\n", + "\n", + "deck ^.. folded . filtered ((== Spark) . _aura) . moves . folded . filtered ((> 30) . _movePower) . moveName " + ] + }, + { + "cell_type": "code", + "execution_count": 14, + "metadata": {}, + "outputs": [], + "source": [ + "-- filteredBy requires lens-4.18.0 \n", + "\n", + "-- filteredBy :: Fold s a -> Fold s s\n", + "\n", + "-- filteredBy :: Fold s a -> IndexedTraversal' a s s\n", + "\n", + "-- filteredBy :: (Indexable i p, Applicative f) => Getting (First i) a i -> p a (f a) -> a -> f a" + ] + } + ], + "metadata": { + "kernelspec": { + "display_name": "Haskell", + "language": "haskell", + "name": "haskell" + }, + "language_info": { + "codemirror_mode": "ihaskell", + "file_extension": ".hs", + "name": "haskell", + "pygments_lexer": "Haskell", + "version": "8.6.5" + } + }, + "nbformat": 4, + "nbformat_minor": 2 +}