Use the ArrayFlatten command elegantly and efficiently

Questions
1

I noticed the following example given on the official website of the tool “Wyckoff position generator”:

Wyckoff position generator

Generates coordinates for all equivalent atoms from one specific atom,
given its Wyckoff position of the crystal space group.

Example: for I41/amd (No. 141) space group, an atom (0, 0, 0.0729) at
Wyckoff position 8e yields the following 8 atoms:

(0,0,0.0729), (0.5,0.5,0.5729), (0,0.5,0.3229), (0.5,0,0.8229),
(0.5,0,0.6771), (0,0.5,0.1771), (0.5,0.5,0.4271), (0,0,-0.0729)

I try to check/confirm the above example based on the data here, as represented below:

Selection_167.png
Selection_167.png1831×950 230 KB

For this purpose, I figured out the following code snippet:

In[7]:= Clear["Global`*"];
v1 = {1/2, 1/2, 1/2};
v2 = {{0, 0, z + 1/8}, {0, 1/2, z + 3/8}, {1/2, 0, -z + 5/8}, {1/2, 
    1/2, -z + 3/8}};
(*ArrayFlatten[{v2,(v1+#&)/@v2},1]/. Solve[z+1/8==0.0729,z];*)

Mod[#, 1] & /@ 
  ArrayFlatten[{v2, TranslationTransform[v1] /@ v2} /. 
    Solve[z + 1/8 == 0.0729, z], 1];
ArrayFlatten[%, 1]

Out[11]= {{0, 0, 0.0729}, {0, 1/2, 0.3229}, {1/2, 0, 0.6771}, {1/2, 1/
  2, 0.4271}, {1/2, 1/2, 0.5729}, {1/2, 0, 0.8229}, {0, 1/2, 
  0.1771}, {0, 0, 0.9271}}

The last two lines of the command seem a bit bloated and cumbersome. Is there any way to improve it in order to make it elegant and efficient?

Any hints/comments/suggestions will be appreciated.

Regards,
Zhao

2

Some of these functions are listable, or designed to work with a list as input. In addition to cleaning up the last step, I’d try to make it more readable with better variable names.

offset = {1/2, 1/2, 1/2};
locations = {{0, 0, z + 1/8}, {0, 1/2, z + 3/8}, {1/2, 0, -z + 5/8}, {1/2, 1/2, -z + 3/8}};
(* probably should be a better name, but I don't know your context *)

Your Solve is trivial, but I’m assuming that the real problem might have some complexity, or that you might want to solve with different equations. So, we might want to isolate that a bit rather than have it buried. Also, doing ReplaceAll with rules nested in lists produces a nested result, so you can simplify your flattening process if you don’t introduce nested lists in the first place.

With[
 {zOffsetRule = Flatten[Solve[z + 1/8 == 0.0729, z]]},
 Flatten[
   FractionalPart[{v2, TranslationTransform[offset][locations]} /. zOffsetRule], 
   1]]

Alternatively (use Catenate instead of Flatten):

With[
 {zOffsetRule = Flatten[Solve[z + 1/8 == 0.0729, z]]},
 Catenate[FractionalPart[{v2, TranslationTransform[offset][locations]} /. zOffsetRule]]]
3

Hi Eric Rimbey,

Thank you for your reply and comments.

Some of these functions are listable, or designed to work with a list
as input. In addition to cleaning up the last step, I’d try to make it
more readable with better variable names.

I made the following modifications and adjustments according to your suggestions:

In[17]:= Clear["Global`*"];
translation={1/2,1/2,1/2};
wyckoffposition={{0,0,z+1/8},{0,1/2,z+3/8},{1/2,0,-z+5/8},{1/2,1/2,-z+3/8}};

Your Solve is trivial, but I’m assuming that the real problem might
have some complexity, or that you might want to solve with different
equations.

What you said is absolutely right. In fact, here to deal with the general problem is as follows:

Give a point by its relative coordinates, in fractions, decimals, or variable parameters {a * x, b * y, c * z}, where the coefficients a, b, c are real numbers, then perform the following steps: First, take out the fractional part of the coordinate component, and then match the results to the corresponding coordinate representation in the following table:

Selection_169.png
Selection_169.png943×735 121 KB

In my example, the point, a.k.a., the atom position is (0, 0, 0.0729). In this simple case, we can see the matched pattern should be {0,0,z + 1/8} as shown in the above table, so the corresponding general solution should be something as follows:

In[62]:= OffsetRule = Flatten[Solve[{0,0,z + 1/8} == FractionalPart[{0,0,0.0729}], z]]

Out[62]= {z -> -0.0521}

However, I still haven’t figured out how to solve this problem about any general expression given in the form {a * x, b * y, c * z}, where the coefficients a, b, c are real numbers.

So, we might want to isolate that a bit rather than have it buried.
Also, doing ReplaceAll with rules nested in lists produces a nested
result, so you can simplify your flattening process if you don’t
introduce nested lists in the first place.

The corresponding code snippet using the new variable names:

With[
 {coordinateRule = Flatten[Solve[{0,0,z + 1/8} == FractionalPart[{0,0,0.0729}], z]]},
 Flatten[
   FractionalPart[{wyckoffposition, TranslationTransform[translation][wyckoffposition]} /. coordinateRule], 
   1]]

Alternatively (use Catenate instead of Flatten):

With[
 {coordinateRule = Flatten[Solve[{0,0,z + 1/8} == FractionalPart[{0,0,0.0729}], z]]},
 Catenate[FractionalPart[{wyckoffposition, TranslationTransform[translation][wyckoffposition]} /. coordinateRule]]]

Best,
Zhao