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!

Improve this question
$\endgroup$
2
  • $\begingroup$ @MarcoB, you have edited my writing very well as though you own asked!!! $\endgroup$
    – Unbelievable
    Commented May 30, 2016 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
    Commented May 30, 2016 at 16:12

2 Answers 2

Reset to default
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}}

Improve this answer
$\endgroup$
3
  • $\begingroup$ so sorry in each coIumn every element can be repeated but a row can not! $\endgroup$
    – Unbelievable
    Commented May 30, 2016 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
    Commented May 30, 2016 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
    Commented May 30, 2016 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.

Improve this answer
$\endgroup$
2
  • $\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
    Commented May 30, 2016 at 16:11
  • $\begingroup$ Please wait I think something is not said $\endgroup$
    – Unbelievable
    Commented May 30, 2016 at 16:16

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.