1
$\begingroup$

I have 3 functions as below

N1 = 4; N2 = 5; N3 = 7;
g1[n1_] := (N1 - 3 n1 - 1)/N1; 
g2[n2_] := (N1 - 3 n2 - 1)/N1; 
g3[n3_] := (N1 - 3 n3 - 1)/N1; 

list1 = g1 /@ Range[1, N1]; 
list2 = g2 /@ Range[1, N2]; 
list3 = g3 /@ Range[1, N3];

I must create a matrix whose elements are randomly selected elements of these lists as exemplified by the sketch below:(each row is not repeated twice or more)

matrix1 = ConstantArray[0, {N1*N2*N3, 4}];

enter image description here

For example below sketch shows some verified permutations-

enter image description here

In particular, the fourth element in each row is the norm of the three preceding elements in the same row.

Without respect to the fourth elements in each row the below code which is not correct can partially satisfy the aim

 matrix1 = ConstantArray[0, {N1*N2*N3, 4}]; 
  Do[
  Do[
    Do[

    matrix1[[i, 1]] = list1[[If[Mod[i, 4] != 0, Mod[i, 4], 4]]];
    matrix1[[j, 2]] = list2[[If[Mod[j, 5] != 0, Mod[j, 5], 5]]];
    matrix1[[k, 3]] = list3[[If[Mod[k, 7] != 0, Mod[k, 7], 7]]];

   , {i, 1, 140}],
  {j, 1, 140}],
 {k, 1, 140}]

The speed of above code is very slow!

$\endgroup$
  • $\begingroup$ @MarcoB, you have edited my writing very well as though you own asked!!! $\endgroup$ – Unbelievable May 30 '16 at 15:47
  • $\begingroup$ You are welcome. Notice, however, that your lists have different lengths, respectively of 4, 5, and 7 elements. Your sketch seems to imply that the lists should have the same length. What do you want to do to fill the missing spots? $\endgroup$ – MarcoB May 30 '16 at 16:12
1
$\begingroup$

UPDATE:

You request no duplication in the rows, but duplication is possible in the columns. We can achieve that using RandomChoice instead of RandomSample to generate the permutations. After generation of a new list, we check that each row is free of duplicates; if not, we generate a new one until we get an appropriate new list. The following uses your definitions of the lists:

N1 = 4; N2 = 5; N3 = 7;

Do[
 newlist = RandomChoice[#, 7] & /@ {list1, list2, list3} // Transpose;
 If[And @@ (DuplicateFreeQ /@ newlist), Return[newlist]],
 200
]

If[
 And @@ (DuplicateFreeQ /@ newlist),
 {Sequence @@ #, Norm[#]} & /@ newlist,
 "no good list found"
]

The $200$ at the end of Do is there to avoid infinite loops; if no duplicate-free lists are generated, the process stops anyway after that number of attempts.


Old Answer:

If you lists had the same length, e.g. by setting:

N1 = 7; N2 = 7; N3 = 7;

Then a simple way of achieving what you want would be the following

RandomSample /@ {list1, list2, list3} // Transpose;
{Sequence @@ #, Norm[#]} & /@ %

{{-(15/7), -(15/7), 0}, {-(3/7), -(3/7), 3/7}, {-(6/7), 3/7, -(12/7)}, {3/7, -(6/7), -(15/7)}, {-(12/7), 0, -(3/7)}, {-(9/7), -(9/7), -(9/7)}, {0, -(12/7), -(6/7)}}

{{-(15/7), -(15/7), 0, (15 Sqrt[2])/7}, {-(3/7), -(3/7), 3/7, (3 Sqrt[3])/7}, {-(6/7), 3/7, -(12/7), 3 Sqrt[3/7]}, {3/7, -(6/7), -(15/7), (3 Sqrt[30])/7}, {-(12/7), 0, -(3/7), (3 Sqrt[17])/7}, {-(9/7), -(9/7), -(9/7), (9 Sqrt[3])/7}, {0, -(12/7), -(6/7), (6 Sqrt[5])/7}}

$\endgroup$
  • $\begingroup$ so sorry in each coIumn every element can be repeated but a row can not! $\endgroup$ – Unbelievable May 30 '16 at 16:39
  • $\begingroup$ @Irreversible OK thanks for the clarification; take a look at the new solution I proposed above, which takes that into consideration. $\endgroup$ – MarcoB May 30 '16 at 17:45
  • $\begingroup$ Unfortunately, there is a problem. I mean from not repeated that for example : two rows have to be not similar. Really I must have 4*5*7=140 rows.{ List1[[3]],List2[[5]],List3[[1]] } not be repeated. but for example if there is a result such as : {1/5,3/4,3/4} because it maybe is a result of two different permutations such as { List1[[3]],List2[[5]],List3[[1]] } and another permutation such as .{ List1[[2]],List2[[3]],List3[[1]] } it can be repeated. we can have again and again some{1/5,3/4,3/4}. (JUST FOR EXAMPLE) $\endgroup$ – Unbelievable May 30 '16 at 18:50
0
$\begingroup$
list1 = RandomReal[1, 10];
list2 = RandomReal[1, 10];
list3 = RandomReal[1, 10];
zz = Transpose[{Permute[list1, RandomPermutation[5]], 
   Permute[list2, RandomPermutation[6]], 
   Permute[list3, RandomPermutation[7]]}];
{#[[1]], #[[2]], #[[3]], Sqrt[#[[1]]^2 + #[[2]]^2 + #[[3]]^2]} & /@ zz

A stylistic request to the question poser: leave out any extraneous material from a question. The functional form of your lists (the g's) is irrelevant to your question, so pare your question to its essence. You'll get more help that way.

$\endgroup$
  • $\begingroup$ Well, there may be a problem though. The listX in the post will have different lengths, respectively of 4, 5, and 7 elements. I think the poster needs to clarify what to do with the "missing" spots . $\endgroup$ – MarcoB May 30 '16 at 16:11
  • $\begingroup$ Please wait I think something is not said $\endgroup$ – Unbelievable May 30 '16 at 16:16

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.