## 72 Reputation

15 years, 216 days

## find all permutations...

we can find all permutations :

findallperm4 := proc (l1, l2) local prodcartarr, d, zap, cnt, i, tx, R0, R; prodcartarr := proc (l) local A, t, B, i, k, m; A := [seq([l[1][j]],j = 1 .. nops(l[1]))]; for t to nops(l)-1 do B := []; for i to nops(A) do for k to nops(l[t+1]) do m := A[i]; if not member(l[t+1][k],A[i]) then m := [op(m), l[t+1][k]]; B := [op(B), m] end if end do end do; A := B end do; return A end proc; d := convert({op(l1)},list); zap := proc (x) procname(x) := 1; [] end proc; cnt := proc (i) zap(l1[i]) := [op(zap(l1[i])), i] end proc; for i to nops(l1) do cnt(i) end do; tx := table([seq(d[i] = zap(d[i]),i = 1 .. nops(d))]); R0 := [seq(tx[l2[k]],k = 1 .. nops(l2))]; zap := subsop(4 = NULL,eval(zap)); R := prodcartarr(R0); return R end proc;

findallperm4([b,b,c,a,a],[a,a,b,c,b]);
[[4, 5, 1, 3, 2], [4, 5, 2, 3, 1], [5, 4, 1, 3, 2], [5, 4, 2, 3, 1]]

we do the same thing with the initial problem:

trucall4 := proc (l0, l2) local prodcartarr, l1, d, zap, cnt, i, tx, s, R0, R, k; prodcartarr := proc (l) local A, t, B, i, k, m; A := [seq([l[1][j]],j = 1 .. nops(l[1]))]; for t to nops(l)-1 do B := []; for i to nops(A) do for k to nops(l[t+1]) do m := A[i]; if not member(l[t+1][k],A[i]) then m := [op(m), l[t+1][k]]; B := [op(B), m] end if end do end do; A := B end do; return A end proc; l1 := [seq(abs(evalf(l0[i])),i = 1 .. nops(l0))]; d := convert({op(l1)},list); zap := proc (x) procname(x) := 1; [] end proc; cnt := proc (i) zap(l1[i]) := [op(zap(l1[i])), i] end proc; for i to nops(l1) do cnt(i) end do; tx := table([seq(d[i] = zap(d[i]),i = 1 .. nops(d))]); s := sort(l1); R0 := [seq(tx[s[k]],k = 1 .. nops(s))]; zap := subsop(4 = NULL,eval(zap)); R := prodcartarr(R0); for k to nops(R) do print([seq(l0[R[k][i]],i = 1 .. nops(R[k]))]); print([seq(l2[R[k][i]],i = 1 .. nops(R[k]))]); print(`-----------`) end do end proc;

l1:=[3+I, I, 2, -1, 5, 4];l2:=[a, b, c, d, e, f];

trucall4(l1,l2);
[I, -1, 2, 3 + I, 4, 5]

[b, d, c, a, f, e]

-----------

[-1, I, 2, 3 + I, 4, 5]

[d, b, c, a, f, e]

-----------

## computing a permutation: use of table fo...

findperm := proc (l1, l2) local transfo, L1, L2, t, R; transfo := proc (l) local l0, tx, k, ht, L1; l0 := convert({op(l)},list); tx := table([seq(l0[j] = j,j = 1 .. nops(l0))]); k := [seq(0,j = 1 .. nops(l0))]; ht := proc (i) local u; u := tx[l[i]]; k := [seq(k[v],v = 1 .. u-1), k[u]+1, seq(k[v],v = u+1 .. nops(k))]; return [l[i], k[u]] end proc; L1 := [seq(ht(i),i = 1 .. nops(l))]; return L1 end proc; L1 := transfo(l1); L2 := transfo(l2); t := table([seq(L1[i] = i,i = 1 .. nops(L1))]); R := [seq(t[L2[ki]],ki = 1 .. nops(L2))]; return R end proc;

I transforme with procedure "transfo" the list with repeated elements in a list of elements distincts:

ex: [b,b,c,a,a];

transfo([b,b,c,a,a]);
[[b, 1], [b, 2], [c, 1], [a, 1], [a, 2]]

