2
$\begingroup$
Union[FullSimplify[Flatten[
       Table[Sum[Exp[2 \[Pi] I Subscript[n, i]/5], {i, 0, 6}],
            {Subscript[n, 0], 0, 4}, {Subscript[n, 1], 0, 4}, 
            {Subscript[n, 2], 0, 4}, {Subscript[n, 3], 0, 4}, 
            {Subscript[n, 4], 0, 4}, {Subscript[n, 5], 0, 4}, 
            {Subscript[n, 6], 0, 4}]]]]

This Table goes through a lot of redundant calculations, blows up unnecessarily and then throws them away. Is there a more efficient way to just generate unique values of this kind?

All I'm trying to do here is to generate a list of complex points that can be expressed as arbitrary sums of, in this case, six fifth roots of unity.

That job still finished in a reasonable amount of time, but I'd like to do the same thing for a higher number of higher-order roots of unity.
Ideally, I'd like to be able to generate the generic limiting pattern, if it exists, for an infinite number of n-order roots. - for 2nd, 3rd, 4th and 6th order roots that generates, respectively, all integers, a triangular grid, a square grid and another triangular grid. I wonder how cases look like that can't have such regular grids - so any other Integer, essentially.

$\endgroup$
6
  • $\begingroup$ Please post working code - this entails getting rid of all the _ and ensuring correct syntax in general. $\endgroup$
    – Yves Klett
    Feb 21, 2013 at 14:09
  • $\begingroup$ @YvesKlett This now is straight from Mathematica. I just wanted to make it more readible. $\endgroup$
    – kram1032
    Feb 21, 2013 at 14:15
  • $\begingroup$ well, fancy syntax FullForm obfuscation is not optimal (you could format it for easy reading yet), but incorrect code is much worse still. BTW, your code is still not working. Copy and paste back into your session to make sure it works. $\endgroup$
    – Yves Klett
    Feb 21, 2013 at 14:21
  • $\begingroup$ @YvesKlett as said, it should work now. Unless I somehow can't directly copy Mathematica code from Mathematica 8 and post it as-is in a codeblock $\endgroup$
    – kram1032
    Feb 21, 2013 at 14:23
  • $\begingroup$ I just realized there might be a much simpler way to solve this particular kind of problem but even so, if there is a generic way to skip redundant steps in Tables like this, it should be a valuable question non-the-less. $\endgroup$
    – kram1032
    Feb 21, 2013 at 14:52

1 Answer 1

6
$\begingroup$

Much faster:

t = Table[Exp[2 I Pi n/5], {n, 0, 4}]
u = Union[Total /@ Tuples[t, 7]]

ListPlot[{Re@#, Im@#} & /@  u, AspectRatio -> 1]

Mathematica graphics

Edit

You may look at the points added each time you add a term to the sum:

ListPlot[Transpose /@ ({Re@#, Im@#} & /@ (Union[Total /@ Tuples[t, #]] & /@ 
          Reverse@Range@8)), AspectRatio -> 1, PlotStyle -> Table[Hue[1/x], {x, 8}]]

Mathematica graphics

$\endgroup$
3
  • $\begingroup$ perfect, thank you! $\endgroup$
    – kram1032
    Feb 21, 2013 at 15:43
  • $\begingroup$ For easier generalization, is it the same to do Tuples[t,7] compared to Tuples[{t,t,t,t,t,t,t}]? - at least the resulting image seems to be the same. That way you'd in general get: t = Table[Exp[2 I Pi i/k], {i, 0, k-1}]; u = Union[Total /@ Tuples[t,n]]; ListPlot[{Re@#, Im@#} & /@ u, AspectRatio -> 1, Axes->None] for sums over n order-k roots of unity. $\endgroup$
    – kram1032
    Feb 21, 2013 at 16:02
  • $\begingroup$ @kram1032 Yup, the same thing $\endgroup$ Feb 21, 2013 at 16:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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