EDIT: converted the use of explicit Hold
wrappers to appropriate HoldAll
and HoldFirst
attributes of helper functions.
Also added possibility to change columns together with rows, and added highlighting of rows/columns that are being moved.
The following is a possible implementation, allowing to visually switch neighbouring rows and columns via mouse dragging the corresponding MatrixPlot of the matrix.
If a symbol containing a matrix is passed to the function, the value of the matrix is changed in-place, so that this can be thought of as a way to visually change a matrix.
To start, I defined an helper function MP
, which is nothing but a MatrixPlot
with some commonly used options:
(* MP is just a shorthand for MatrixPlot, with some predefined commonly used
options *)
Options @ MP = Options @ MatrixPlot;
MP[expr_, opts : OptionsPattern[]] := MatrixPlot[
expr,
Evaluate @ FilterRules[{opts}, Options @ MatrixPlot],
PlotRangePadding -> None,
Mesh -> All, MeshStyle -> Gray
];
The code implementing the functionality is then the following:
rowNumber[matrix_] := If[# === None, #,
If[
MatchQ[#, _Integer ? (1 <= # <= Length @ matrix &)],
#, None
] & [
1 + Length @ matrix - Last @ Floor[# + 1]
]
] & @ MousePosition["Graphics"];
colNumber[matrix_] := If[# === None, #,
If[
MatchQ[#, _Integer ? (1 <= # <= Last @ Dimensions @ matrix &)],
#, None
] & [
First @ Floor[# + 1]
]
] & @ MousePosition["Graphics"];
mouseOnGraphics[] := MousePosition["Graphics"] =!= None;
switchRows[matrix_, row1_, row2_] := ReplacePart[matrix,
{row1 -> matrix[[row2]],
row2 -> matrix[[row1]]}
];
switchCols[matrix_, col1_, col2_] := ReplacePart[matrix,
{
{row_, col1} :> matrix[[row, col2]],
{row_, col2} :> matrix[[row, col1]]
}
];
(* Replace neighboring rows or columns, conditionally to the value of `which`.
The change is done in-place, that is, the value of `matrixVar` is changed
directly. *)
Attributes @ switchNeighborsInPlace = HoldFirst;
switchNeighborsInPlace[
matrixVar_, idx1_, idx2_, which : ("Rows" | "Cols")
] := Set[matrixVar,
Which[
which == "Cols",
switchCols[matrixVar, idx1, idx2],
which == "Rows",
switchRows[matrixVar, idx1, idx2]
]
];
Attributes @ conditionallySwitchNeighbors = HoldAll;
conditionallySwitchNeighbors[
matrix_, labelsList_, oldIdx_, newIdx_, which : ("Rows" | "Cols")
] := If[
Abs[oldIdx - newIdx] == 1 // TrueQ,
switchNeighborsInPlace[matrix, oldIdx, newIdx, which];
labelsList[[{oldIdx, newIdx}]] = labelsList[[{newIdx, oldIdx}]];
oldIdx = newIdx
];
drawHighlightingRectangles[len_, row_, col_] := {
FaceForm[], EdgeForm[{Red, Thickness @ 0.01}],
If[NumericQ @ row,
Rectangle[{0, len - row}, {len, len - row + 1}],
Sequence[]
],
FaceForm[], EdgeForm[{Purple, Thickness @ 0.01}],
If[NumericQ @ col,
Rectangle[{col - 1, 0}, {col, len}],
Sequence[]
]
};
makeFrameTicks[len_Integer, labels_List] := {
{#, #}, {#, #}
} & @ Thread @ {Range @ len, labels};
makeFrameTicks[lenghts_List, labelsRows_List, labelsCols_List] := {
{#1, #1}, {#2, #2}
} & [
Thread @ {Range @ lenghts[[1]], labelsRows},
Thread @ {Range @ lenghts[[2]], labelsCols}
];
makeFrameTicks[labels_List] := makeFrameTicks[Length @ labels, labels];
makeFrameTicks[labelsRows_List, labelsCols_List] := makeFrameTicks[
Length /@ {labelsRows, labelsCols}, labelsRows, labelsCols
];
Attributes @ dynamicMatrixPlot = HoldFirst;
Options @ dynamicMatrixPlot = {"OverlayRectangles" -> False};
dynamicMatrixPlot[matrix_, opts : OptionsPattern[]] := If[
(* If the input is directly given as a matrix, we make local variable holding
it and recall the function with that variable as argument *)
! MatchQ[Hold @ matrix, Hold @ _Symbol],
Module[{mat = matrix}, dynamicMatrixPlot[mat, opts]],
With[{overlayRectangles = TrueQ @ OptionValue @ "OverlayRectangles"},
DynamicModule[{
len = Length @ matrix,
oldRow, oldCol,
rowsOrder = Range @ Length @ matrix,
colsOrder = Range @ Length @ matrix
},
EventHandler[
Dynamic @ MP[matrix,
(* Epilog is used to draw the rectangles highlighting the row/column
that is being moved *)
If[overlayRectangles,
Epilog -> drawHighlightingRectangles[len, oldRow, oldCol],
Unevaluated @ Sequence[]
],
FrameTicks -> makeFrameTicks @@ {rowsOrder, colsOrder}
],
{
"MouseDown" :> (
Set[oldRow, rowNumber @ matrix];
Set[oldCol, colNumber @ matrix]
),
"MouseDragged" :> (
If[And[
mouseOnGraphics[],
rowNumber @ matrix =!= None,
colNumber @ matrix =!= None
],
(* conditionallySwitchNeighbors handles the switching of neighboring
rows and columns. Note that it also changes in-place `oldRow`
and `oldCol`. *)
conditionallySwitchNeighbors[
matrix, rowsOrder, oldRow, rowNumber @ matrix, "Rows"
];
conditionallySwitchNeighbors[
matrix, colsOrder, oldCol, colNumber @ matrix, "Cols"
]
];
)
}
]
]]
];
The main idea is pretty simple: MP
(or, equivalently, MatrixPlot
) is used to draw the matrix, and an EventHandler
wraps the whole MP
handling the MouseDown
and MouseDragged
events.
To use it just call dynamicMatrixPlot
over the target matrix:
The function can also be used to modify a pre-existing matrix:
matrix = HamadardMatrix @ 4;
dynamicMatrixPlot @ matrix
will change matrix
to be what is currently shown in the plot.
The implementation is surely not optimal.
In particular, when the kernel is quitted the plots disappear, basically because MP
and the local variables created by Module
are not defined anymore.
I'm not sure how to fix this though, suggestions are welcome!