for b:each time we have b in the list ,I count the number of apparitions (n) of b before its position (its position include). and I put [b,n].

findperm([b,b,c,a,a],[a,a,b,c,b]);
[4, 5, 1, 3, 2]

we can do something strange with my procedure:

the second list l2 can contain strictly the first list l1

findperm([b,b,d,a,a,d],[a,a,b,d,b]);
[4, 5, 1, 3, 2]

we can use transfo for the initial problem:

truc := proc (l1, l2) local transfo, L2, L1, t, R, RE; transfo := proc (l) local l0, tx, k, ht, L1; l0 := convert({op(l)},list); tx := table([seq(l0[j] = j,j = 1 .. nops(l0))]); k := [seq(0,j = 1 .. nops(l0))]; ht := proc (i) local u; u := tx[l[i]]; k := [seq(k[v],v = 1 .. u-1), k[u]+1, seq(k[v],v = u+1 .. nops(k))]; return [l[i], k[u]] end proc; L1 := [seq(ht(i),i = 1 .. nops(l))]; return L1 end proc; L2 := transfo(sort([seq(evalf(abs(l1[io])),io = 1 .. nops(l1))])); L1 := transfo([seq(evalf(abs(l1[io])),io = 1 .. nops(l1))]); t := table([seq(L1[i] = i,i = 1 .. nops(L1))]); R := [seq(l1[t[L2[ki]]],ki = 1 .. nops(L2))]; RE := [seq(l2[t[L2[ki]]],ki = 1 .. nops(L2))]; print(R); print(RE) end proc;

with transfo we can use table.

l1:=[3+I, I, 2, -1, 5, 4];l2:=[a, b, c, d, e, f];

truc(l1,l2);
[I, -1, 2, 3 + I, 4, 5]

[b, d, c, a, f, e]

## an other method for sorting with a permu...

L1:=[3+I,I,2,-1,5,4];L2:=[a,b,c,d,e,f];

truc := proc (l0, bi) local pos, L, f, B; global A; A := []; pos := proc (a) local t; global ee; ee := 0; t := i -> if ee = 0 and l0[i] = a and not member(i,A) then A := [op(A), i]; ee := 1; return i end if; return op(map(t,[seq(io,io = 1 .. nops(l0))])) end proc; L := sort(l0); f := j -> if j <= nops(bi) then bi[j] end if; B := map(f,map(pos,L)); return B end proc;

truc([seq(evalf(abs(L1[i])),i=1..nops(L1))],L1);
[I, -1, 2, 3 + I, 4, 5]

truc([seq(evalf(abs(L1[i])),i=1..nops(L1))],L2);
[b, d, c, a, f, e]

## maplets on maple 7:response...

The initial problem is activing a third time Maple 12 on vista.I have already contacted customer support (B.Vidalie) which said to me that it is impossible to do it with the student version of maple 12.

So,I installed my old version of maple:Maple 7 (the interface can work on vista except saving and reading .mws files (with the mouse) .I wonder if I could read my maple 12-Maplets and create it again on Maple 7.I have seen that "Maplets 1.0" which is a package for Maple 7 exists on the old mapleprimes and I wish to know if it  still exists on the web and if it is the case what is its address.

## special arrangements of GELATINOUS...

first you choose 5 boxes parmi 10 boxes :you have C(10,5)=10!/((5!)*(10-5)!)  possibilities and then you place your vowels in alphabetical order in your 5 boxes:you have one possibility. So you have C(10,5)*1 possibilities.

After that,for one of your C(10,5) possibilities,you complete the other boxes with the 5 other letters in order without repetitions :you have 5! possibilities.

So,totaly,you have C(10,5)*5! special arrangements possible cad: 30240 special arrangements of GELATINOUS.

Thanks.

## ordering a list of lists (a mistake in f...

Sorry,I made a mistake in f :f doesn't work with a list of lists which have differents lengths. here is a new procedure f that seems working: f:=proc(l,k);if l=[] then l else if k=max(seq(nops(l[i]),i=1..nops(l)))+1 then l;else n:=min(seq(l[i][k],i=1..nops(l)));A:=[];B:=[];for ki from 1 to nops(l) do if l[ki][k]=n then A:=[op(A),l[ki]];else B:=[op(B),l[ki]];fi;od;AA:=[];AB:=[];for kk from 1 to nops(A) do if nops(A[kk])>=k+1 then AA:=[op(AA),A[kk]];else AB:=[op(AB),A[kk]];fi;od;return([op(AB),op(f(AA,k+1)),op(f(B,k))]);fi;fi;end; f([[2,1],[2,2],[2,1,3]],1); [[2, 1], [2, 1, 3], [2, 2]] f([[1,2,7,12],[3,4,5,6],[1,2,5,9]],1); [[1, 2, 5, 9], [1, 2, 7, 12], [3, 4, 5, 6]] (f is still a little complex but doesn't use 'sort')

