5
$\begingroup$

I want to plot a series of lines. This is how I did it:

Table[{y==(1/Sqrt[3])*x+i,y==-(1/Sqrt[3])*x+i,x==i*Sqrt[3]/2,x==i*Sqrt[3]/2},{i, -3, 3}]

(*Output: 
{{y == -3 + x/Sqrt[3], y == -3 - x/Sqrt[3]}, {y == -2 + x/Sqrt[3], 
y == -2 - x/Sqrt[3]}, {y == -1 + x/Sqrt[3], 
y == -1 - x/Sqrt[3]}, {y == x/Sqrt[3], 
y == -(x/Sqrt[3])}, {y == 1 + x/Sqrt[3], 
y == 1 - x/Sqrt[3]}, {y == 2 + x/Sqrt[3], 
y == 2 - x/Sqrt[3]}, {y == 3 + x/Sqrt[3], y == 3 - x/Sqrt[3]}} *)




 ContourPlot[{
    {y == -3 + x/Sqrt[3], y == -3 - x/Sqrt[3], x == -((3 Sqrt[3])/2)}, 
    {y == -2 + x/Sqrt[3], y == -2 - x/Sqrt[3], x == -Sqrt[3]},
    {y == -1 + x/Sqrt[3], y == -1 - x/Sqrt[3], x == -(Sqrt[3]/2)}, 
    {y == x/Sqrt[3], y == -(x/Sqrt[3]), x == 0}, 
    {y == 1 + x/Sqrt[3], y == 1 - x/Sqrt[3], x == Sqrt[3]/2}, 
    {y == 2 + x/Sqrt[3], y == 2 - x/Sqrt[3], x == Sqrt[3]}, 
    {y == 3 + x/Sqrt[3], y == 3 - x/Sqrt[3], x == (3 Sqrt[3])/2}}, 
    {x, -3, 3}, {y, -3, 3}
  ]

This works. Triangle Lattice

But it is kind of stupid and tedious. I hope to do it more concisely.

Then I tried in these ways:

eqns = Table[{y==(1/Sqrt[3])*x+i,y == -(1/Sqrt[3])*x+i}, {i, -3, 3}];
ContourPlot[eqns, {x, -3, 3}, {y, -3, 3}]

or straightforwardly:

ContourPlot[
  Table[{y==(1/Sqrt[3])*x+i,y==-(1/Sqrt[3])*x+i}, {i, -3, 3}],
  {x, -3, 3}, {y, -3, 3}
]

or, using pure functions perhaps?

eqns[#1,#2]&=Table[{#2 == (1/Sqrt[3])*#1 + i, #2 == -(1/Sqrt[3])*#1 + i, #1 == 
i*Sqrt[3]/2}, {i, -7, 7}] &
ContourPlot[eqns[#1,#2]&[x,y], {x, -3, 3}, {y, -3, 3}]

But these didn't work.

So how to achieve this in a more concise way? Are there any possible methods using pure functions, mapping, and all kinds of these things to get it done? (I am a beginner in Mathematica, not quite familiar with the functions or these kind of things and I am still learning about it. )

If there are any other resources that could help me figure it out, please tell me. Thank you very much!

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I hope you will become a regular contributor. To get started, 1) take the introductory Tour now, 2) when you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge, and 3) remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign. $\endgroup$ – bbgodfrey May 22 '15 at 2:17
  • $\begingroup$ Why not just Plot[]? Plot[Table[{i + x/Sqrt[3], i - x/Sqrt[3]}, {i, -3, 3}] // Flatten // Evaluate, {x, -3, 3}] $\endgroup$ – J. M. will be back soon May 22 '15 at 2:18
  • $\begingroup$ @Guesswhoitis. Perhaps, you meant Plot[Evaluate[ Table[{(1/Sqrt[3])*x + i, -(1/Sqrt[3])*x + i}, {i, -7, 7}]], {x, -3, 3}]. No Flatten or y. $\endgroup$ – bbgodfrey May 22 '15 at 2:27
  • $\begingroup$ Ah, @bbgodfrey, forgot to remove the other iterator; thanks. But the result is still a nested list; okay if OP wants the pairs to have the same color, but not otherwise. $\endgroup$ – J. M. will be back soon May 22 '15 at 2:41
5
$\begingroup$
eqns = Table[{y==(1/Sqrt[3])*x+i,y == -(1/Sqrt[3])*x+i}, {i, -3, 3}];

ContourPlot[Evaluate[## & @@@ eqns], {x, -3, 3}, {y, -3, 3}]

Mathematica graphics

eqns2 = Table[{ x == i Sqrt[3]/2, y == (1/Sqrt[3])*x + i, 
                y == -(1/Sqrt[3])*x + i}, {i, -7, 7}];

ContourPlot[Evaluate[## & @@@ eqns2], {x, -3, 3}, {y, -3, 3}]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thank u very much! This is quite concise. $\endgroup$ – atoman May 22 '15 at 14:26
  • $\begingroup$ @atoman, my pleasure. Thank you for the accept. And welcome to mma.se. $\endgroup$ – kglr May 22 '15 at 14:55
7
$\begingroup$

You need to either join all desired plots, e.g.

ContourPlot[#, {x, -10, 10}, {y, -10, 10}, 
   ContourStyle -> Red] &@(Join @@ 
   Table[{y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i, 
     x == i*Sqrt[3]/2}, {i, -7, 7}])

or Show, e.g.:

Show[ContourPlot[#, {x, -10, 10}, {y, -10, 10}, 
    ContourStyle -> Red] & /@ 
  Table[{y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i, 
    x == i*Sqrt[3]/2}, {i, -7, 7}]]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ …although, it might be simpler to use Line[] or the newer InfiniteLine[] to generate the required picture. $\endgroup$ – J. M. will be back soon May 22 '15 at 3:08
  • $\begingroup$ @Guesswhoitis. I guess I was not so much interested in the underlying aim but addressing achieving it...agree other ways to achieve this result :-) $\endgroup$ – ubpdqn May 22 '15 at 3:12
  • 2
    $\begingroup$ @Guesswhoitis. Hmm... Graphics[GeometricTransformation[InfiniteLine[{0, 0}, {0, 1}], Flatten@Outer[Dot,Table[RotationTransform[2 Pi/3 i], {i, 3}], Table[TranslationTransform[{i Sqrt[3]/2, 0}], {i, -Ceiling[3/(Sqrt[3]/2)], Ceiling[3/(Sqrt[3]/2)]}]]], PlotRange -> 3, Frame -> True] --> i.stack.imgur.com/2XcZx.png suggests $\infty\approx\sqrt{2}$. (Line[] works fine.) $\endgroup$ – Michael E2 May 22 '15 at 10:23
  • $\begingroup$ @Michael, wow. Now that's something to report… $\endgroup$ – J. M. will be back soon May 22 '15 at 10:41
5
$\begingroup$
eqs = Table[{y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i, x == i*Sqrt[3]/2},
    {i, -7, 7}];

ParametricPlot[
 Evaluate[{x, y} /. ToRules /@ Flatten[eqs] /. {x -> t, y -> t}],
 {t, -3, 3}, PlotRange -> 3]

Mathematica graphics

$\endgroup$
  • $\begingroup$ neat use of ToRules +1 :) $\endgroup$ – ubpdqn May 22 '15 at 3:57
  • $\begingroup$ @ubpdqn Thanks. +1, to you, too. $\endgroup$ – Michael E2 May 22 '15 at 10:25
  • $\begingroup$ Thank u very much! By this I begin to learn the ToRules. $\endgroup$ – atoman May 22 '15 at 14:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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