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