假设我有一系列沿着无限标尺放置的纸条，起始和终止点由成对的数字指定。我想创建一个列表，表示沿着标尺点的纸张层数。重叠条
例如：
strips =
{{-27, 20},
{ -2, -1},
{-47, -28},
{-41, 32},
{ 22, 31},
{ 2, 37},
{-28, 30},
{ -7, 39}}
应该输出：
-47 -41 -27 -7 -2 -1 2 20 22 30 31 32 37 39
1 2 3 4 5 4 5 4 5 4 3 2 1 0
什么是最高效，清洁，或简洁的方式做到这一点，容纳真实与理性条位置？
这里是一个解决方案：
In[305]:=
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2,
37}, {-28, 30}, {-7, 39}};
In[313]:= int = Interval /@ strips;
In[317]:= Thread[{Union[Flatten[strips]],
Join[Count[int, x_ /; IntervalMemberQ[x, #]] & /@ (Mean /@
Partition[Union[Flatten[strips]], 2, 1]), {0}]}]
Out[317]= {{-47, 1}, {-41, 2}, {-28, 2}, {-27, 3}, {-7, 4}, {-2,
5}, {-1, 4}, {2, 5}, {20, 4}, {22, 5}, {30, 4}, {31, 3}, {32,
2}, {37, 1}, {39, 0}}
SplitBy和后处理下面的代码获取最短的名单：
In[329]:=
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2,
37}, {-28, 30}, {-7, 39}};
In[330]:= int = Interval /@ strips;
In[339]:=
SplitBy[Thread[{Union[Flatten[strips]],
Join[Count[int, x_ /; IntervalMemberQ[x, #]] & /@ (Mean /@
Partition[Union[Flatten[strips]], 2, 1]), {0}]}],
Last] /. {b : {{_, co_} ..} :> First[b]}
Out[339]= {{-47, 1}, {-41, 2}, {-27, 3}, {-7, 4}, {-2, 5}, {-1,
4}, {2, 5}, {20, 4}, {22, 5}, {30, 4}, {31, 3}, {32, 2}, {37,
1}, {39, 0}}
+1对于'Interval' - 我在 – Simon 2011-04-25 23:27:11
这里是我的尝试 - 它适用于整数，有理数和真实的，但没有声称是非常有效的。 （我犯同样的错误作为萨莎，我原来的版本没有返回最短的名单，所以我偷了SplitBy修复！）
layers[strips_?MatrixQ] := Module[{equals, points},
points = [email protected]@strips;
equals = Function[x, Evaluate[(#1 <= x < #2) & @@@ strips]];
points = {points, Total /@ Boole /@ equals /@ points}\[Transpose];
SplitBy[points, Last] /. {b:{{_, co_}..} :> First[b]}]
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31},
{2, 37}, {-28, 30}, {-7, 39}};
In[3]:= layers[strips]
Out[3]= {{-47, 1}, {-41, 2}, {-27, 3}, {-7, 4}, {-2, 5}, {-1, 4}, {2, 5},
{20, 4}, {22, 5}, {30, 4}, {31, 3}, {32, 2}, {37, 1}, {39, 0}}
In[4]:= layers[strips/2]
Out[4]:= {{-(47/2), 1}, {-(41/2), 2}, {-(27/2), 3}, {-(7/2), 4},
{-1, 5}, {-(1/2), 4}, {1, 5}, {10, 4}, {11, 5}, {15, 4}, {31/2, 3},
{16, 2}, {37/2, 1}, {39/2, 0}}
In[5]:= layers[strips/3.]
Out[5]= {{-15.6667, 1}, {-13.6667, 2}, {-9., 3}, {-2.33333, 4}, {-0.666667, 5},
{-0.333333, 4}, {0.666667, 5}, {6.66667, 4}, {7.33333, 5}, {10.,4},
{10.3333, 3}, {10.6667, 2}, {12.3333, 1}, {13., 0}}
你可能认为这是一个愚蠢的做法，但无论如何，我会提供它：
f[x_]:=Sum[UnitStep[x-strips[[k,1]]]-UnitStep[x-strips[[k,2]]],{k,Length[strips]}]
f/@Union[Flatten[strips]]
f[u_, s_] := Total[[email protected]{{1, #1 <= x < #2}} & @@@ s /. x -> u]
用法
f[#, strips] & /@ {-47, -41, -27, -7, -2, -1, 2, 20, 22, 30, 31, 32, 37, 39}
- >
{1, 2, 3, 4, 5, 4, 5, 4, 5, 4, 3, 2, 1, 0}
对于开/关的目的，只是用< =或<
这里有一个办法：
Clear[hasPaper,nStrips]
hasPaper[y_, z_] := Piecewise[{{1, x <= z && x >= y}}, 0];
nStrips[y_, strip___] := [email protected](hasPaper @@@ strip) /. x -> y
你可以在任何值获取条数。
Table[nStrips[i, strips], {i, [email protected]@strips}]
{1, 2, 3, 3, 3, 4, 5, 5, 5, 5, 5, 5, 4, 3, 2, 1}
另外，情节它
Plot[nStrips[x, strips], {x, [email protected]@strips, [email protected]@strips}]
拼接一起抵接条，确定关键点，其中层 的变化，并计算出的数目多少条各关键点栖息：
splice[s_, {}] := s
splice[s_, vals_] := Module[{h = First[vals]},
splice[(s /. {{x___, {k_, h}, w___, {h, j_}, z___} :> {x, {k, j},
w, z}, {x___, {k_, h}, w___, {h, j_}, z___} :> {x, {k, j}, w,
z}}), Rest[vals]]]
splicedStrips = splice[strips, [email protected]@strips];
keyPoints = [email protected]@splicedStrips;
({#, [email protected](splicedStrips /. {a_, b_} :> Boole[a <= # < b])} & /@ keyPoints)
// Transpose // TableForm
经过一番挣扎，我能够去除splice，更直接地消除并不需要检查点（-28，在strips数据，我们一直在使用）：
keyPoints = Complement[pts = [email protected]@strips,
Cases[pts, x_ /; MemberQ[strips, {x, _}] && MemberQ[strips, {_, x}]]];
({#, [email protected](strips /. {a_, b_} :> Boole[a <= # < b])} & /@ keyPoints)
这里的我的方法，类似于贝利萨留：
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}, {22, 31}, {2,
37}, {-28, 30}, {-7, 39}};
pw = PiecewiseExpand[Total[Boole[# <= x < #2] & @@@ strips]]
Grid[Transpose[
SplitBy[SortBy[Table[{x, pw}, {x, Flatten[strips]}], First],
Last][[All, 1]]], Alignment -> "."]
以下解决方案假定图层计数函数将被调用很多次。它使用层预计算和Nearest以大大减少的时间来计算的层数在任何给定点所需的量：
layers[strips:{__}] :=
Module[{pred, changes, count}
, changes = Union @ Flatten @ strips /. {c_, r___} :> {c-1, c, r}
; Evaluate[pred /@ changes] = {changes[[1]]} ~Join~ Drop[changes, -1]
; Do[count[x] = Total[(Boole[#[[1]] <= x < #[[2]]]) & /@ strips], {x, changes}]
; With[{n = Nearest[changes]}
, (n[#] /. {m_, ___} :> count[If[m > #, pred[m], m]])&
]
]
下面的示例使用layers定义一个新的功能f，将计算层计数用于所提供的样品条：
$strips={{-27,20},{-2,-1},{-47,-28},{-41,32},{22,31},{2,37},{-28,30},{-7,39}};
f = layers[$strips];
f现在可以用于计算在点的层数：
Union @ Flatten @ $strips /. s_ :> {s, f /@ s} // TableForm
Plot[f[x], {x, -50, 50}, PlotPoints -> 1000]
对于1000层和10000点，预计算阶段可能需要相当多的时间，但个别点的计算是比较快：是将解决这个的
一种方法
strips = {{-27, 20}, {-2, -1}, {-47, -28}, {-41, 32}
,{ 22, 31}, { 2, 37}, {-28, 30}, {-7, 39}}
添加到分隔符列表中，标记条的开始或结束并按位置排序它们
StripToLimiters[{start_, end_}] := Sequence[BeginStrip[start], EndStrip[end]]
limiterlist = SortBy[StripToLimiters /@ strips, First]
现在我们可以排序限制器映射到递增/递减
LimiterToDiff[BeginStrip[_]] := 1
LimiterToDiff[EndStrip[_]] := -1
，并使用累加得到相交条的中间总计：
In[6]:= Transpose[{First/@#,Accumulate[LimiterToDiff/@#]}]&[limiterlist]
Out[6]= {{-47,1},{-41,2},{-28,3},{-28,2},{-27,3},{-7,4},{-2,5},{-1,4}
,{2,5},{20,4},{22,5},{30,4},{31,3},{32,2},{37,1},{39,0}}
或没有中间limiterlist：
In[7]:= StripListToCountList[strips_]:=
Transpose[{First/@#,Accumulate[LimiterToDiff/@#]}]&[
SortBy[StripToLimiters/@strips,First]
]
StripListToCountList[strips]
Out[8]= {{-47,1},{-41,2},{-28,3},{-28,2},{-27,3},{-7,4},{-2,5},{-1,4}
,{2,5},{20,4},{22,5},{30,4},{31,3},{32,2},{37,1},{39,0}}
为什么不在输出中列出-28？如果一条以-28结尾，另一条以-28开始，那么这是否意味着两条将在28点重叠？ （我假设关闭间隔）。 – DavidC 2011-04-25 23:37:58
@大卫似乎间隔是开放的，因为最后的间隔在39结束，但f [39] == 0 – 2011-04-25 23:42:35
@belisarius开放间隔是有道理的。 – DavidC 2011-04-25 23:45:52