Message Boards Message Boards

GROUPS:

Automatically write a large binary matrix with known positions of 1?

Posted 4 months ago
313 Views
|
7 Replies
|
6 Total Likes
|

Hi everybody! I am new to Mathematica and I have a problem that I can not find a solution to by myself. I have a script where I need to input a binary matrix, which should look like this, for example:

M = {{0, 1, 0, 0, 1, 1, 0, 0}, 
     {1, 0, 1, 0, 0, 0, 0, 1},  
     {0, 1, 0, 1, 0, 0, 1, 0}, 
     {0, 0, 1, 0, 1, 0, 1, 0}, 
     {1, 0, 0, 1, 0, 1, 0, 0}, 
     {1, 0, 0, 0, 1, 0, 0, 1}, 
     {0, 0, 1, 1, 0, 0, 0, 1}, 
     {0, 1, 0, 0, 0, 1, 1, 0}}

However, what I actually have looks like this:

1 ZA 2 3 4 5 
2 ZA 1 6 7 
3 ZA 1 7 8 
4 ZA 1 8 9 
5 ZA 1 9 6 
6 ZA 2 5 10 11 
7 ZA 2 3 11 12 
8 ZA 3 4 12 13 
9 ZA 4 5 13 10 
10 ZA 6 9 14 
11 ZA 6 7 14 
12 ZA 7 8 14 
13 ZA 8 9 14 
14 ZA 10 11 12 13 

These numbers show which elements in each row should be equal to 1, while all the other elements should be equal to zero. Some of my examples contain up to 1000 rows and columns, so there is no way to write the matrix manually. Please, show me the automated way to write the matrix using the provided type of input. Thanks in advance, Anton

7 Replies

Anton,

You should consider using SparseArray[]. For example,

aa = SparseArray[{{1, 2}, {2, 4}} -> 1] 
aa //MatrixForm

Yields

Normal[aa]

 {{0, 1, 0, 0}, {0, 0, 0, 1}}

Which is what I believe you want. I would take your indices text file and make some sort of list from it (Import or semanticImport). Lets say your list looks like this:

bb = {{2, 3, 4}, {1, 6, 7}}

Then your array could be made many ways with something like this:

cc = Flatten[Table[Outer[List, {x}, bb[[x]]], {x, Length[bb]}], 2]
mat = SparseArray[cc -> 1]

I hope this helps.

Regards

Neil

Thank you very much, Neil! It really helped a lot - now I can construct a matrix. However, I have another trouble. I have an algorithm, which allows to find face vertices of a polyhedron from the face adjacency graph. It works good with the provided example of matrix M, which shows which vertices of the polyhedron are connected with each other with edges, and which are not:

M = {{0, 1, 0, 0, 1, 1, 0, 0}, 
     {1, 0, 1, 0, 0, 0, 0, 1},  
     {0, 1, 0, 1, 0, 0, 1, 0}, 
     {0, 0, 1, 0, 1, 0, 1, 0}, 
     {1, 0, 0, 1, 0, 1, 0, 0}, 
     {1, 0, 0, 0, 1, 0, 0, 1}, 
     {0, 0, 1, 1, 0, 0, 0, 1}, 
     {0, 1, 0, 0, 0, 1, 1, 0}}

 GraphPlot[M]   

  g = AdjacencyGraph[M , GraphLayout -> "PlanarEmbedding", 
             VertexLabels -> "Name", ImagePadding -> 5]
nextCandidate[s_, t_, adj_] :=
   Block[{ length, pos},
      length = Length[adj];
      pos = Mod[Position[adj, s][[1, 1]] + 1, length, 1];
      {t, adj[[pos]]}
    ];

