Оптимизировать извлечение деталей

Question

У меня есть эта специальная функция для извлечения частей списка в форме: Give[list, elem] возвращает часть списка , которая соответствует позиции элемент в глобальном $Reference переменная (если определена). Я активно использую эту функцию в своем коде, поэтому я решил оптимизировать ее. Вот где мне удалось продвинуться так далеко, но, честно говоря, я понятия не имею, как продвигаться.

ClearAll[Give, $Reference, set];

Give::noref = "No, non-list or empty $Reference was defined to refer to by Give.";
Give::noelem = "Element (or some of the elements in) `1` is is not part of the reference set `2`.";
Give::nodepth = "Give cannot return all the elements corresponding to `1` as the list only has depth `2`.";

give[list_, elem_List, ref_] := Flatten[Pick[list, ref, #] & /@ elem, 1];
give[list_, elem_, ref_] := First@Pick[list, ref, elem];

Options[Give] = {Reference :> $Reference}; (* RuleDelayed is necessary, for it is possible that $Reference changes between two subsequent Give calls, and without delaying its assignment, ref would use previous value of $Reference instead of actual one. *)
Give[list_List, elem___, opts___?OptionQ] := Module[{ref, pos},
   ref = Reference /. {opts} /. Options@Give;
   Which[
      Or[ref === {}, Head@ref =!= List], Message[Give::noref]; {},
      Complement[Union@Flatten@{elem}, ref] =!= {}, Message[Give::noelem, elem, ref]; {},
      Length@{elem} > Depth@list - 1, Message[Give::nodepth, {elem}, Depth@list]; {},
      True, Fold[give[#1, #2, ref] &, list, {elem}]
]];



In[106]:= $Reference = {"A", "B", "C"};
set = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}};

Give[set, "B"](* return specified row *)
Out[108]= {4, 5, 6}

In[109]:= Give[set, "B", "A"] (* return entry at specified row & column *)
Out[109]= 4

In[110]:= Give[set, {"B", "A"}] (* return multiple rows *)
Out[110]= {{4, 5, 6}, {1, 2, 3}}

Я решил отбросить отдельные вызовы функций подписи, поскольку версия списка может вызывать не-версию списка, что означает, что обработка ошибок должна выполняться несколько раз (для каждого элемента в списке). К сожалению, обработка ошибок не может быть отброшена. Если улучшенная версия более устойчива (например, может обрабатывать больше измерений), это не проблема, однако приведенных выше примеров будет достаточно.

In[139]:= First@Timing[Give[set, RandomChoice[$Reference, 10000]]] (* 1D test *)

Out[139]= 0.031

In[138]:= First@Timing[Table[Give[set, Sequence @@ RandomChoice[$Reference, 2]], {10000}]] (* 2d test *)

Out[138]= 0.499

Я уверен, что это неэффективный код, поэтому не стесняйтесь его улучшать. Любая помощь приветствуется, даже если она обрезается всего на несколько наносекунд.

Answer 1

Вот еще одно решение этой проблемы, основанное на проблеме с индексацией действительных чисел.Он использует ленивый анализ для отображения сообщения об ошибке, если это необходимо (уловка, которую я узнал на этом сайте! Спасибо всем за вашу преданность, всегда приятно изучать новые вещи здесь!)

ListToIndexFunction[list_List,precision_:0.00001]:=
   Module[{numbersToIndexFunction},

      numbersToIndexFunction::indexNotFound="Index of `1` not found.";

      MapThread[(numbersToIndexFunction[#1]=#2)&,{Round[list,precision],Range[Length@list]}];
      numbersToIndexFunction[x_]/;(Message[numbersToIndexFunction::indexNotFound,x];False):=Null;

      numbersToIndexFunction[Round[#,precision]]&
   ];

Test: 
f=ListToIndexFunction[{1.23,2.45666666666,3}]
f[2.456666]
f[2.456665]

Answer 2

Основная проблема эффективности для больших списков, похоже, связана с отображением Pick. Этого можно избежать, если заменить соответствующее определение для give следующим:

give[list_, elem_List, ref_] := 
    list[[elem /. Dispatch[Thread[ref -> Range[Length[ref]]]]]];

Вот мой тестовый код:

In[114]:= 
  Block[{$Reference = Range[100000],set = Range[100000]^2,rnd,ftiming,stiming},
      rnd = RandomSample[$Reference,10000];
      ftiming = First@Timing[res1 = Give[set,rnd]];
      Block[{give},
        give[list_,elem_List,ref_]:=list[[elem/.Dispatch[Thread[ref->Range[Length[ref]]]]]];
        give[list_,elem_,ref_]:=First@Pick[list,ref,elem];
        stiming = First@Timing[res2 = Give[set,rnd]];];
   {ftiming,stiming,res1===res2}
]

Out[114]= {1.703,0.188,True}

Вы получаете 10-кратное увеличение скорости здесь, для этого варианта использования. Я не тестировал 2D, но думаю, это тоже должно помочь.

EDIT

Вы можете еще больше повысить производительность, кэшируя отправленную таблицу для $Reference (Dispatch[Thread[ref->Range[Length[$Reference]]]) один раз в начале в теле Give, а затем передайте ее в give (либо явно, либо сделав give внутренняя функция - через Module переменных - которая будет ссылаться на нее), чтобы вам не приходилось пересчитывать ее в случае, если вы вызываете give несколько раз через Fold. Вы также можете сделать это условно, скажем, у вас есть большие списки элементов в elem, чтобы оправдать время, необходимое для создания таблицы диспетчеризации.

Answer 3

Это то, что я получил после того, как оставил этот кусок кода на 2 года.Он запоминает таблицу диспетчеризации для данного набора ссылок и использует синтаксис типа Part.Я избавился от всех сообщений об ошибках и также сбросил глобальный символ $Reference.Очень не- Mathematica -подобно, и мне никогда не нравилось.

dispatch[ref_] := dispatch@ref = (Dispatch@Thread[ref -> Range@Length@ref]);
give[list_, elem__, ref_] := list[[Sequence @@ ({elem} /. dispatch@ref)]];

Запоминание гарантирует, что таблица отправки для данного ref рассчитывается только один раз.Ведение нескольких таблиц диспетчеризации в памяти не является проблемой, поскольку обычно они невелики.

ref = Reference = {"A", "B", "C"};
set = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}};

give[set, "B", ref]          (* ==> {4, 5, 6}              *)
give[set, "B", "A", ref]     (* ==> 4                      *)
give[set, {"B", "A"}, ref]   (* ==> {{4, 5, 6}, {1, 2, 3}} *)

Время:

n = 20000;
{
First@Timing[give[set, #, ref] & /@ RandomChoice[ref, n]],
First@Timing[give[set, RandomChoice[ref, n], ref]],
First@Timing[Table[give[set, Sequence @@ RandomChoice[ref, 2], ref], {n}]]
}

{0.140401, 0., 0.202801}

Сравните это с временеморигинальной функции:

{
First@Timing[Give[set, #] & /@ RandomChoice[ref, n]],
First@Timing[Give[set, RandomChoice[ref, n]]],
First@Timing[Table[Give[set, Sequence @@ RandomChoice[ref, 2]], {n}]]
}

{0.780005, 0.015600, 1.029607}

Answer 4

Это похоже на ответ Леонида, но в моем собственном стиле.

Я использую ту же таблицу Dispatch, и рекомендую сделать ее как можно более внешней. С этой целью я предлагаю новый символ $Rules, который обновляется при каждом изменении $Reference. Например:

$Reference = RandomSample["A"~CharacterRange~"Z"];

$Rules = Dispatch@Thread[$Reference -> Range@Length@$Reference];

Это может быть сделано автоматически для удобства, если это делается часто (спросите).

Помимо этого, мой полный код:

ClearAll[Give, $Reference, Reference, $Rules];

Give::noref = "No, non-list or empty $Reference was defined to refer to by Give.";
Give::noelem = "Element (or some of the elements in) `1` is is not part of the reference set `2`.";
Give::nodepth = "Give cannot return all the elements corresponding to `1` as the list only has depth `2`.";

Options[Give] = {Reference :> $Reference};

Give[list_List, elem___, opts : OptionsPattern[]] := 
  Module[{ref, pos, rls},
   ref = OptionValue[Reference];
   rls = If[{opts} == {}, $Rules, Dispatch@Thread[ref -> Range@Length@ref]];
   Which[
    ref === {} || Head@ref =!= List,
        Message[Give::noref]; {},
    Complement[Union@Flatten@{elem}, ref] =!= {},
        Message[Give::noelem, elem, ref]; {},
    Length@{elem} > Depth@list - 1, 
        Message[Give::nodepth, {elem}, Depth@list]; {},
    True,
        list[[##]] & @@ ({elem} /. rls)
   ]
  ];