From 7f72a44157581d4f7f37d3627abb63749b9b9793 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 15 Sep 2019 22:03:01 -0400 Subject: Implemented function memoization. --- stdlib/source/lux/control/function/memo.lux | 62 ++++++++++++++++++++++++ stdlib/source/lux/data/text/format.lux | 39 +++++++-------- stdlib/source/test/lux/control.lux | 11 ++++- stdlib/source/test/lux/control/function/memo.lux | 57 ++++++++++++++++++++++ 4 files changed, 147 insertions(+), 22 deletions(-) create mode 100644 stdlib/source/lux/control/function/memo.lux create mode 100644 stdlib/source/test/lux/control/function/memo.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/control/function/memo.lux b/stdlib/source/lux/control/function/memo.lux new file mode 100644 index 000000000..975d03148 --- /dev/null +++ b/stdlib/source/lux/control/function/memo.lux @@ -0,0 +1,62 @@ +## Inspired by; +## "The Different Aspects of Monads and Mixins" by Bruno C. d. S. Oliveira + +(.module: + [lux #* + [abstract + [hash (#+ Hash)] + [monad (#+ do)]] + [control + ["." state (#+ State)]] + [data + ["." product] + [collection + ["." dictionary (#+ Dictionary)]]]] + ["." // #_ + ["#" mixin (#+ Mixin Recursive)]]) + +(def: #export memoization + (All [i o] + (Mixin (-> i (State (Dictionary i o) o)))) + (function (_ delegate recur) + (function (_ input) + (do state.monad + [memory state.get] + (case (dictionary.get input memory) + (#.Some output) + (wrap output) + + #.None + (do @ + [output (delegate input) + _ (state.update (dictionary.put input output))] + (wrap output))))))) + +(type: #export (Memo i o) + (Recursive i (State (Dictionary i o) o))) + +(def: #export (open memo) + {#.doc (doc "Memoization where the memoized results can be re-used accross invocations.")} + (All [i o] + (-> (Memo i o) (-> [(Dictionary i o) i] [(Dictionary i o) o]))) + (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo)))] + (function (_ [memory input]) + (|> input memo (state.run memory))))) + +(def: #export (closed hash memo) + {#.doc (doc "Memoization confined to a single invocation to the function (not counting any subsequent recursive invocations)." + "Memoized results will be re-used during recursive invocations, but cannot be accessed after the main invocation has ended.")} + (All [i o] + (-> (Hash i) (Memo i o) (-> i o))) + (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo))) + empty (dictionary.new hash)] + (|>> memo (state.run empty) product.right))) + +(def: #export (none hash memo) + {#.doc (doc "No memoization at all." + "This is useful as a test control when measuring the effect of using memoization.")} + (All [i o] + (-> (Hash i) (Memo i o) (-> i o))) + (let [memo (//.mixin (//.from-recursive memo)) + empty (dictionary.new hash)] + (|>> memo (state.run empty) product.right))) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index a6dd67617..99dbc2a73 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -45,29 +45,26 @@ (Format ) )] - [bit Bit (:: bit.codec encode)] - [nat Nat (:: nat.decimal encode)] - [int Int (:: int.decimal encode)] - [rev Rev (:: rev.decimal encode)] - [frac Frac (:: frac.decimal encode)] - [ratio ratio.Ratio (:: ratio.codec encode)] - [text Text text.encode] - [name Name (:: name.codec encode)] - [code Code code.to-text] - [type Type type.to-text] - [bin Nat (:: nat.binary encode)] - [oct Nat (:: nat.octal encode)] - [hex Nat (:: nat.hex encode)] - [xml xml.XML (:: xml.codec encode)] - [json json.JSON (:: json.codec encode)] - [instant instant.Instant instant.to-text] - [date date.Date (:: date.codec encode)] + [bit Bit (:: bit.codec encode)] + [nat Nat (:: nat.decimal encode)] + [int Int (:: int.decimal encode)] + [rev Rev (:: rev.decimal encode)] + [frac Frac (:: frac.decimal encode)] + [ratio ratio.Ratio (:: ratio.codec encode)] + [text Text text.encode] + [name Name (:: name.codec encode)] + [code Code code.to-text] + [type Type type.to-text] + [bin Nat (:: nat.binary encode)] + [oct Nat (:: nat.octal encode)] + [hex Nat (:: nat.hex encode)] + [xml xml.XML (:: xml.codec encode)] + [json json.JSON (:: json.codec encode)] + [instant instant.Instant instant.to-text] + [duration duration.Duration duration.encode] + [date date.Date (:: date.codec encode)] ) -(def: #export duration - (Format duration.Duration) - duration.encode) - (def: #export (cursor [file line column]) (Format Cursor) (|> (.list (..text file) (..nat line) (..nat column)) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 12c906664..ace450eba 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- function) ["_" test (#+ Test)]] ["." / #_ ["#." continuation] @@ -24,6 +24,8 @@ ["#/." cli]] [security ["#." policy]] + [function + ["#." memo]] ]) (def: concurrency @@ -49,6 +51,12 @@ /policy.test )) +(def: function + Test + ($_ _.and + /memo.test + )) + (def: #export test Test ($_ _.and @@ -66,4 +74,5 @@ ..concurrency ..parser ..security + ..function )) diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux new file mode 100644 index 000000000..5b5c91271 --- /dev/null +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -0,0 +1,57 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract/monad (#+ do)] + ["%" data/text/format (#+ format)] + [control + ["." io (#+ IO)] + ["." state ("#@." monad)]] + [math + ["r" random]] + [data + [number + ["n" nat]]] + [time + ["." instant] + ["." duration (#+ Duration)]]] + {1 + ["." / + ["/#" // #_ + ["#" mixin]]]}) + +(def: (fibonacci fibonacci input) + (/.Memo Nat Nat) + (case input + 0 (state@wrap 0) + 1 (state@wrap 1) + _ (do state.monad + [output-1 (fibonacci (n.- 1 input)) + output-2 (fibonacci (n.- 2 input))] + (wrap (n.+ output-1 output-2))))) + +(def: (time function input) + (All [i o] (-> (-> i o) i (IO [Duration o]))) + (do io.monad + [before instant.now + #let [output (function input)] + after instant.now] + (wrap [(instant.span before after) + output]))) + +(def: #export test + Test + (<| (_.context (%.name (name-of /.memoization))) + (let [fast (/.closed n.hash fibonacci) + slow (/.none n.hash ..fibonacci)] + (do r.monad + [input (wrap 30) + #let [prefix (format (%.name (name-of /.memoization)) " => " (%.nat input) " => ")]] + (_.test "Memoization makes certain computations faster." + (io.run + (do io.monad + [[fast-time fast-output] (..time fast input) + [slow-time slow-output] (..time slow input) + #let [_ (log! (format prefix " memoized = " (%.duration fast-time))) + _ (log! (format prefix "non-memoized = " (%.duration slow-time)))]] + (wrap (and (n.= fast-output slow-output) + (:: duration.order < slow-time fast-time)))))))))) -- cgit v1.2.3