优化零件提取

Question

我有这个特定的函数来提取列表的一部分，格式为：Give[list, elem] 返回 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

大型列表的主要效率问题似乎来自映射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 的，但猜想它也应该有帮助。

编辑

您可以通过在Give 的主体中缓存$Reference (Dispatch[Thread[ref->Range[Length[$Reference]]]) 的调度表一次，然后将其传递给give（显式地或通过使@987654329 @ 一个内部函数 - 通过 Module 变量 - 将引用它），这样当您通过 Fold 多次调用 give 时，您不必重新计算它。您也可以有条件地执行此操作，假设您在elem 中有大量元素列表，以证明创建调度表所需的时间是合理的。

Answer 2

这是基于我在索引实数时遇到的问题的另一种解决方案。如果需要，它使用惰性评估来显示错误消息（我在这个网站上学到的一个技巧！感谢大家的奉献，在这里学习新东西总是很高兴！）

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 3

这与 Leonid 的回答类似，但采用了我自己的风格。

我使用相同的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)
   ]
  ];

Answer 4

这是我让这段代码搁置 2 年后得到的。它记忆给定参考集的调度表，并使用Part-type 语法。我摆脱了所有错误消息，还删除了全局 $Reference 符号。非常不-Mathematica-喜欢，我从不喜欢它。

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

Memoization 确保给定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}