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]
Related
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]
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}}}}
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]
I have a list of lists with inner lists possibly of variable lengths. I need to sort the outer list based on the alphabetical order of the inner list elements. For example, given a list of
{{0, 0, 7}, {5, 0, 2, 3}, {0, 0, 10, 0}, {0, 6, 2}, {5, 1, 2}, {0, 3, 6, 1, 4}}
I want the output after Sort to be
{{0, 0, 10, 0}, {0, 0, 7}, {0, 3, 6, 1, 4}, {0, 6, 2}, {5, 0, 2, 3}, {5, 1, 2}}
I just do not know how to handle the variable lengths of inner lists in order to write a comparison function. Please help.
Edit
BTW, the original list is a numerical one.
Edit 2
For example, I have a list:
{{0, 0, 7}, {5, 0, 2, 3}, {0, 0, 11, 0}, {0, 0, 1, 12}, {0, 6, 2}, {5, 1, 2}, {0, 3, 6, 1, 4}}
The output should be:
{{0, 0, 1, 12}, {0, 0, 11, 0}, {0, 0, 7}, {0, 3, 6, 1, 4}, {0, 6, 2}, {5, 0, 2, 3}, {5, 1, 2}}
The reason is that 1 is lexically less than 11, which is less than 7.
You can set up a lexciographic comparator like this:
lexComp[_, {}] := False;
lexComp[{}, _] := True;
lexComp[{a_, as___}, {b_, bs___}] := a < b || a == b && lexComp[{as}, {bs}];
You can then sort using that to get the desired effect:
Sort[{{0, 0, 7}, {5, 0, 2, 3}, {0, 0, 10, 0}, {0, 6, 2}, {5, 1, 2}, {0, 3, 6, 1, 4}}, lexComp]
{{0, 0, 7}, {0, 0, 10, 0}, {0, 3, 6, 1, 4}, {0, 6, 2}, {5, 0, 2, 3}, {5, 1, 2}}
If you wish to treat the numbers as strings in your sorting, you can modify it like so:
lessAsString[a_, b_] := Order ## (ToString /# {a, b}) === 1;
olexComp[_, {}] := False;
olexComp[{}, _] := True;
olexComp[{a_, as___}, {b_, bs___}] := lessAsString[a, b] || a === b && olexComp[{as}, {bs}];
Here is the example of such a sort:
In[5]:= Sort[{{0, 0, 7}, {5, 0, 2, 3}, {0, 0, 11, 0}, {0, 0, 1, 12}, {0, 6, 2}, {5, 1, 2}, {0, 3, 6, 1, 4}}, olexComp]
Out[5]= {{0, 0, 1, 12}, {0, 0, 11, 0}, {0, 0, 7}, {0, 3, 6, 1, 4}, {0, 6, 2}, {5, 0, 2, 3}, {5, 1, 2}}
alphaSort = #[[ Ordering # Map[ToString, PadRight##, {2}] ]] &;
This works by preparing the data for the default Ordering sort, and then using that order to sort the original list.
In this case, padding all of the lists to the same length keeps this Sort property from interfering:
Sort usually orders expressions by putting shorter ones first, and then comparing parts in a depth-first manner.
ToString is used to get an alphabetical order rather than a numeric one.
This should do it
{{0, 0, 7}, {5, 0, 2, 3}, {0, 0, 10, 0}, {0, 6, 2}, {5, 1, 2}, {0, 3,
6, 1, 4}} // SortBy[#, ToString] &
This works because lexically, comma and space precede the numbers, so {a,b} is lexically before {a,b,c}.
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}}