2
$\begingroup$

I have a system which is composed of the following blocks

$$[-,+],[+,+],[+,-],[-,-]$$

I can compose a system of $n$ blocks with the only rule that the edges act as a dipole.

for example $$[-,+][-,+][-,-][+,-]$$

is a possible configuration of $n=4$.

Is it possible to create a code with mathematica that will produce all the possible configurations for any given $n$?

$\endgroup$
3
  • $\begingroup$ With[{n = 2}, Tuples[{-1, +1}, n]] ? $\endgroup$
    – cvgmt
    Jan 22, 2021 at 9:55
  • $\begingroup$ this gives all the possible elements, but how can I compose all the possible combinations for any given $n$, which will perserve a dipole between the elements? $\endgroup$
    – jarhead
    Jan 22, 2021 at 9:59
  • $\begingroup$ "the only rule that the edges act as a dipole." - to clarify, an admissible configuration is one with + or - on both ends, and +/- always being adjacent between the two poles? $\endgroup$ Jan 22, 2021 at 10:09

2 Answers 2

4
$\begingroup$
AttachDipole[x : {___, {_, "+"}}] := Append[x, #] & /@ {{"-", "-"}, {"-", "+"}};
AttachDipole[x : {___, {_, "-"}}] := Append[x, #] & /@ {{"+", "-"}, {"+", "+"}};


AttachDipoles[dipls_List] := Join @@ AttachDipole /@ dipls
AllDipoles[n_] := 
   Nest[AttachDipoles, {{{"-", "-"}}, {{"-", "+"}}, {{"+", "-"}}, {{"+", "+"}}}, n - 1]

AllDipoles[1]
{{{"-", "-"}}, {{"-", "+"}}, {{"+", "-"}}, {{"+", "+"}}}
AllDipoles[2]
{{{"-", "-"}, {"+", "-"}}, {{"-", "-"}, {"+", "+"}}, 
 {{"-", "+"}, {"-", "-"}}, {{"-", "+"}, {"-", "+"}}, 
 {{"+", "-"}, {"+", "-"}}, {{"+", "-"}, {"+", "+"}}, 
 {{"+", "+"}, {"-", "-"}}, {{"+", "+"}, {"-", "+"}}}
AllDipoles[3]
{{{"-", "-"}, {"+", "-"}, {"+", "-"}}, {{"-", "-"}, {"+", "-"}, {"+", "+"}}, 
 {{"-", "-"}, {"+", "+"}, {"-", "-"}}, {{"-", "-"}, {"+", "+"}, {"-", "+"}}, 
 {{"-", "+"}, {"-", "-"}, {"+", "-"}}, {{"-", "+"}, {"-", "-"}, {"+", "+"}}, 
 {{"-", "+"}, {"-", "+"}, {"-", "-"}}, {{"-", "+"}, {"-", "+"}, {"-", "+"}}, 
 {{"+", "-"}, {"+", "-"}, {"+", "-"}}, {{"+", "-"}, {"+", "-"}, {"+", "+"}}, 
 {{"+", "-"}, {"+", "+"}, {"-", "-"}}, {{"+", "-"}, {"+", "+"}, {"-", "+"}}, 
 {{"+", "+"}, {"-", "-"}, {"+", "-"}}, {{"+", "+"}, {"-", "-"}, {"+", "+"}}, 
 {{"+", "+"}, {"-", "+"}, {"-", "-"}}, {{"+", "+"}, {"-", "+"}, {"-", "+"}}}
$\endgroup$
2
$\begingroup$

Here is a one liner:

n = 3;
DeleteCases[Tuples[Tuples[{-1, 1}, 2],  n], {___, {_, x_}, {y_, _}, ___} /; ( x == y)]

{{{-1, -1}, {1, -1}, {1, -1}}, {{-1, -1}, {1, -1}, {1, 
   1}}, {{-1, -1}, {1, 1}, {-1, -1}}, {{-1, -1}, {1, 1}, {-1, 
   1}}, {{-1, 1}, {-1, -1}, {1, -1}}, {{-1, 1}, {-1, -1}, {1, 
   1}}, {{-1, 1}, {-1, 1}, {-1, -1}}, {{-1, 1}, {-1, 1}, {-1, 
   1}}, {{1, -1}, {1, -1}, {1, -1}}, {{1, -1}, {1, -1}, {1, 
   1}}, {{1, -1}, {1, 1}, {-1, -1}}, {{1, -1}, {1, 1}, {-1, 1}}, {{1, 
   1}, {-1, -1}, {1, -1}}, {{1, 1}, {-1, -1}, {1, 1}}, {{1, 1}, {-1, 
   1}, {-1, -1}}, {{1, 1}, {-1, 1}, {-1, 1}}}
$\endgroup$
1
  • 1
    $\begingroup$ You can make the pattern a bit more compact with {___, {_, x_}, {x_, _}, ___} $\endgroup$
    – Hausdorff
    Jan 22, 2021 at 15:19

Your Answer

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

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