优化零件提取

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 的，但我猜它也应该有帮助。

编辑

您可以通过缓存$Reference的分派表来进一步提高性能（Dispatch[Thread[ref->Range[Length[$Reference]]]< /code>) 在 Give 主体的开头一次，然后将其传递给 give （显式或通过使 give 成为一个内部函数 - 通过 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

这是我把这段代码搁置了两年后得到的结果。它记住给定参考集的调度表，并使用 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}