Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I'm trying to sketch polymers. Here is how I do it for the monomer:

Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 5 <-> 6, 6 <-> 1, 4 <-> 7, 7 <-> 8}] 

Mathematica graphics

How can the left part arranged to form a regular hexagon? This is only a subunit so for polymers there are more. Is there a general way to do so? For the polymer, I wrote an ugly one:

Mol[k_] := Join[
   Table[Join[
     Table[(8 n + i) <-> (8 n + i + 1), {i, 5}],
     {(8 n + 6) <-> (8 n + 1), (8 n + 4) <-> (8 n + 7), (8 n + 7) <-> (8 n + 8),
      (8 n + 8) <-> (8 n + 9)}], {n, 0, k - 2}],
   Join[Table[(8 (k - 1) + i) <-> (8 (k - 1) + i + 1), {i, 5}],
     {(8 (k - 1) + 6) <-> (8 (k - 1) + 1), (8 (k - 1) + 4) <-> (8 (k - 1) + 7),
      (8 (k - 1) + 7) <-> (8 (k - 1) + 8)}]] // Flatten;

Graph[Mol[5], VertexLabels -> "Name", ImagePadding -> 10, ImageSize -> 1000]

Mathematica graphics

share|improve this question
    
Have you tried ChemicalData /@ ChemicalData["Polymers"]? –  belisarius Dec 9 '13 at 0:07
    
A good point, but I'm going to use AdjacencyMatrix[] after this and apply Huckel model, so it's better to use Graph here. –  xunmo Dec 9 '13 at 5:02
    
It's not about being purist but there is a hexagon. You mean regular one? –  Kuba Dec 9 '13 at 9:03
    
Yes, a regular one. I have updated my question. Thanks. –  xunmo Dec 9 '13 at 22:41
1  
Please provide your code for making a polymer and show an example how it should look. –  Kardashev3 Dec 10 '13 at 9:34
show 3 more comments

2 Answers

You could use "SpringEmbedding" for GraphLayout:

Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 5 <-> 6, 6 <-> 1, 4 <-> 7,
7 <-> 8}, GraphLayout -> "SpringEmbedding"]

Mathematica graphics

and reverse direction by reversing the whole structure

Graph[{8 <-> 7, 7 <-> 4, 1 <-> 6, 6 <-> 5, 5 <-> 4, 4 <-> 3, 3 <-> 2, 
2 <-> 1}, GraphLayout -> "SpringEmbedding"]

Mathematica graphics

Update:

By generating a polymer chain using

Mol[k_] := 
Join[Table[{(8 + 8*i) <-> (7 + 8*i), (7 + 8*i) <-> (4 + 8*i), (1 + 
8*i) <-> (6 + 8*i), (6 + 8*i) <-> (5 + 8*i), (5 + 
8*i) <-> (4 + 8*i), (4 + 8*i) <-> (3 + 8*i), (3 + 
8*i) <-> (2 + 8*i), (2 + 8*i) <-> (1 + 8*i)}, {i, 0, k - 1}], 
Table[{(8 + 8*i) <-> (9 + 8*i)}, {i, 0, k - 1}]];

I get this for a length of 5:

Graph[Flatten@Mol[5], GraphLayout -> "SpringEmbedding",
ImagePadding -> 10, ImageSize -> 1000]

Mathematica graphics

By using InferentialDistance as a parameter the chain can be straightened to a certain degree:

Graph[Flatten@Mol[5], 
GraphLayout -> {"SpringEmbedding", "InferentialDistance" -> 1000}, 
ImagePadding -> 10, ImageSize -> 1000]

Mathematica graphics

But this doesn't work for longer chains:

Graph[Flatten@Mol[50], 
GraphLayout -> {"SpringEmbedding", "InferentialDistance" -> 1000}, 
ImagePadding -> 10, ImageSize -> 1000]

Mathematica graphics

share|improve this answer
    
Thanks. It works for the unit, but when I make a polymer it fails. –  xunmo Dec 9 '13 at 20:50
    
Please provide your code for making a polymer and show an example how it should look. –  Kardashev3 Dec 10 '13 at 7:11
add comment

Here is another approach to your problem using VertexCoordinates:

The single unit is given by

single = {8 <-> 7, 7 <-> 4, 1 <-> 6, 6 <-> 5, 5 <-> 4, 4 <-> 3, 3 <-> 2, 2 <-> 1};

and the coordinates of the vertices are calculated with

singlecoords = 
Join[Table[(i + 1) -> {Sin[3/2*Pi + i*Pi/3], 
Cos[3/2*Pi + i*Pi/3]}, {i, 0, 5}], {7 -> {2, 0}, 8 -> {3, 0}}];

then you can plot the basic unit using

Graph[single, VertexLabels -> "Name", 
VertexCoordinates -> singlecoords, ImagePadding -> 10]

Mathematica graphics

Now we can generate a polymer of desired length with

Mol2[k_] := {Flatten[
Join[Table[{(8 + 8*i) <-> (7 + 8*i), (7 + 8*i) <-> (4 + 
8*i), (1 + 8*i) <-> (6 + 8*i), (6 + 8*i) <-> (5 + 
8*i), (5 + 8*i) <-> (4 + 8*i), (4 + 8*i) <-> (3 + 
8*i), (3 + 8*i) <-> (2 + 8*i), (2 + 8*i) <-> (1 + 8*i)}, {i,
0, k - 1}], Table[{(8 + 8*i) <-> (9 + 8*i)}, {i, 0, k - 2}]]],
Flatten[{Table[
Join[Table[(i + 1 + j*8) -> {Sin[3/2*Pi + i*Pi/3] + j*5, 
Cos[3/2*Pi + i*Pi/3]}, {i, 0, 
5}], {(7 + j*8) -> {2 + j*5, 0}, (8 + j*8) -> {3 + j*5, 
0}}], {j, 0, k - 1}]}]};

where the first element generates the vertices and the second element calculates the vertex coordinates.

For length 2 we get

polymer = Mol2[2];

Graph[polymer[[1]], VertexLabels -> "Name", 
VertexCoordinates -> polymer[[2]], ImagePadding -> 10, 
ImageSize -> 1000]

Mathematica graphics

and for length 10 it looks like this:

polymer = Mol2[10];

Graph[polymer[[1]], VertexLabels -> "Name", 
VertexCoordinates -> polymer[[2]], ImagePadding -> 10, 
ImageSize -> 1000]

Mathematica graphics

share|improve this answer
    
Cool. Thank you so much. –  xunmo Dec 12 '13 at 2:44
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.