How to trace a path graphically in a matrix in mathematica - wolfram-mathematica

I have a matrix, i.e., a non-ragged list of lists, and given a list of coordinates, for example in form of {{0,0},{1,1},{2,2},...{5,5}}, I want to trace a path in that matrix and show the results graphically. A colored band for the path is good enough.
Please help me to write such a function in Mathematica. Thanks a lot!


Here's one possibility.
pos = {{1, 1}, {1, 2}, {2, 2}, {3, 3},
{3, 4}, {3, 5}, {4, 5}, {5, 5}};
mat = HankelMatrix[8];
display = Map[Pane[#,{16,20},Alignment->Center]&, mat, {2}];
display = MapAt[Style[#, Background -> Yellow]&, display, pos];
Grid[display, Spacings->{0,0}]
Outlining the entries with a tube, as you describe, is harder. It can be done, though, if we are willing to step down to graphics primitives.
mat = IdentityMatrix[8];
pos = {{1, 1}, {1, 2}, {2, 2}, {3, 3},
{3, 4}, {3, 5}, {4, 5}, {5, 5}};
pos = Map[{#[[1]], -#[[2]]} &, pos];
outline = {CapForm["Round"], JoinForm["Round"],
{AbsoluteThickness[30], Line[pos]},
{AbsoluteThickness[28], White, Line[pos]}};
disks = Table[{Darker[Yellow, 0.07], Disk[p, 0.25]},
{p, pos}];
numbers = MapIndexed[Style[Text[#, {#2[[1]], -#2[[2]]},
{-0.2, 0.2}], FontSize -> 12] &, mat, {2}];
Graphics[{outline, disks, numbers}, ImageSize -> 300]


Another possibility, using ItemStyle:
m = RandomInteger[10, {10, 10}];
c = {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {5, 5}, {5, 6}, {5, 7}, {4, 8}};
Grid[m, ItemStyle -> {Automatic, Automatic, Table[i -> {16, Red}, {i, c}]}]
Which ends up looking like this:


I may have misunderstood the question but this is what I thought you were asking for:
coords = Join ## Array[List, {3, 4}]
{{1, 1}, {1, 2}, {1, 3}, {1, 4}, {2, 1}, {2, 2}, {2, 3}, {2, 4}, {3,
1}, {3, 2}, {3, 3}, {3, 4}}
path = RandomSample[coords, Length[coords]]
{{1, 2}, {3, 3}, {2, 2}, {2, 4}, {3, 1}, {1, 4}, {1, 3}, {2, 1}, {3,
4}, {3, 2}, {2, 3}, {1, 1}}
labels = Text[StyleForm[#], #] & /# coords;
Graphics[Line[path], Epilog -> labels]

Related

loop to generate iterative rows of a matrix in mathematica

I have a matrix
FT= {{0, 0, 0}, {1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 2, 1}, {1, 2, 2}, {1,
2, 3}, {1, 3, 1}, {1, 3, 2}, {1, 3, 3}, {2, 1, 1}, {2, 1, 2}, {2,
1, 3}, {2, 2, 1}, {2, 2, 2}, {2, 2, 3}, {2, 3, 1}, {2, 3, 2}, {2, 3,
3}, {2, 4, 1}, {2, 4, 2}, {2, 4, 3}, {2, 5, 1}, {2, 5, 2}, {2, 5,
3}, {2, 6, 1}, {2, 6, 2}, {2, 6, 3}, {3, 1, 1}, {3, 1, 2}, {3, 1,
3}, {3, 2, 1}, {3, 2, 2}, {3, 2, 3}, {3, 3, 1}, {3, 3, 2}, {3, 3,
3}, {3, 4, 1}, {3, 4, 2}, {3, 4, 3}, {3, 5, 1}, {3, 5, 2}, {3, 5,
3}, {3, 6, 1}, {3, 6, 2}, {3, 6, 3}, {3, 7, 1}, {3, 7, 2}, {3, 7,
3}, {3, 8, 1}, {3, 8, 2}, {3, 8, 3}, {3, 9, 1}, {3, 9, 2}, {3, 9,
3}, {3, 10, 1}, {3, 10, 2}, {3, 10, 3}, {3, 11, 1}, {3, 11, 2}, {3,
11, 3}, {3, 12, 1}, {3, 12, 2}, {3, 12, 3}}
Where each row represents a kind of address of each element whose first element gives G, second element gives B and the third element gives M. For e.g. for 3rd element G is 1, B is 1 and M is 2 and so on. Now i need to generate a matrix for each element such that whenever my G is 0 or 1 it gives me {0,0,0} and for G>1 it gives me rows with G-1, G-2 and so on till it gives 1; and for B it gives a check for whenever B is even it returns B/2 and whenever B is odd it returns (B+1) /2 and M takes value of 3 every time and finally a row {0,0,0}. For e.g. for last element with FT= {3,12,3} it should give me {{2,6,3}, {1,3,3}, {0,0,0}} and for FT= {2,5,1} it should give me {{1,3,3}, {0,0,0}}.
Can you please help me writing code for this in mathematica.
Thanks in advance :)

For this demo lower-case symbols are used to avoid conflicting with built-in functions, e.g. D, E, I, N
This function defines the basic operation
op[{g_, b_, m_}] := {g - 1, If[EvenQ[b], b/2, (b + 1)/2], 3}
which should be applied repeatedly until a condition is met. NestWhileList is useful for this, e.g.
NestWhileList[op[#] &, {3, 12, 3}, First[#] > 1 &]
{{3, 12, 3}, {2, 6, 3}, {1, 3, 3}}
Another function uses the above if g > 1 :-
f[{g_, b_, m_}] := Append[
If[g > 1, Rest#NestWhileList[op, {g, b, m}, First[#] > 1 &],
{}], {0, 0, 0}]
E.g.
f[{2, 5, 1}]
{{1, 3, 3}, {0, 0, 0}}
Now f can be mapped over ft :-
ft = {
{0, 0, 0}, {1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 2, 1},
{1, 2, 2}, {1, 2, 3}, {1, 3, 1}, {1, 3, 2}, {1, 3, 3},
{2, 1, 1}, {2, 1, 2}, {2, 1, 3}, {2, 2, 1}, {2, 2, 2},
{2, 2, 3}, {2, 3, 1}, {2, 3, 2}, {2, 3, 3}, {2, 4, 1},
{2, 4, 2}, {2, 4, 3}, {2, 5, 1}, {2, 5, 2}, {2, 5, 3},
{2, 6, 1}, {2, 6, 2}, {2, 6, 3}, {3, 1, 1}, {3, 1, 2},
{3, 1, 3}, {3, 2, 1}, {3, 2, 2}, {3, 2, 3}, {3, 3, 1},
{3, 3, 2}, {3, 3, 3}, {3, 4, 1}, {3, 4, 2}, {3, 4, 3},
{3, 5, 1}, {3, 5, 2}, {3, 5, 3}, {3, 6, 1}, {3, 6, 2},
{3, 6, 3}, {3, 7, 1}, {3, 7, 2}, {3, 7, 3}, {3, 8, 1},
{3, 8, 2}, {3, 8, 3}, {3, 9, 1}, {3, 9, 2}, {3, 9, 3},
{3, 10, 1}, {3, 10, 2}, {3, 10, 3}, {3, 11, 1}, {3, 11, 2},
{3, 11, 3}, {3, 12, 1}, {3, 12, 2}, {3, 12, 3}};
matrix = Map[f, ft]

Mathematica: flatten a nested list with repetitions

I have a following list:
lis={{1, {2}}, {3, {4, 5, 6}}, {7, {8, 9}}, {10, {11}}};
I'd like to obtain this:
lis2={{1, 2}, {3, 4}, {3, 5}, {3, 6}, {7, 8}, {7, 9}, {10, 11}};
I can achieve that using nested tables and calculating the length of the second nested list:
Flatten[Table[Table[{lis[[kk, 1]], lis[[kk, 2, ii]]}, {ii, 1, Length[lis[[kk, 2]]]}], {kk, 1, Length[lis]}], 1]
It works, but is there a more straightforward way? Perhaps a combination of Map/Thread/Apply?

One way:
ArrayFlatten[Distribute[#, List] & /# lis, 1]
=> {{1, 2}, {3, 4}, {3, 5}, {3, 6}, {7, 8}, {7, 9}, {10, 11}}
Edit
Or
ArrayFlatten[Thread /# lis, 1]
Edit 2
Or, slightly simpler, as Mr Wizard points out in a comment:
Flatten[Thread /# lis, 1]

Mathematica, group pairs with common values

I'm trying to use the GatherBy function in Mathematica in order to take the pairs in the list a={{1, 4}, {2, 3}, {1, 5}, {2, 5}, {3, 4}, {6, 8}, {6, 7}, {7, 8}} and sort by the pairs that contain the value 1. Ideally, output would look like Output={ { {1,4},{1,5} } , {{2, 3}, {2, 5}, {3, 4}, {6, 8}, {6, 7}, {7, 8} } } or something similar where the first element in the output is a list of all elements in a containing a 1 and the second element contains all pairs that do not contain a 1.

GatherBy[a, #[[1]] == 1 || #[[2]] == 1 &]

answering the q in the comment, Sort the result to ensure the desired order:
a = {{1, 4}, {2, 3}, {1, 5}, {2, 5}, {3, 4}, {6, 8}, {6, 7}, {7, 8}};
SortBy[GatherBy[a, MemberQ[#, 2] &], !MemberQ[First##, 2] &]
another approach :
Reap[Sow[ # , MemberQ[#, 2] ] & /# a, {True, False}] // Last
Either yields:
{{{{2, 3}, {2, 5}}}, {{{1, 4}, {1, 5}, {3, 4}, {6, 8}, {6, 7}, {7,
8}}}}

Drop nested Lists in Mathematica

Consider :
Tuples[Range[1, 3], 2]
I would like to drop some of the sublist based on the following list :
sublistToTemove = {1,2,3,6,8}
Desired Output :
{2, 1}, {2, 2}, {3, 1}
Corresponding to the 4th, 5th and 7th elements of list.
I have tried Drop, Case, Select without success, must be missing something.

Given your list:
In[2]:= lst = Tuples[Range[1, 3], 2]
Out[2]= {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3,2}, {3, 3}}
and
In[5]:= sublistToTemove = {1, 2, 3, 6, 8}
Out[5]= {1, 2, 3, 6, 8}
Here are 2 ways:
In[6]:= Delete[lst, List /# sublistToTemove]
Out[6]= {{2, 1}, {2, 2}, {3, 1}, {3, 3}}
In[7]:= lst[[Complement[Range[Length[lst]], sublistToTemove]]]
Out[7]= {{2, 1}, {2, 2}, {3, 1}, {3, 3}}

In[15]:= sublistToTemove = {1, 2, 3, 6, 8};
In[16]:= Delete[Tuples[Range[1, 3], 2], Transpose[{sublistToTemove}]]
Out[16]= {{2, 1}, {2, 2}, {3, 1}, {3, 3}}

MapThread for any combination of variables

I have a set of regular (mod 5) matrices N2 and I would like to get the group generated by these matrices in Mathematica:
My approach was to use a function f doing the matrix multiplication and g for mod 5 and then I wanted to use MapThread
M= Function[{x,y},x.y];
g = Function[z, Mod[z, 5]]
g /# MapThread[M, {N2,N2}]
The problem is that MapThread is inserting only pairs of elements that are at the same position in the lists. I would like to insert any pair of elements in N. To get the group generated by the matrices in N I would just repeat this and update N2 every time.
E.g. let N2 ={A,B}
g /# MapThread[M, {N2,N2}]
would return {B^2,A^2}, while I want it to return any product of matrices in N2, i.e. {A^2,AB,BA,B^2}.

I'm not sure whether I understand your question, but if your intention is to get all combinations of the two matrices A,B you could use Tuples combined with Apply (which you may use in its functional form with square brackets or as many here do in initially cryptic prefix operator form ### = Apply at level 1):
In[24]:= Dot ### Tuples[{A, B}, 2]
Out[24]= {A.A, A.B, B.A, B.B}

In this case you need Outer:
In[27]:= n = RandomInteger[{1, 5}, {3, 2, 2}];
In[28]:= Outer[mFunc, n, n, 1]
Out[28]= {{mFunc[{{3, 5}, {2, 4}}, {{3, 5}, {2, 4}}],
mFunc[{{3, 5}, {2, 4}}, {{3, 4}, {4, 3}}],
mFunc[{{3, 5}, {2, 4}}, {{4, 4}, {5, 1}}]}, {mFunc[{{3, 4}, {4,
3}}, {{3, 5}, {2, 4}}],
mFunc[{{3, 4}, {4, 3}}, {{3, 4}, {4, 3}}],
mFunc[{{3, 4}, {4, 3}}, {{4, 4}, {5, 1}}]}, {mFunc[{{4, 4}, {5,
1}}, {{3, 5}, {2, 4}}],
mFunc[{{4, 4}, {5, 1}}, {{3, 4}, {4, 3}}],
mFunc[{{4, 4}, {5, 1}}, {{4, 4}, {5, 1}}]}}
In[29]:= n
Out[29]= {{{3, 5}, {2, 4}}, {{3, 4}, {4, 3}}, {{4, 4}, {5, 1}}}

Resources