## ordering a list of lists...

I am working on Maple 7. I think I found a way to do what you want. It is the procedure f:you must put 1 for the second argument. f := proc (l, k) local n, A, B, ki, AA, d, kk, r, kki, BB; if l = [] then l else if k = max(seq(nops(l[i]),i = 1 .. nops(l)))+1 then l else n := min(seq(l[i][k],i = 1 .. nops(l))); A := []; B := []; for ki to nops(l) do if l[ki][k] = n then A := [op(A), l[ki]] else B := [op(B), l[ki]] end if end do; AA := []; d := sort(convert({seq(nops(A[i]),i = 1 .. nops(A))},list)); for kk to nops(d) do r := []; for kki to nops(A) do if nops(A[kki]) = d[kk] then r := [op(r), A[kki]] end if end do; AA := [op(AA), r] end do; BB := []; d := sort(convert({seq(nops(A[i]),i = 1 .. nops(A))},list)); for kk to nops(d) do r := []; for kki to nops(B) do if nops(B[kki]) = d[kk] then r := [op(r), B[kki]] end if end do; BB := [op(BB), r] end do; return [seq(op(f(AA[ti],k+1)),ti = 1 .. nops(AA)), seq(op(f(BB[ti],k)),ti = 1 .. nops(BB))] end if end if end proc; f([[1,2,7,12],[3,4,5,6],[1,2,5,9]],1); [[1, 2, 5, 9], [1, 2, 7, 12], [3, 4, 5, 6]]

## sequence squares...

here are two procedures f and g which can do what you want: f := proc(n) local A, i; A := [1]; for i to n - 1 do A := [op(A), A[nops(A)] + 2] end do; return A end proc; > f(10); [1, 3, 5, 7, 9, 11, 13, 15, 17, 19] g := proc(m) local A, n, i; A := []; n := 0; i := 0; while i < m do if n^3 mod 2 = 1 then A := [op(A), n^3]; i := i + 1 end if; n := n + 1 end do; return A end proc; > g(10); [1, 27, 125, 343, 729, 1331, 2197, 3375, 4913, 6859] >

## combination...

if your result has this form: {{t1,t2},{t3,t4},....,} i think that you have: convert([seq((24-2*i)!/(2!*(24-2*i-2)!),i=0..11)],`*`)/(12!) =316234143225 possible results. you have (24!)/(2!*(24-2)!)=276 possible choices of 2 tables (parmi) the 24 tables.

## solutions de x+y+z=n...

bonjour thunwa, j'ai crée un worksheet nommé "chaussettes" sur maple 7 qui résoud un problème: déterminer le nombre minimum de chaussettes qu'il faut prendre pour etre certain d'avoir au moins k chaussettes identiques,sachant qu'il y a x couleurs différentes et x1 chaussettes de couleur 1,etc ....,xn chaussettes de couleurs n. la procédure est la suivante : chaussette(x,[x1, ,xn],k); cette procédure utilise une autre procédure CALCU qui résoud ton probleme: on fait CALCU(ki,n,[seq(i,i=0..n)]); avec ki le nombre de termes (ici "x,y,z" donc ki=3) et n (x+y+z=n) (pour déterminer les couples (x1, ,xki) avec xi appartenant à l tt i et x1+.. +xki=n on fait CALCU(ki,n,l);) tu peux uploader le worksheet sur "xavier".
 Page 1 of 1
﻿