FindFace[g_?PlanarGraphQ] :=
       Block[{emb},
          emb = GraphEmbedding[g, "PlanarEmbedding"];
          FindFace[g, emb]
       ]; 

   FindFace[g_?PlanarGraphQ, emb_] :=
   Block[{m, orderings, pAdj, rightF, s, t, initial, face},
       m = AdjacencyMatrix[g];
       Table[pAdj[v] = 
           SortBy[Pick[VertexList[g], m[[v]], 1], 
           ArcTan @@ (emb[[v]] - emb[[#]]) &], {v, VertexList[g]}];
       rightF[_] := False;
       Reap[
         Table[
           If[  ! rightF[e],
             s = e[[1]];
             t = e[[2]];
             initial = s;
             face = {s};
             While[t =!= initial,
               rightF[UndirectedEdge[s, t]] = True;
               {s, t} = nextCandidate[s, t, pAdj[t]];
               face = Join[face, {s}];
             ];
             Sow[face];
           ],
         {e, EdgeList[g]}]][[2, 1]]
     ]
FindFace[g, GraphEmbedding[g]] 

I get the following result, which lists the vertices of all faces - this is exactly what I want to do, but for very large polyhedra:

{{1,2,8,6},{1,5,4,3,2},{1,6,5},{2,3,7,8},{3,4,7},{4,5,6,8,7}}

However, if I replace the input matrix M with the one found using your algorithm, I get errors which I can not fix:

 bb = {{2, 3, 4, 5},
 {1, 6, 7 },
 { 1, 7, 8 },
 { 1, 8, 9 },
 { 9, 6 },
 { 2, 5,10,11 },
 { 2 ,3 ,11 ,12 },
 { 3 ,4, 12, 13 },
 { 4 ,5 ,13 ,10 },
 { 6 ,9, 14 },
 { 6 ,7 ,14 },
 { 7 ,8, 14 },
 { 8 ,9 ,14 },
 { 10, 11, 12,13}} 

cc = Flatten[Table[Outer[List, {x}, bb[[x]]], {x, Length[bb]}], 2]

M = SparseArray[cc -> 1] 

My efforts show that this happens because the new matrix is larger than the first one, because even if I use the same manual input, but larger matrix - it results in the same errors:

Mat  = {{0,1,1,1,1,0,0,0,0,0,0,0,0,0},
{1,0,0,0,0,1,1,0,0,0,0,0,0,0},
{1,0,0,0,0,0,1,1,0,0,0,0,0,0},
{1,0,0,0,0,0,0,1,1,0,0,0,0,0},
{0,0,0,0,0,1,0,0,1,0,0,0,0,0},
{0,1,0,0,1,0,0,0,0,1,1,0,0,0},
{0,1,1,0,0,0,0,0,0,0,1,1,0,0},
{0,0,1,1,0,0,0,0,0,0,0,1,1,0},
{0,0,0,1,1,0,0,0,0,1,0,0,1,0},
{0,0,0,0,0,1,0,0,1,0,0,0,0,1},
{0,0,0,0,0,1,1,0,0,0,0,0,0,1},
{0,0,0,0,0,0,1,1,0,0,0,0,0,1},
{0,0,0,0,0,0,0,1,1,0,0,0,0,1},
{0,0,0,0,0,0,0,0,0,1,1,1,1,0}}  

On the other hand, the script works if I input a smaller matrix with your method:

bb = {{2, 5, 6},
 {1, 3, 8 },
 { 2, 4, 7 },
 { 3, 5, 7 },
 { 1, 4, 6 },
 { 1, 5,8 },
 { 3 ,4 ,8 },
 { 2 ,6, 7 }} 

cc = Flatten[Table[Outer[List, {x}, bb[[x]]], {x, Length[bb]}], 2]

M = SparseArray[cc -> 1]

I hope that this issue is easily solved and I kindly ask for your help. Thanks in advance, Anton

Anton,

It's hard to say what is going on without diving into the code. One difference to consider is to recognize that the SparseArray and arrays are different. You may want to convert the SparseArray to a regular array with Normal[]. If that does not fix the problem then there is an algorithmic problem with certain input matrices.

Another suggestion is to look at iGraph/M. If I understand your application correctly iGraph/M was written to do this type of thing:

http://szhorvat.net/pelican/igraphm-a-mathematica-interface-for-igraph.html

maybe @Szabolcs Horvát can comment on if this is an application for his software.

Regards,

Neil

Hello Anton and Neil,

The released version of IGraph/M doesn't yet deal with planar graphs. However, the next version will gain a lot of functionality in this area. If you would like to test it in advance, you can try this version: https://www.dropbox.com/s/loo23lx5fq2980b/IGraphM-0.3.99.90.paclet?dl=0 (Install it like this.) This paclet should work on Windows and Mac, but not on Linux. If you need a Linux version, email me.

Be warned that this version isn't quite ready, and it is meant for testing. There are certainly more bugs than usual. Feedback on the planar graph functionality is most welcome (and would be very helpful, even just confirming that it runs on your Windows system).

The relevant functions for you are:

  • IGFaces finds the faces of a planar graph (without any reference to coordinates)
  • IGCoordinatesToEmbedding does something similar to your FindFaces function, but it returns a combinatorial embedding (not a list of faces), which in turn can be processed using IGFaces
  • IGPlanarEmbedding returns a combinatorial embedding of the graph
  • IGDualGraph finds the dual of a planar graph

The Planar Graphs section of the documentation has descriptions of most of these.

I have not yet tested this on large graphs, but the core functionality is written in C, so it should be possible to get good performance (and improve things in case the pure-Mathematica part slows it down).

Anton,

I looked at your code a bit to see why it might crash. Click on the stack trace and you can see the problem. Its in the function nextCandidate. It appears that you are trying to find a 1 in a vector {9,6}

here is part of the stack trace:

length = Length[{9, 6}]; pos = 
 Mod[Position[{9, 6}, 1][[1, 1]] + 1, length, 1]; {5, {9, 6}[[pos]]}

I recommend that you click on the stack trace (the three dots in a bubble next to the error) and review that to find out where the code goes wrong and you should be able to fix it (since you know it better than I do). My guess is that there is some case that you did not handle in your function and the trace should show what it it.

I also suggest that you do not start your variables or functions with capital letters -- one day you will have a bug due to a conflict with internal symbols (as they all begin with capital letters)

I hope that helps.

Regards,

Neil

Well, it seems that all problems were related to my inattention. It is not in the size of the matrix, but in the type of the matrix - it should be symmetric. I was inaccurate to make a mistake in just one value in my matrix. If one uses corrected input matrix, which looks like this:

M = {{0,1,1,1,1,0,0,0,0,0,0,0,0,0},
{1,0,0,0,0,1,1,0,0,0,0,0,0,0},
{1,0,0,0,0,0,1,1,0,0,0,0,0,0},
{1,0,0,0,0,0,0,1,1,0,0,0,0,0},
{1,0,0,0,0,1,0,0,1,0,0,0,0,0},
{0,1,0,0,1,0,0,0,0,1,1,0,0,0},
{0,1,1,0,0,0,0,0,0,0,1,1,0,0},
{0,0,1,1,0,0,0,0,0,0,0,1,1,0},
{0,0,0,1,1,0,0,0,0,1,0,0,1,0},
{0,0,0,0,0,1,0,0,1,0,0,0,0,1},
{0,0,0,0,0,1,1,0,0,0,0,0,0,1},
{0,0,0,0,0,0,1,1,0,0,0,0,0,1},
{0,0,0,0,0,0,0,1,1,0,0,0,0,1},
{0,0,0,0,0,0,0,0,0,1,1,1,1,0}}

or like this:

bb = {{2, 3, 4, 5},
 {1, 6, 7 },
 { 1, 7, 8 },
 { 1, 8, 9 },
 { 1, 9, 6 },
 { 2, 5,10,11 },
 { 2 ,3 ,11 ,12 },
 { 3 ,4, 12, 13 },
 { 4 ,5 ,13 ,10 },
 { 6 ,9, 14 },
 { 6 ,7 ,14 },
 { 7 ,8, 14 },
 { 8 ,9 ,14 },
 { 10, 11, 12,13}} 

the same script by @Szabolcs Horvát works perfectly! And this totally solves my problem! Once again, thank you, Neil - you actually helped to solve the title problem of the post. Szabolcs, thank you for the script for finding face vertices from the face adjacency graph, which I found in the community, and for the beta version of IGraph/M - I will contact you in case I have any feedback information. Best regards, Anton

If anyone is still looking at this, please get the IGraph/M with planar graph functionality from here: https://www.dropbox.com/s/558aq5dynz81huk/IGraphM-0.3.99.92.paclet?dl=0 This version now supports Linux again.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract