Created
June 5, 2012 13:35
-
-
Save w495/2875038 to your computer and use it in GitHub Desktop.
Простая мемоизация на erlang
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
%%% @file memo.erl Простая мемоизация. | |
%%% Функциям '[l|p]memoize' | |
%%% на вход подается | |
%%% функция от 0\1 аргумента; | |
%%% результатом тоже является функция от 0\1 аргументов. | |
%%% Функциям '[l|p]save' | |
%%% на вход подается | |
%%% функция от N аргументов, | |
%%% список аргуменитов; | |
%%% a результатом является результат вычисления | |
%%% функции на этих аргументах. | |
%%% Функции 'rmemoize' | |
%%% на вход подается | |
%%% функция, с аргуметом функцией одного аргумента, | |
%%% и возвращающая функцию одного аргумента; | |
%%% a результатом тоже является функция от 1 аргументa. | |
%%% Примеры использования даны в конце файла. | |
%%% | |
%%% Мы умышленно не используем apply/3 и Mod:Name(Args). | |
%%% Это позволяет нам не увеличивать время на вызов функции в 2 раза. | |
%%% http://www.erlang.org/doc/efficiency_guide/functions.html#id67124 | |
%%% | |
-module (memo). | |
-export ([ | |
pmemoize/1, | |
lmemoize/1, | |
psave/2, | |
lsave/2 | |
]). | |
-export ([ | |
rmemoize/1, | |
test/0 | |
]). | |
-export ([ | |
ploop/2 | |
]). | |
%%% ------------------------------------------------------------------------ | |
%%% Классическая рекурсивная мемоизация | |
%%% Реализована через оператор неподвижной точки. | |
%%% Крайне эффективна для рекурсивных функций. | |
%%% ------------------------------------------------------------------------ | |
%%% | |
%%% @doc | |
%%% Оператор неподвижной точки | |
%%% Следует из определения рекурсии в λ-исчислении. | |
%%% | |
ry(Function) when erlang:is_function(Function, 1) -> | |
Function( | |
fun(X) -> | |
(ry(Function))(X) | |
end | |
). | |
%%% | |
%%% @doc | |
%%% Вычисляет рекурсивную функцию. | |
%%% Запоминает промежуточные результаты. | |
%%% И при необходимости достает их из памяти. | |
%%% | |
rmemoize(Tab, Function) when erlang:is_function(Function, 1) -> | |
fun (B) -> | |
Bfunction = Function(B), | |
fun (Args) -> | |
Hash = funhash(Bfunction, Args), | |
case get_value(Tab, Hash) of | |
undefined -> | |
Result = Bfunction(Args), | |
put_value(Tab, Hash, Result), | |
Result; | |
Result -> | |
Result | |
end | |
end | |
end. | |
%%% | |
%%% @doc | |
%%% Вычисляет рекурсивную функцию. | |
%%% Удаляет промежуточные результаты. | |
%%% Запоминает последний результат. | |
%%% | |
%%% ВАЖНО: | |
%%% Function = fun( fun(Arg) ) -> fun(Arg) | |
%%% Или в стиле Ocaml: | |
%%% (fun (fun -> Arg ) -> (fun -> Arg) | |
%%% | |
rmemoize(Function) when erlang:is_function(Function, 1) -> | |
fun (Args) -> | |
Anstab = new(memo_rmemoize_ans), | |
Hash = funhash(Function, Args), | |
case get_value(Anstab, Hash) of | |
undefined -> | |
Tmptab = new(memo_rmemoize_tmp), | |
Mfunction = rmemoize(Tmptab, Function), | |
Yfunction = ry(Mfunction), | |
Ans = Yfunction(Args), | |
delete(Tmptab), | |
put_value(Anstab, Hash, Ans), | |
Ans; | |
Result -> | |
Result | |
end | |
end. | |
%%% ------------------------------------------------------------------------ | |
%%% Линейная мемоизация, по сути является | |
%%% обычным хешированием без определенного времени удаления | |
%%% | |
%%% Сохраняется только конечный результат вычислений. | |
%%% Промежуточные варианты, для рекурсивной функции не сохраняются. | |
%%% но при соответсвуюущей мемоизация рекурсивнх вызовов | |
%%% --- это возможно. | |
%%% | |
%%% ------------------------------------------------------------------------ | |
%%% | |
%%% @doc | |
%%% Вычисляет функцию. | |
%%% Запоминает последний результат. | |
%%% | |
%%% ВАЖНО: | |
%%% Function = fun() | |
%%% Function = fun(Arg) | |
%%% | |
lmemoize(Function) when erlang:is_function(Function, 0) -> | |
fun (Args) -> | |
lmemoize_inside(Function, 0, Args) | |
end; | |
lmemoize(Function) when erlang:is_function(Function, 1) -> | |
fun (Args) -> | |
lmemoize_inside(Function, 1, Args) | |
end. | |
lmemoize_inside(Function, Arity, Args) -> | |
Anstab = new(memo_lmemoize_ans), | |
Hash = funhash(Function, Args), | |
case get_value(Anstab, Hash) of | |
undefined -> | |
Ans = apply_one(Function, Arity, Args), | |
put_value(Anstab, Hash, Ans), | |
Ans; | |
Result -> | |
Result | |
end. | |
%%% | |
%%% @doc | |
%%% Вычисляет функцию. | |
%%% Запоминает последний результат. | |
%%% Для каждого вызова функции создается | |
%%% отдельный процесс. | |
%%% Последнее может быть полезно, | |
%%% если в качестве хранилища будем использовать | |
%%% локальную память процесса в виде состояния | |
%%% (dict, gb_tree, proplist). | |
%%% ВАЖНО: | |
%%% Function = fun() | |
%%% Function = fun(Arg) | |
%%% | |
pmemoize(Function) when erlang:is_function(Function, 0) -> | |
fun() -> | |
pcall(Function, 0, undefined) | |
end; | |
pmemoize(Function) when erlang:is_function(Function, 1) -> | |
fun(Args) -> | |
pcall(Function, 1, Args) | |
end. | |
pspawn(Function) -> | |
spawn(?MODULE, ploop, [new(memo_pmemoize_ans), Function]). | |
pcall(Function, Arity, Args) -> | |
pspawn(Function) ! {memo, self(), Arity, Args}, | |
receive | |
{_, {'EXIT', Reason}} -> erlang:error(Reason); | |
{fresh, Value} -> Value; | |
{cache, Value} -> Value | |
end. | |
ploop(Tab, Fun) -> | |
receive | |
{memo, From, Arity, Args} -> | |
Hash = funhash(Fun, Args), | |
case get_value(Tab, Hash) of | |
undefined -> | |
Result = apply_one(Fun, Arity, Args), | |
From ! {fresh, Result}, | |
put_value(Tab, Hash, Result), | |
ploop(Tab, Fun); | |
Result -> | |
From ! {cache, Result}, | |
ploop(Tab, Fun) | |
end | |
end. | |
%%% ------------------------------------------------------------------------ | |
%%% | |
%%% ------------------------------------------------------------------------ | |
lsave(Function, Argslist) | |
when erlang:is_function(Function) | |
andalso erlang:is_list(Argslist) -> | |
Anstab = new(memo_lsave_ans), | |
Hash = funhash(Function, Argslist), | |
case get_value(Anstab, Hash) of | |
undefined -> | |
Ans = erlang:apply(Function, Argslist), | |
put_value(Anstab, Hash, Ans), | |
Ans; | |
Result -> | |
Result | |
end. | |
psave(Function, Argslist) | |
when erlang:is_function(Function) | |
andalso erlang:is_list(Argslist) -> | |
erlang:error("Not implemementet"). | |
%%% ------------------------------------------------------------------------ | |
%%% Вспомогательные функции | |
%%% ------------------------------------------------------------------------ | |
apply_one(Fun, Arity, Args)-> | |
case Arity of | |
0 -> | |
Fun(); | |
_ -> | |
Fun(Args) | |
end. | |
%%% | |
%%% @doc | |
%%% Вычисляет хеш для функции и аргументов. | |
%%% | |
funhash(Fun, Args) -> | |
{module, Module} = erlang:fun_info(Fun, module), | |
{name, Name} = erlang:fun_info(Fun, name), | |
{arity, Arity} = erlang:fun_info(Fun, arity), | |
{Module, Name, Arity, Args}. | |
%erlang:md5(erlang:term_to_binary({Module, Name, Arity, Args})). | |
new() -> | |
new(?MODULE). | |
new(Tab) -> | |
storage:newc(Tab). | |
delete() -> | |
delete(?MODULE). | |
delete(Tab) -> | |
storage:delete(Tab). | |
get_value(Args) -> | |
get_value(?MODULE, Args). | |
get_value(Tab, Args) -> | |
storage:value(Tab, Args). | |
put_value(Args, Result) -> | |
put_value(?MODULE, Args, Result). | |
put_value(Tab, Args, Result) -> | |
storage:insert(Tab, Args, Result). | |
%%% ------------------------------------------------------------------------ | |
%%% Функции тектирования | |
%%% ------------------------------------------------------------------------ | |
test_fibimpl_rmemoize(Self) -> | |
fun | |
(0) -> 1; | |
(1) -> 1; | |
(N) when N > 1 -> | |
((Self)(N - 1)) + ((Self)(N - 2)) | |
end. | |
test_fff_rmemoize(Self) -> | |
fun(N)-> | |
N | |
end. | |
test_fib_rmemoize(N) -> | |
Function1 = rmemoize(fun test_fibimpl_rmemoize/1), | |
io:format("test_fibimpl_rmemoize(~p) = ~p ~n", | |
[N, Function1(N)]), | |
ok. | |
%%% ------------------------------------------------------------------------ | |
test_simple_fibimpl_pmemoize(0) -> 1; | |
test_simple_fibimpl_pmemoize(1) -> 1; | |
test_simple_fibimpl_pmemoize(N) when N > 1 -> | |
test_simple_fibimpl_pmemoize(N-1) + test_simple_fibimpl_pmemoize(N - 2). | |
test_simple_fib_pmemoize(N) -> | |
Function1 = pmemoize(fun test_simple_fibimpl_pmemoize/1), | |
io:format("test_simple_fibimpl_pmemoize(~p) = ~p ~n", | |
[N, Function1(N)]), | |
ok. | |
%%% ------------------------------------------------------------------------ | |
test_rec_fibimpl_pmemoize(0) -> 1; | |
test_rec_fibimpl_pmemoize(1) -> 1; | |
test_rec_fibimpl_pmemoize(N) when N > 1 -> | |
Function = pmemoize(fun test_rec_fibimpl_pmemoize/1), | |
Function(N-1) + Function(N - 2). | |
test_rec_fib_pmemoize(N) -> | |
io:format("test_rec_fibimpl_pmemoize(~p) = ~p ~n", | |
[N, test_rec_fibimpl_pmemoize(N)]), | |
ok. | |
%%% ------------------------------------------------------------------------ | |
test_simple_fibimpl_lmemoize(0) -> 1; | |
test_simple_fibimpl_lmemoize(1) -> 1; | |
test_simple_fibimpl_lmemoize(N) when N > 1 -> | |
test_simple_fibimpl_lmemoize(N-1) + test_simple_fibimpl_lmemoize(N - 2). | |
test_simple_fib_lmemoize(N) -> | |
Function1 = lmemoize(fun test_simple_fibimpl_lmemoize/1), | |
io:format("test_simple_fibimpl_lmemoize(~p) = ~p ~n", | |
[N, Function1(N)]), | |
ok. | |
%%% ------------------------------------------------------------------------ | |
test_rec_fibimpl_lmemoize(0) -> 1; | |
test_rec_fibimpl_lmemoize(1) -> 1; | |
test_rec_fibimpl_lmemoize(N) when N > 1 -> | |
Function = lmemoize(fun test_rec_fibimpl_lmemoize/1), | |
Function(N-1) + Function(N - 2). | |
test_rec_fib_lmemoize(N) -> | |
io:format("test_rec_fibimpl_lmemoize(~p) = ~p ~n", | |
[N, test_rec_fibimpl_lmemoize(N)]), | |
ok. | |
%%% ------------------------------------------------------------------------ | |
test()-> | |
io:format("test~n"), | |
test_fib_rmemoize(10000). | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
%%% @file storage.erl | |
%%% Некотрое ОЗУ хранилище. | |
%%% Нужно, чтобы отделиться от реализации ets | |
%%% Это может быть полезно, если мы с ets перейдем на что-то иное, | |
%%% например на gb_set или gb_tree, | |
%%% или захотим инкапсулировать каждый словарь в gen_server. | |
%%% | |
%%% Кроме того, на базе этого модуля можно организовать простое | |
%%% и быстрое кеширование с вытесненнием параметров | |
%%% (как это сделано для капчи). | |
%%% Сечас это просто обертка над ets. | |
%%% | |
-module(storage). | |
-export([ | |
new/1, | |
newc/1, | |
value/2, | |
lookup/2, | |
insert/3, | |
delete/2, | |
delete/1, | |
delete_all_objects/1, | |
select/2, | |
select/3, | |
remove_expired/1, | |
timeout/1, | |
remove_expired/0, | |
timeout/0, | |
test/0, | |
test/1 | |
]). | |
%%% ---------------------------------------------------------------------- | |
%%% API | |
%%% ---------------------------------------------------------------------- | |
new(Name)-> | |
internal_new(Name, []). | |
newc(Name)-> | |
internal_newc(Name, []). | |
insert(Name, Key, Value) -> | |
internal_insert(Name, Key, Value). | |
value(Name, Key) -> | |
internal_lookup_value(Name, Key). | |
lookup(Name, Key) -> | |
internal_lookup(Name, Key). | |
delete(Name, Key) -> | |
internal_delete(Name, Key). | |
delete(Name) -> | |
internal_delete(Name). | |
delete_all_objects(Name) -> | |
internal_delete_all_objects(Name). | |
%%% | |
%%% @doc | |
%%% Нежелательная опирация, так она оставляет зависимость от ets | |
%%% | |
select(Name, Match_spec) -> | |
internal_select(Name, Match_spec). | |
select(Name, Match_spec, Limit) -> | |
internal_select(Name, Match_spec, Limit). | |
remove_expired(Name)-> | |
%delete_all_objects(Name), | |
ok. | |
timeout(Name)-> | |
%delete_all_objects(Name), | |
ok. | |
remove_expired()-> | |
ok. | |
timeout()-> | |
ok. | |
test()-> | |
ok. | |
test(speed)-> | |
ok. | |
%%% ---------------------------------------------------------------------- | |
%%% Внутренние функции | |
%%% ---------------------------------------------------------------------- | |
internal_newc(Name) -> | |
internal_newc(Name, []). | |
internal_newc(Name, Opts) -> | |
internal_new(Name, [{write_concurrency,true}|Opts]). | |
internal_new(Name) -> | |
internal_new(Name, []). | |
internal_new(Name, Opts) -> | |
case ets:info(Name) of | |
undefined -> ets:new(Name, [set, public, named_table|Opts]); | |
_ -> Name | |
end. | |
internal_insert(Name, Key, Value) -> | |
case ets:insert(Name, {Key, Value}) of | |
true -> | |
true; | |
Else -> | |
Else | |
end. | |
internal_lookup(Name, Key) -> | |
case ets:lookup(Name, Key) of | |
[{Key, Value}] -> | |
{Key, Value}; | |
[] -> | |
undefined; | |
Else -> | |
Else | |
end. | |
internal_lookup_value(Name, Key) -> | |
case ets:lookup(Name, Key) of | |
[{Key, Value}] -> | |
Value; | |
[] -> | |
undefined; | |
Else -> | |
Else | |
end. | |
internal_delete(Name, Key) -> | |
ets:delete(Name, Key). | |
internal_delete(Name) -> | |
ets:delete(Name). | |
internal_delete_all_objects(Name) -> | |
ets:delete_all_objects(Name). | |
internal_select(Name, Ets_match_spec) -> | |
ets:select(Name, Ets_match_spec). | |
internal_select(Name, Ets_match_spec, Limit) -> | |
ets:select(Name, Ets_match_spec, Limit). | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment