在Mathematica中将坐标系转换为矩阵

Question

在编程问题出现之前，我相信我需要提供一些背景信息，说明我正在采取哪些措施来简化对问题的理解：

我在向受试者主体显示一些图案时记录眼球运动。通过实验，我后来展示了这些模式的一些对称变换。

我得到的是固定坐标和持续时间列表：

{{fix1X，fix1Y，fix1Dn}，{fix2X，fix2Y，fix2Dn}，... {fixNX，fixNY，fixNDn}}

其中：

- fix1X 是第一次录制的X坐标。

- fix1Y 是第一次录制的Y坐标。

- fix1D 是注视的持续时间（以毫秒为单位）

请考虑：

FrameWidth  = 31.36;
scrHeightCM = 30;
scrWidthCM  = 40;
FrameXYs    = {{4.32, 3.23}, {35.68, 26.75}};  (* {{Xmin,Ymin},{Xmax,Ymax}} *)

以下是1个显示的注意事项（屏幕上3s刺激呈现期间的主题固定）

fix ={{20.14, 15.22, 774.}, {20.26, 15.37, 518.}, {25.65, 16.22, 200.}, 
      {28.15, 11.06, 176.}, {25.25, 13.38, 154.}, {24.78, 15.74, 161.}, 
      {24.23, 16.58, 121.}, {20.06, 13.22, 124.}, {24.91, 15.8, 273.}, 
      {24.32, 12.83, 119.}, {20.06, 12.14, 366.}, {25.64, 18.22, 236.}, 
      {24.37, 19.2, 177.}, {21.02, 16.4, 217.}, {20.63, 15.75,406.}}

