Commit 08ebd572 authored by Valentin Reis's avatar Valentin Reis
Browse files

moving the experimental validation code to a notebook.

parent 8cee418a
......@@ -80,7 +80,7 @@ ghcid-test: hbandit.cabal .hlint.yaml hbandit.nix
'
.PHONY: pre-commit
pre-commit: ormolu dhall-format shellcheck src/Bandit/Tutorial.hs README.md
pre-commit: ormolu dhall-format shellcheck README.md
.PHONY: shellcheck
shellcheck:
......@@ -123,7 +123,7 @@ ormolu:
}
' --run bash <<< '
RETURN=0
for F in $$(fd -E src/Bandit/Tutorial.hs -e hs); do
for F in $$(fd -e hs); do
ormolu -o -XTypeApplications -o -XPatternSynonyms -m check $$F
if [ $$? -ne 0 ]; then
echo "[!] $$F does not pass ormolu format check. Formatting.." >&2
......@@ -135,7 +135,7 @@ ormolu:
'
.PHONY: doc
doc: src/Bandit/Tutorial.hs hbandit.cabal hbandit.nix
doc: hbandit.cabal hbandit.nix nbconvert
@nix-shell -E '
with import <nixpkgs> {};
with haskellPackages;
......@@ -147,51 +147,11 @@ doc: src/Bandit/Tutorial.hs hbandit.cabal hbandit.nix
cabal v2-haddock hbandit --haddock-internal
'
.PRECIOUS: src/Bandit/Tutorial.hs
src/Bandit/Tutorial.hs: literate/tutorial.md hbandit.nix src
@nix-shell --pure -E '
with import <nixpkgs> {};
with haskellPackages;
let extra = { mkDerivation, inline-r, pretty-simple, aeson, stdenv }:
mkDerivation {
pname = "extra";
version = "1.0.0";
src = "";
libraryHaskellDepends = [
aeson
inline-r
data-default
pretty-simple
];
description = "extra";
license = stdenv.lib.licenses.bsd3;
};
in
shellFor {
packages = p: [
p.hbandit
(haskellPackages.callPackage extra {})
];
buildInputs = [
inline-r
data-default
aeson
pretty-simple
panhandle
pandoc-citeproc
panpipe
unlit
pandoc
pkgs.which
cabal-install
R];
R_LIBS_SITE = "$${builtins.readFile r-libs-site}";
}
' --run bash <<< '
pandoc --filter $$(which panpipe) --filter $$(which panhandle) -f markdown+lhs -t markdown+lhs $< | unlit -f bird > $@
'
.PHONY: nbconvert
nbconvert:
nix-shell --run "jupyter-nbconvert docs/index.ipynb"
README.md: literate/readme.md
README.md: extras/readme.md
@nix-shell --pure -E '
with import <nixpkgs> {};
with haskellPackages;
......@@ -215,12 +175,15 @@ README.md: literate/readme.md
pandoc -t markdown_strict --filter $$(which pandoc-citeproc) -s $< -o $@
'
.PHONY:ihaskell
ihaskell:
nix-shell default.nix -A ihaskell --run "ihaskell-notebook"
.PHONY:clean
clean:
rm -rf .build
rm -rf dist*
rm -f literate/main.hs
rm -f src/Bandit/Tutorial.hs
rm -f extras/main.hs
rm -f hbandit.nix
rm -f hbandit.cabal
rm -rf dhall-to-cabal
{ pkgs ? import (builtins.fetchTarball
"https://github.com/NixOS/nixpkgs/archive/20.03.tar.gz") { } }:
with pkgs.lib;
{ nixpkgs ? (builtins.fetchTarball
"https://github.com/NixOS/nixpkgs/archive/20.03.tar.gz") }:
let
pkgs = import nixpkgs {
config = {
ihaskell = {
packages = ps:
with ps; [
ihaskell-charts
ihaskell-widgets
ad
Chart
hbandit
Chart-diagrams
lens
protolude
generic-lens
generic-data
refined
command-qq
probability
xls
intervals
neat-interpolation
statistics
random-fu
pretty-simple
];
};
};
overlays = [
(_: pkgs: {
haskellPackages = pkgs.haskell.packages.ghc865.override {
overrides = self: super:
with pkgs.haskell.lib; rec {
ihaskell = unmarkBroken super.ihaskell;
vinyl = doJailbreak (unmarkBroken super.vinyl);
ihaskell-blaze = unmarkBroken super.ihaskell-blaze;
ihaskell-charts = unmarkBroken super.ihaskell-charts;
ihaskell-widgets = unmarkBroken super.ihaskell-widgets;
ihaskell-diagrams = unmarkBroken super.ihaskell-diagrams;
ihaskell-display = unmarkBroken super.ihaskell-display;
hbandit = self.callPackage ./hbandit.nix { };
panpipe = unmarkBroken (doJailbreak super.panpipe);
refined = unmarkBroken super.refined;
dhall-to-cabal = unmarkBroken super.dhall-to-cabal;
lazysmallcheck2012 = null;
panhandle = doJailbreak (dontCheck (self.callCabal2nix "panhandle"
(builtins.fetchTarball
"https://github.com/freuk/panhandle/archive/master.tar.gz")
{ }));
};
};
})
];
};
ormolu = let
source = pkgs.fetchFromGitHub {
owner = "tweag";
......@@ -12,7 +69,8 @@ let
};
in (import source { }).ormolu;
in pkgs // rec {
in with pkgs;
pkgs // rec {
dhall-to-cabal-resources = pkgs.stdenv.mkDerivation {
name = "dhall-to-cabal-resources";
......@@ -20,24 +78,15 @@ in pkgs // rec {
installPhase = "cp -r dhall $out";
};
haskellPackages = pkgs.haskellPackages.override {
overrides = self: super:
with pkgs.haskell.lib; rec {
hbandit = self.callPackage ./hbandit.nix {};
panpipe = unmarkBroken (doJailbreak super.panpipe);
refined = unmarkBroken super.refined;
dhall-to-cabal = unmarkBroken super.dhall-to-cabal;
lazysmallcheck2012 = null;
panhandle = doJailbreak (dontCheck (self.callCabal2nix "panhandle"
(builtins.fetchTarball
"https://github.com/freuk/panhandle/archive/master.tar.gz") { }));
};
};
inherit ormolu;
hlint = haskellPackages.hlint;
hbandit = haskellPackages.hbandit;
ihaskell = pkgs.stdenv.mkDerivation {
name = "my-jupyter";
src = null;
buildInputs = [ pkgs.ihaskell ];
};
r-libs-site = pkgs.runCommand "r-libs-site" {
buildInputs = with pkgs; [
R
......
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
......@@ -18,7 +18,6 @@ description:
hbandit
category: algorithms
build-type: Simple
extra-doc-files: literate/*.png
source-repository head
......@@ -30,7 +29,6 @@ library
Bandit.Exp3
Bandit.Exp4R
Bandit.Types
Bandit.Tutorial
Bandit.Util
hs-source-dirs: src
default-language: Haskell2010
......@@ -63,39 +61,3 @@ library
MonadRandom -any,
lens -any,
generic-lens -any
test-suite test
type: exitcode-stdio-1.0
main-is: ctx.hs
hs-source-dirs: test
default-language: Haskell2010
default-extensions: LambdaCase QuasiQuotes DefaultSignatures
ExistentialQuantification RecordWildCards TypeSynonymInstances
StandaloneDeriving FlexibleInstances TupleSections
MultiParamTypeClasses NoImplicitPrelude OverloadedStrings
OverloadedLists ViewPatterns OverloadedLabels DeriveFunctor
TypeFamilies DeriveAnyClass DeriveGeneric DeriveDataTypeable
DeriveFoldable DerivingStrategies TypeApplications MultiWayIf
TemplateHaskell BlockArguments GADTs FlexibleContexts TypeOperators
DataKinds PolyKinds AllowAmbiguousTypes FunctionalDependencies
UndecidableInstances
ghc-options: -Wall -O0 -Wcompat -Wincomplete-uni-patterns
-Widentities -Wredundant-constraints -Wcpp-undef -fwarn-tabs
-fwarn-unused-imports -fwarn-missing-signatures
-fwarn-name-shadowing -fprint-potential-instances
-fwarn-unused-do-bind -fwarn-wrong-do-bind
-fwarn-incomplete-patterns -Wincomplete-record-updates
-Wmonomorphism-restriction -Wimplicit-prelude
-Wmissing-local-signatures -Wmissing-exported-signatures
-Wmissing-export-lists -Wmissing-home-modules -Widentities
-Wredundant-constraints -Wpartial-fields
build-depends:
base -any,
protolude -any,
random -any,
refined -any,
intervals -any,
MonadRandom -any,
lens -any,
generic-lens -any,
hbandit -any
......@@ -123,7 +123,6 @@ let allmodules =
, "Bandit.Exp3"
, "Bandit.Exp4R"
, "Bandit.Types"
, "Bandit.Tutorial"
, "Bandit.Util"
]
......@@ -180,22 +179,7 @@ in prelude.defaults.Package
}
⫽ common.copts ([] : List Text)
)
, test-suites =
[ prelude.unconditional.test-suite
"test"
( prelude.defaults.TestSuite
⫽ { build-depends =
common.libdep # [ nobound "hbandit" ]
, hs-source-dirs =
[ "test" ]
, type =
types.TestType.exitcode-stdio { main-is = "ctx.hs" }
}
⫽ common.copts ([] : List Text)
)
]
, extra-doc-files =
[ "literate/*.png" ] : List Text
, extra-source-files =
[] : List Text
, license =
......
......@@ -9,10 +9,6 @@ mkDerivation {
base generic-lens intervals lens MonadRandom protolude random
refined
];
testHaskellDepends = [
base generic-lens intervals lens MonadRandom protolude random
refined
];
description = "hbandit";
license = stdenv.lib.licenses.bsd3;
}
the string manipulating bash snippets used in this literate file are:
```{.bash pipe="tee -a execute.sh"}
#usage: cat content | execute.sh section_identifier
echo " putText \"<\$$1\"" >> main.hs
echo " hFlush stdout" >> main.hs
echo '> -- |'
(tee -a main.hs | awk '{print "> -- >>>" $0}') <&0
echo " hFlush stdout" >> main.hs
echo "> -- \$$1"
```
```{.bash pipe="tee -a ggplot.sh"}
#usage: cat content | ggplot.sh filename width height
echo '> -- |'
(tee -a main.hs | awk '{print "> -- >>>" $0}') <&0
echo " putText \"<\$$1\\n<<<literate/$1.png>>\"" >> main.hs
echo " [r| ggsave(\"literate/$1.png\", width=$2, height=$3, units=\"cm\", dpi=96) |]" >> main.hs
echo "> -- \$$1"
```
We print a warning in the output:
> -- Do not modify. This file has been automatically generated from file
> -- `literate/tutorial.md`, your changes will be erased.
cabal packaging for the executable file:
```{.hidden pipe="tee -a Tmodule.hs > /dev/null"}
{- cabal:
build-depends:
protolude
, random
, hbandit
, containers
, generic-lens
, lens
, pretty-simple
, aeson
, base
, text
, refined
, inline-r
, primitive
-}
```
> {-| This module serves as an introduction to the `hbandit` Multi-Armed Bandit
> library. -}
>
> module Bandit.Tutorial (
> -- *** Setup
>
> -- | The code snippets displayed in this tutorial require the following list
> -- of extensions and modules.
```{.haskell pipe="tee -a Tmodule.hs | awk '{print \"> -- > \" $0}' | (echo '> -- |' ;cat - )"}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE QuasiQuotes #-}
import Protolude
import Text.Pretty.Simple
import System.Random
import Data.List.NonEmpty as NonEmpty hiding (init)
import Refined hiding (NonEmpty)
import Refined.Unsafe
import Data.Sequence as Sequence
import Data.Generics.Product
import Prelude ((!!))
import Data.Coerce
import Data.Generics.Labels
import Data.Functor.Compose
import H.Prelude.Interactive
import System.IO hiding (print)
import Control.Monad.Primitive
import qualified Language.R.Instance as R
import Control.Lens
import Bandit
import Bandit.EpsGreedy
import Bandit.Exp3
import qualified Data.Text.Lazy.Encoding as T
import qualified Data.Text.Lazy as T
import Data.Aeson hiding ((.=))
```
```{.haskell pipe="tee -a main.hs | awk '{print \"> -- \" $0}'"}
print' :: (Show a) => a -> IO ()
print' a = Protolude.putText $ "@" <> toS (pShowNoColor a) <> "@"
putText' :: Text -> IO ()
putText' t = Protolude.putText $ "@" <> t <> "@"
rrequire :: (MonadR m, Literal lib a) => lib -> m ()
rrequire p = void [r| suppressMessages(require(p_hs,character.only=TRUE)) |]
rpackages :: [Text]
rpackages = [ "svglite", "dplyr", "tidyr", "purrr", "ggplot2" , "jsonlite"]
main :: IO ()
main = do
R.initialize R.defaultConfig
for_ rpackages rrequire
[r| theme_set(
theme_bw() +
theme(
panel.background = element_rect(fill = "transparent"),
plot.background = element_rect(fill = "transparent", color = NA),
legend.background = element_rect(fill = "transparent"),
legend.box.background = element_rect(fill = "transparent")
)) |]
```
> -- | This tutorial only covers non-contextual bandit algorithms.
>
> -- ** Classes
> --
> -- *** Non-contextual
> --
> -- | The algorithm class for non-contextual bandits is 'Bandit'. This class gives
> -- types for a basic bandit game between a learner and an environment, where the
> -- learner has access to a random generator and is defined via a stateful 'step'
> -- function.
> Bandit.Class.Bandit(..)
>
> -- **** example instance: Epsilon-Greedy
> --
> -- | Let's take a look at the instance for the classic fixed-rate \(\epsilon\)-Greedy
> -- algorithm. The necessary hyperparameters are the number of arms and the rate value,
> -- as the 'EpsGreedyHyper' datatype shows.
> ,Bandit.EpsGreedy.EpsGreedyHyper(..)
>
> -- | Let's use that instance on some toy data with a few rounds.
> --
> -- First, we define the @onePass@ function that takes a deterministic oblivious adversary
> -- (represented as a list of of @ a->l @), an initial random generator for the bandit,
> -- a hyperparameter, and runs the bandit game on all the iterations of the adversary
> -- to produces a history of lossses and actions:
```{.haskell pipe="tee -a Tmodule.hs | awk '{print \"> -- > \" $0}' | (echo '> -- | ' ;cat - )"}
data GameState b a l
= GameState
{ historyActions :: NonEmpty a,
historyLosses :: Seq l,
bandit :: b,
stdGen :: StdGen
}
deriving (Generic, Show)
onePass :: (Bandit b hyper a l) =>
hyper -> -- ^ hyperparameter
StdGen -> -- ^ random generator initial value
[(a -> l)] -> -- ^ oblivious deterministic adversary
GameState b a l
onePass hyper g adversary = runGame initialGame
where
(initialBanditState, initialAction, g') = Bandit.init g hyper
initialGame = GameState
{ historyActions = [initialAction],
historyLosses = [],
bandit = initialBanditState,
stdGen = g'
}
runGame = execState game
game = for_ adversary iteration
iteration actionToLoss = do
(actionToLoss . NonEmpty.head -> loss) <- use #historyActions
oldGen <- use #stdGen
(action, newGen) <- zoom #bandit $ step oldGen loss
#stdGen .= newGen
#historyActions %= (action NonEmpty.<|)
#historyLosses %= (loss Sequence.<|)
```
> -- | Specializing this to the 'EpsGreedy' datatype on a small toy dataset, using a fixed rate:
```{.haskell pipe="tee -a Tmodule.hs | awk '{print \"> -- > \" $0}' | (echo '> -- | ' ;cat - )"}
runOnePassEG :: StdGen -> GameState (EpsGreedy Bool FixedRate) Bool Double
runOnePassEG g = onePass hyper g (getZipList $ f <$> ZipList [40, 2, 10] <*> ZipList [4, 44 ,3] )
where
f a b = \case True -> a; False -> b
hyper = EpsGreedyHyper {rateRep = (FixedRate 0.5), arms = Bandit.Arms [True, False]}
printOnePassEG :: IO ()
printOnePassEG = putText $
"Action series:" <>
show (historyActions gs ^.. traversed) <>
"\nLoss series:" <>
show ( historyLosses gs ^.. traversed)
where gs = runOnePassEG (mkStdGen 1)
```
```{.haskell pipe="bash execute.sh eg"}
printOnePassEG
```
> -- *** Contextual
> --
> -- | The algorithm class for contextual bandits is 'ContextualBandit'. This
> -- class gives types for a bandit game between a learner and an environment
> -- with context, where the learner has access to a random generator and is
> -- defined via a stateful 'step' function.
> , Bandit.Class.ContextualBandit(..)
> -- | The 'ExpertRepresentation' class is used to encode experts.
> , Bandit.Class.ExpertRepresentation(..)
> -- ** Non-contextual algorithm comparison
> -- | This subsection runs bandit experiments on an example dataset with some of the @Bandit@ instances.
> -- The data for this tutorial is generated in R using the [inline-r](https://hackagehaskell.org/package/inline-r) package.
> -- Let's define a simple problem with three gaussian arms. We will threshold all cost values to \(\left[0,1\right]\).
```{.haskell pipe="tee -a Tmodule.hs | awk '{print \"> -- > \" $0}' | (echo '> -- | ' ;cat - )"}
generateGaussianData ::
Int -> -- ^ number of rounds
[ZeroOne Double] -> -- ^ arm averages
IO [[Double]] -- ^ dataset
generateGaussianData (fromInteger . toInteger -> n :: Double) avgs =
(mapM generate (unrefine <$> avgs ))
where
generate :: (MonadR m, Functor m) => Double -> m [Double]
generate mu = gen01TS mu <&> fromSomeSEXP
gen01TS :: (MonadR m) => Double -> m (SomeSEXP (PrimState m))
gen01TS mu = [r| pmax(0,pmin(1,rnorm(n_hs, mean=mu_hs, sd=0.1))) |]
refineDataset :: [[Double]] -> [[ZeroOne Double]]
refineDataset = (fmap.fmap) unsafeRefine
```
> -- Let's generate data for a 3 arm problem and observe the distribution of costs.
```{.haskell pipe="bash execute.sh summaryProblem"}
dataset <- generateGaussianData 400 (unsafeRefine <$> [0.1, 0.5, 0.6])
let d :: Text
d = show $ Protolude.transpose dataset
[r| print(summary(jsonlite::fromJSON(d_hs))) |]
```
```{.haskell pipe="bash ggplot.sh summaryPlot 15 7 "}
[r|
data <- as.data.frame(jsonlite::fromJSON(d_hs))
data_mutated = data %>% gather("arm", "cost", 1:ncol(data))
ggplot(data_mutated, aes(arm, cost, group=factor(arm)))+ geom_boxplot()
|]
```
> -- | Here is helper that convert to the @[action->loss]@ adversary format:
```{.haskell pipe="tee -a Tmodule.hs | awk '{print \"> -- > \" $0}' | (echo '> -- | ' ;cat - ) "}
toAdversary :: [[a]] -> [Int -> a]
toAdversary xss = Protolude.transpose xss <&> listToAdversary
where
listToAdversary :: [a] -> Int -> a
listToAdversary l i = l Prelude.!! i
```
> -- | Let's define some experiments:
```{.haskell pipe="tee -a Tmodule.hs | awk '{print \"> -- > \" $0}' | (echo '> -- | ' ;cat - ) "}
exp3 :: [[Double]] -> StdGen -> GameState (Exp3 Int) Int (ZeroOne Double)
exp3 dataset g =
onePass
(Bandit.Arms [0..2])
g
(toAdversary $ refineDataset dataset)
greedy :: (Rate r) => [[Double]] -> StdGen -> r -> GameState (EpsGreedy Int r) Int (Double)
greedy dataset g r =
onePass
(EpsGreedyHyper {rateRep = r, arms = Bandit.Arms [0..2]})
g
(toAdversary dataset)
data SimResult t = SimResult {
t :: t Int,
seed :: t Int,
greedy05 :: t Double,
greedy03 :: t Double,
greedysqrt05 :: t Double,
exp3pf :: t Double
} deriving (Generic)
simulation :: Int -> Int -> IO (SimResult [])
simulation tmax seed@(mkStdGen -> g) = do
dataset <- generateGaussianData tmax (unsafeRefine <$> [0.1, 0.5, 0.6])
return $ SimResult {
t = [1 .. tmax],
seed = Protolude.replicate tmax seed,