Graphics[{
          Gray, EdgeForm[Thick],
          Rectangle @@ {{0, 0}, {scrWidthCM, scrHeightCM}},
          White,
          Rectangle @@ StimuliFrameCoordinates,
          Dashed, Black,
         Line[
             {{(scrWidthCM/2), FrameXYs[[1, 2]]},
             {(scrWidthCM/2), FrameXYs[[2, 2]]}}],
         Line[
             {{FrameXYs[[1, 1]], (scrHeightCM/2)},
             {(FrameXYs[[2, 1]]), (scrHeightCM/2)}}],

         Thickness[0.005], Pink,
         Disk[{#[[1]], #[[2]]}, 9 N[#[[3]]/Total[fix[[All, 3]]]]] & /@ fix
         }, ImageSize -> 500]

我想做什么：

我想将刺激框架空间“离散化”成簇：

以下是具有不同聚类（2,4,16,64）的视觉表示（在PPT中完成）。

表示发生固定的集群的彩色部分：

有了这个，我想

计算每个群集中的注视数量。

- 计算每个群集中观察到的存在/计数或持续时间。

矩阵表单可以让我轻松地通过减法比较不同的显示内容。

所以，问题

- 如何创建灵活的机制将刺激帧划分为簇。

- 将固定点映射到这些聚类上，获得填充0或固定点数的矩形矩阵或每个矩阵单元格的总固定持续时间。

我觉得这个问题可能不清楚，并会对其进行编辑以澄清所需的一切。 另外，您认为这应该在2个单独的问题中提出，我很乐意这样做。

非常感谢您提供的任何帮助。

Answer 1

您可以执行以下操作：

createMatrix[list_, frameXYs_, partitX_, partitY_, fun_] :=
 Module[{matrix},
  (*init return matrix*)
  matrix = Array[0 &, {partitX, partitY}];
  (matrix[[
    IntegerPart@Rescale[#[[1]], {frameXYs[[1, 1]], frameXYs[[2, 1]]}, {1,partitX}],
    IntegerPart@Rescale[#[[2]], {frameXYs[[1, 2]], frameXYs[[2, 2]]}, {1,partitY}]
         ]] += fun[#[[3]]]) & /@ list;

  Return@(matrix[[1 ;; -2, 1 ;; -2]]);]

fun是列表第三维上的计数功能。

所以，如果你想计算出现次数：

fix = {{20.14, 15.22, 774.}, {20.26, 15.37, 518.}, {25.65, 16.22, 200.}, 
       {28.15, 11.06, 176.}, {25.25, 13.38, 154.}, {24.78, 15.74, 161.}, 
       {24.23, 16.58, 121.}, {20.06, 13.22, 124.}, {24.91, 15.8,  273.}, 
       {24.32, 12.83, 119.}, {20.06, 12.14, 366.}, {25.64, 18.22, 236.}, 
       {24.37, 19.2, 177.},  {21.02, 16.4, 217.},  {20.63, 15.75, 406.}};
FrameXYs = {{4.32, 3.23}, {35.68, 26.75}};

cm = createMatrix[fix, FrameXYs, 10, 10, 1 &]
MatrixPlot@cm
MatrixForm@cm

如果你想加上录制时间

cm = createMatrix[fix, FrameXYs, 10, 10, # &]
MatrixPlot@cm
MatrixForm@cm

修改

对索引进行一些调整，一点点代码修饰，一个更清晰的例子：

createMatrix[list_, frameXYs_, partit : {partitX_, partitY_}, fun_] :=
 Module[{matrix, g},
  (*Define rescale function*)
  g[i_, l_] := IntegerPart@
                   Rescale[l[[i]], (Transpose@frameXYs)[[i]], {1, partit[[i]]}];
  (*Init return matrix*)
  matrix = Array[0 &, {partitX + 1, partitY + 1}];
  (matrix[[g[1, #], g[2, #]]] += fun[#[[3]]]) & /@ list;
  Return@(matrix[[1 ;; -2, 1 ;; -2]]);]

。

fix = {{1, 1, 1}, {1, 3, 2}, {3, 1, 3}, {3, 3, 4}, {2, 2, 10}};
FrameXYs = {{1, 1}, {3, 3}};
cm = createMatrix[fix, FrameXYs, {7, 7}, # &];
MatrixPlot@cm
Print[MatrixForm@SparseArray[(#[[1 ;; 2]] -> #[[3]]) & /@ fix], MatrixForm@cm]

Answer 2

要完成你想要的东西，还有很多事情要做。首先，给定除法计数，我们必须划分二维空间。其次，使用除法计数，我们需要一种灵活的方法将注视分组到适当的位置。最后，我们生成您需要的任何统计数据。

关于除法计数，内置函数FactorInteger几乎可以满足你的需要。例如，

(* The second parameter is the upper limit for the number of factors returned *)
FactorInteger[35,2] == {{5,1}, {7,1}}
FactorInteger[64,2] == {{2,6}}

不幸的是，你只能指定返回因子数的上限，所以我们必须稍微修改输出

Clear[divisionCount]
divisionCount[c_Integer?(Positive[#] && (# == 2 || ! PrimeQ[#]) &)] :=
With[{res = FactorInteger[c, 2]},
 Power @@@ If[ 
     Length[res] == 2, 
     res // Reverse,
     With[
       {q = Quotient[res[[1, 2]], 2], r = Mod[res[[1, 2]], 2], 
        b = res[[1, 1]]},
       {{b, q + r}, {b, q}}
     ]
 ]
] 

这有两件事，用{{b,m}}代替{{b, m / 2 + m mod 2}, {b, m / 2}}，其中/表示整数除法（即有余数）并通过{将{{b, m} ..}转换为{b^m ..} {3}}。这给了

divisionCount[32] == {8, 4}
divisionCount[64] == {8, 8}.

事实证明，此时我们可以通过Power @@@获得最少额外工作的固定计数，如下所示

BinCounts[fix[[All,;;2]], (* stripping duration from tuples *)
  {xmin, xmax, (xmax - xmin)/#1,
  {ymin, ymax, (ymax - ymin)/#2]& @@ divisionCount[ divs ]

您需要提供x和y的范围以及分割数。但是，这并不像它可能的那样灵活。相反，我们会使用BinCounts。

有效使用SelectEquivalents的关键是创建良好的分类功能。为此，我们需要自己确定分部，如下所示

Clear[makeDivisions]
makeDivisions[
 {xmin_, xmax_, xdivs_Integer?Positive}, {ymin_, ymax_, ydivs_Integer?Positive}] :=
   Partition[#,2,1]& /@ {
     (xmax - xmin)*Range[0, xdivs]/xdivs + xmin,
     (ymax - ymin)*Range[0, ydivs]/ydivs + ymin
   }

makeDivisions[
       {xmin_, xmax_}, {ymin_, ymax_}, 
       divs_Integer?(Positive[#] && (# == 2 || ! PrimeQ[#]) &)] :=
 makeDivisions[{xmin, xmax, #1}, {ymin, ymax, #2}] & @@ divisionCount[divs]

，其中

makeDivisions[{0, 1}, {0, 1}, 6] == 
 {{{0, 1/3}, {1/3, 2/3}, {2/3, 1}}, {{0, 1/2}, {1/2, 1}}}.

（我本来会使用SelectEquivalents，但它并不总是返回您请求的分区数。）makeDivisions返回两个列表，其中每个列表中的每个术语都是最小 - 最大对我们可以用来确定一个点是否落入垃圾箱。

由于我们在方格上，我们需要测试我们刚刚确定的所有极限对。我将使用以下

Clear[inBinQ, categorize]
inBinQ[{xmin_,xmax_}, {ymin_, ymax_}, {x_,y_}]:= 
   (xmin <= x < xmax) && (ymin <= y < ymax)

categorize[{xmin_, xmax_}, {ymin_, ymax_}, divs_][val : {x_, y_, t_}] := 
 With[{bins = makeDivisions[{xmin, xmax}, {ymin, ymax}, divs]}, 
  Outer[inBinQ[#1, #2, {x, y}] &, bins[[1]], bins[[2]], 1]] //Transpose

返回

categorize[{0,1},{0,1},6][{0.1, 0.2, 5}] ==
 {{True, False, False}, {False, False, False}}.

注意，与绘图相比，y坐标反转，低值位于数组的开头。要在Reverse中“修复”bins[[2]] categorize。此外，您需要在将结果提供给Transpose之前删除MatrixPlot，因为它希望结果采用无翻译的形式。

使用

SelectEquivalents[ 
 fix, 
 (categorize[{xmin, xmax}, {ymin, ymax}, 6][#] /. {True -> 1, False -> 0} &), 
 #[[3]] &, (* strip off all but the timing data *)
{#1, #2} &],

我们得到了

{{
  {{0, 0, 0}, {0, 1, 0}}, {774., 518., 161., 121., 273., 177., 217., 406.}
 }, 
 {
  {{0, 0, 0}, {0, 0, 1}}, {200., 236.}
 }, 
 {
  {{0, 0, 1}, {0, 0, 0}}, {176., 154.}
 }, 
 {
  {{0, 1, 0}, {0, 0, 0}}, {124., 119., 366.}
 }}}

其中每个子列表中的第一个术语是bin的矩阵表示，第二个术语是落入该bin中的点列表。要确定每个箱子中有多少，

Plus @@ (Times @@@ ({#1, Length[#2]} & @@@ %)) ==
 {{0, 3, 2}, {0, 8, 2}}

或者，时间

Plus @@ (Times @@@ ({#1, Total[#2]} & @@@ %)) ==
 {{0, 609., 330.}, {0, 2647., 436.}}

修改：正如您所看到的，要获取修改所需的任何统计信息，您只需要替换Length或Total。例如，您可能需要花费的平均时间（Mean），而不仅仅是总时间。

Answer 3

根据您正在执行的计算以及数据的精确度，您可能会关注更柔和的方法。考虑使用图像重采样。这是一种可能的方法。这里有明显的模糊性，但同样，这可能是可取的。

fix = {{20.14, 15.22, 774.}, {20.26, 15.37, 518.}, {25.65, 16.22, 
    200.}, {28.15, 11.06, 176.}, {25.25, 13.38, 154.}, {24.78, 15.74, 
    161.}, {24.23, 16.58, 121.}, {20.06, 13.22, 124.}, {24.91, 15.8, 
    273.}, {24.32, 12.83, 119.}, {20.06, 12.14, 366.}, {25.64, 18.22, 
    236.}, {24.37, 19.2, 177.}, {21.02, 16.4, 217.}, {20.63, 15.75, 
    406.}};
FrameXYs = {{4.32, 3.23}, {35.68, 26.75}};

Graphics[{AbsolutePointSize@Sqrt@#3, Point[{#, #2}]} & @@@ fix, 
 BaseStyle -> Opacity[0.3], PlotRange -> Transpose@FrameXYs,
 PlotRangePadding -> None, ImageSize -> {400, 400}]

ImageResize[%, {16, 16}];

Show[ImageAdjust@%, ImageSize -> {400, 400}]

---

由于上述情况显然无益，因此这是一种建设性的尝试。 这是我对belisarius的精细解决方案的看法。我觉得它有点干净。

createMatrix[list_, {{x1_, y1_}, {x2_, y2_}}, par:{pX_, pY_}, fun_] :=
 Module[{matrix, quant},
    matrix = 0 ~ConstantArray~ par;
    quant = IntegerPart@Rescale@## &;
    (matrix[[
         quant[#1, {x1, x2}, {1, pX}],
         quant[#2, {y1, y2}, {1, pY}]
           ]] += fun[#3] &) @@@ list;
    Drop[matrix, -1, -1]
 ]

请注意，语法略有不同：量化分区x和y在列表中给出。我觉得这与其他功能更加一致，例如Array。