f := proc (l, d) local x; if seq(l[i],i = nops(l)-nops(d)+2 .. nops(l)) = seq(d[k],k = 1 .. nops(d)-1) then x := [bar(d[nops(d)])] else x := [0, 1] end if; return x end proc;

F := proc (n, d) local s, ko, ki, T, i, l, x; s := [[0], [1]]; for ko to nops(d)-2 do s := [seq(seq([op(s[i]), k],k = 0 .. 1),i = 1 .. nops(s))] end do; for ki from nops(d) to n do T := []; for i to nops(s) do l := s[i]; x := f(l,d); T := [op(T), seq([op(l), x[k]],k = 1 .. nops(x))] end do; s := T end do; return s end proc;

bar := proc (x) options operator, arrow; if x = 0 then 1 else 0 end if end proc;

All sequence of 1 and 0 without [1,1]:

F(6,[1,1]);
[[0, 0, 0, 0, 0, 0], [0, 0, 0, 0, 0, 1], [0, 0, 0, 0, 1, 0],

[0, 0, 0, 1, 0, 0], [0, 0, 0, 1, 0, 1], [0, 0, 1, 0, 0, 0],

[0, 0, 1, 0, 0, 1], [0, 0, 1, 0, 1, 0], [0, 1, 0, 0, 0, 0],

[0, 1, 0, 0, 0, 1], [0, 1, 0, 0, 1, 0], [0, 1, 0, 1, 0, 0],

[0, 1, 0, 1, 0, 1], [1, 0, 0, 0, 0, 0], [1, 0, 0, 0, 0, 1],

[1, 0, 0, 0, 1, 0], [1, 0, 0, 1, 0, 0], [1, 0, 0, 1, 0, 1],

[1, 0, 1, 0, 0, 0], [1, 0, 1, 0, 0, 1], [1, 0, 1, 0, 1, 0]]
 

g := proc (l, n) local d, cd, i, a, k, c, t; d := []; cd := []; for i to nops(l) do if n+i-1 <= nops(l) then a := []; for k from i to n+i-1 do a := [op(a), l[k]] end do; c := []; for t to nops(l) do if n+i < t then c := [op(c), l[t]] end if end do; d := [op(d), c]; cd := [op(cd), a] end if end do; return [d, cd] end proc;

f := proc (l, nn, i) local cc, A, B, k, z, aa, bb; if i = nops(nn)+1 then cc := l[2] else A := []; B := []; for k to nops(l[1]) do z := g(l[1][k][nops(l[1][k])],nn[i]); aa := seq([op(l[2][k]), z[2][kt]],kt = 1 .. nops(z[2])); bb := seq([op(l[1][k]), z[1][kt]],kt = 1 .. nops(z[1])); A := [op(A), aa]; B := [op(B), bb] end do; cc := f([B, A],nn,i+1) end if; return cc end proc;

fa := proc (l) local a, k, e, n; a := []; k := 1; while k <= nops(l) do if l[k] = 1 then e := 0; n := 1; k := k+1; while e = 0 and k <= nops(l) do if l[k] = 1 then k := k+1; n := n+1 else e := 1; k := k+1 end if end do; a := [op(a), n] else k := k+1 end if end do; return a end proc;

init := proc (l0) options operator, arrow; [[[l0]], [[]]] end proc;

F := proc (l0, n) options operator, arrow; f(init(l0),n,1) end proc;

app := proc (l0, d) local AL, tu, s, ki, k, i; AL := []; for tu to nops(d) do s := [seq(0,i = 1 .. nops(l0))]; for ki to nops(d[tu]) do for k to nops(d[tu][ki]) do for i to nops(s) do if d[tu][ki][k] = i then s := [seq(s[m],m = 1 .. i-1), 1, seq(s[m],m = i+1 .. nops(s))] end if end do end do end do; AL := [op(AL), s] end do; return AL end proc;

FF := proc (l0, n) options operator, arrow; app(l0,F(l0,n)) end proc;

gene := proc (n) options operator, arrow; [[seq(0,i = 1 .. n)], seq(op(FF([seq(i,i = 1 .. n)],[seq(1,io = 1 .. k)])),k = 1 .. 1/2*n-1/2*`mod`(n,2)+1)] end proc;

ex: ALL the bitstrings of length 6 without 2 consecutive 1 are:

gene(6);
[[0, 0, 0, 0, 0, 0], [1, 0, 0, 0, 0, 0], [0, 1, 0, 0, 0, 0],

[0, 0, 1, 0, 0, 0], [0, 0, 0, 1, 0, 0], [0, 0, 0, 0, 1, 0],

[0, 0, 0, 0, 0, 1], [1, 0, 1, 0, 0, 0], [1, 0, 0, 1, 0, 0],

[1, 0, 0, 0, 1, 0], [1, 0, 0, 0, 0, 1], [0, 1, 0, 1, 0, 0],

[0, 1, 0, 0, 1, 0], [0, 1, 0, 0, 0, 1], [0, 0, 1, 0, 1, 0],

[0, 0, 1, 0, 0, 1], [0, 0, 0, 1, 0, 1], [1, 0, 1, 0, 1, 0],

[1, 0, 1, 0, 0, 1], [1, 0, 0, 1, 0, 1], [0, 1, 0, 1, 0, 1]]
 

here is a solution:

f := proc (n) local A, e, ki, x; A := []; e := 0; for ki to n do if e = 0 then x := `mod`(rand(),2); if x = 1 then e := 1 else e := 0 end if else x := 0; e := 0 end if; A := [op(A), x] end do; return A end proc;

f(13);
[1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0]
 

 

here is a solution with seq:

f1 := (i, l) -> if `mod`(i,2) = 1 then l[i] end if;

f2 := (i, l) -> if `mod`(i,2) = 0 then l[i] end if;

OddEven := L -> [seq(f1(i,L),i = 1 .. nops(L)), seq(f2(i,L),i = 1 .. nops(L))];

OddEven([1,3,5,7,9,11]);
[1, 5, 9, 3, 7, 11]
 

 

 

 

my procedure works on maple 7. it returns all the occurrent elements of the list.you can put A:=[NULL]; instead of A:=[];but not  A:=[l];

B can be deleted and remplaced by A:

repeatedEls := proc (l) local A, i, j; A := []; for i to nops(l) do if not member(l[i],A) then for j to nops(l) do if l[j] = l[i] and j <> i then A := [op(A), l[i]]; break end if end do end if end do; return A end proc;

 

 

here is a solution for repeatedEls:

repeatedEls := proc (l) local A, B, i, j; A := []; B := []; for i to nops(l) do if not member(l[i],B) then for j to nops(l) do if l[j] = l[i] and j <> i then A := [op(A), l[i]]; break end if end do; B := [op(B), l[i]] end if end do; return A end proc;

repeatedEls([a,b,c,d,c,d,e,f,a]);
[a, c, d]
 

 

here is a solution without member:

setDiff := proc (l1, d1) local A, l, d, i, r, k; A := []; l := convert(l1,list); d := convert(d1,list); for i to nops(l) do r := 0; for k to nops(d) do if l[i] = d[k] then r := 1 end if end do; if r = 0 then A := [op(A), l[i]] end if end do; return {op(A)} end proc;

here is a solution with member:

setDiff2 := proc (l1, d1) local A, l, d, i; A := []; l := convert(l1,list); d := convert(d1,list); for i to nops(l) do if not member(l[i],d) then A := [op(A), l[i]] end if end do; return {op(A)} end proc;

here is a solution with map and member:

setDiff3 := proc (l1, d1) local l, d, g, A; l := convert(l1,list); d := convert(d1,list); g := proc (a) options operator, arrow; if not member(a,d) then a end if end proc; A := map(g,l); return {op(A)} end proc;

 

 

 

the procedure works on maple 7. you can put b; instead of return(b);

here is a solution that seems working: test:=proc(a);perm := proc (l0) local A, m, L, i, l, ki, k; A := [seq([l0[u]],u = 1 .. nops(l0))]; for m to nops(l0)-1 do L := []; for i to nops(A) do l := l0; for ki to nops(A[i]) do for k to nops(l) do if l[k] = A[i][ki] then l := [seq(l[j],j = 1 .. k-1), seq(l[j],j = k+1 .. nops(l))]; break end if end do end do; L := [op(L), l] end do; A := [seq(seq([op(A[i]), L[i][kj]],kj = 1 .. nops(L[i])),i = 1 .. nops(A))] end do; return convert({op(A)},list) end proc;choix := proc (l, n) local A, di, k, m, j; if n = 0 or l = [] then A := [[]] else di := perm([seq(1,i = 1 .. n), seq(0,i = 1 .. nops(l)-n)]); A := []; for k to nops(di) do m := []; for j to nops(di[k]) do if di[k][j] = 1 then m := [op(m), l[j]] end if end do; A := [op(A), m] end do end if; return A end proc;occi := proc (l0) local l, d, B, ki, k; l := l0; d := convert({op(l)},list); if nops(d) = nops(l0) then B := d else for ki to nops(d) do for k to nops(l) do if l[k] = d[ki] then l := [seq(l[j],j = 1 .. k-1), seq(l[j],j = k+1 .. nops(l))]; break end if end do end do; B := [op(d), op(occi(l))] end if; return B end proc;a0:=[seq(i,i=1..nops(a))];c1:=choix(a0,2);c2:=[];for k from 1 to nops(c1) do c2:=[op(c2),[seq(a[c1[k][1]][ti]+a[c1[k][2]][ti],ti=1..nops(a[c1[k][1]]))]];od; d:=convert({seq(occi(c2[tt]),tt=1..nops(c2))},list);b:=[seq([],kk=1..nops(d))];for ki from 1 to nops(c2) do for kk from 1 to nops(d) do if occi(c2[ki])=d[kk] then b:=[seq(b[t],t=1..kk-1),[op(b[kk]),cat(convert(a[c1[ki][1]],string),`+`,convert(a[c1[ki][2]],string))],seq(b[t],t=kk+1..nops(b))];break;fi;od;od;return(b);end; test([[1,0,1,0],[1,1,0,0],[0,0,1,1]]); [["[1, 1, 0, 0]+[0, 0, 1, 1]"], ["[1, 0, 1, 0]+[1, 1, 0, 0]", "[1, 0, 1, 0]+[0, 0, 1, 1]"]]

foldl((d,l)->map((ll,d)->op(map((dd,a)->dd+a,d,ll)),l,d),[0],op(L));

here is a solution which doesn't use seq: g := proc (d, l) local A, i, B, k; A := []; for i to nops(d) do B := []; for k to nops(l) do B := [op(B), d[i]+l[k]] end do; A := [op(A), op(B)] end do; return A end proc; foldl(g, [0], op(L));

I have found an other solution: f := proc (L) local l, j; l := [seq(L[1][k],k = 1 .. nops(L[1]))]; for j from 2 to nops(L) do l := [seq(seq(l[i]+L[j][k],k = 1 .. nops(L[j])),i = 1 .. nops(l))] end do; return l end proc; f([[3,4,1],[2],[2],[6,7]]); [13, 14, 14, 15, 11, 12]

here is a way to do:(perm=permutation,choix=choice,arr=arrangements,prodcart=cartesian product) I use only perm and prodcart perm:=proc(l0);A:=[seq([l0[u]],u=1..nops(l0))];for m from 1 to nops(l0)-1 do L:=[];for i from 1 to nops(A) do l:=l0;for ki from 1 to nops(A[i]) do for k from 1 to nops(l) do if l[k]=A[i][ki] then l:=[seq(l[j],j=1..k-1),seq(l[j],j=k+1..nops(l))];break;fi;od;od;L:=[op(L),l];od;A:=[seq(seq([op(A[i]),L[i][kj]],kj=1..nops(L[i])),i=1..nops(A))];od;return(convert({op(A)},list));end; perm := proc(l0) local A, m, L, i, l, ki, k; A := [seq([l0[u]], u = 1 .. nops(l0))]; for m to nops(l0) - 1 do L := []; for i to nops(A) do l := l0; for ki to nops(A[i]) do for k to nops(l) do if l[k] = A[i][ki] then l := [seq(l[j], j = 1 .. k - 1), seq(l[j], j = k + 1 .. nops(l))]; break end if end do end do; L := [op(L), l] end do; A := [seq( seq([op(A[i]), L[i][kj]], kj = 1 .. nops(L[i])), i = 1 .. nops(A))] end do; return convert({op(A)}, list) end proc > choix:=proc(l,n);d:=perm([seq(1,i=1..n),seq(0,i=1..nops(l)-n)]);A:=[];for k from 1 to nops(d) do m:=[];for j from 1 to nops(d[k]) do if d[k][j]=1 then m:=[op(m),l[j]];fi;od;A:=[op(A),m];od;return(A);end; choix := proc(l, n) local d, A, k, m, j; d := perm( [seq(1, i = 1 .. n), seq(0, i = 1 .. nops(l) - n)]); A := []; for k to nops(d) do m := []; for j to nops(d[k]) do if d[k][j] = 1 then m := [op(m), l[j]] end if end do; A := [op(A), m] end do; return A end proc > > arr:=proc(l,n);d:=choix(l,n);a:=[seq(op(perm(d[i])),i=1..nops(d))];return(a);end; arr := proc(l, n) local d, a; d := choix(l, n); a := [seq(op(perm(d[i])), i = 1 .. nops(d))]; return a end proc > prodcart:=proc(l);A:=[seq([l[1][j]],j=1..nops(l[1]))];for t from 1 to nops(l)-1 do A:=[seq(seq([op(A[i]),l[t+1][k]],k=1..nops(l[t+1])),i=1..nops(A))];od;if l[1][1]::list then [seq(matrix(A[i]),i=1..nops(A))] else return(A);fi;end; prodcart := proc(l) local A, t; A := [seq([l[1][j]], j = 1 .. nops(l[1]))]; for t to nops(l) - 1 do A := [seq( seq([op(A[i]), l[t + 1][k]], k = 1 .. nops(l[t + 1])) , i = 1 .. nops(A))] end do; if l[1][1]::list then [seq(matrix(A[i]), i = 1 .. nops(A))] else return A end if end proc > prodcart([perm([1,1,0,0]),perm([1,1,0,0])]); [1 1 0 0] [1 1 0 0] [1 1 0 0] [[ ], [ ], [ ], [1 1 0 0] [1 0 1 0] [1 0 0 1] [1 1 0 0] [1 1 0 0] [1 1 0 0] [ ], [ ], [ ], [0 1 1 0] [0 1 0 1] [0 0 1 1] [1 0 1 0] [1 0 1 0] [1 0 1 0] [ ], [ ], [ ], [1 1 0 0] [1 0 1 0] [1 0 0 1] [1 0 1 0] [1 0 1 0] [1 0 1 0] [ ], [ ], [ ], [0 1 1 0] [0 1 0 1] [0 0 1 1] [1 0 0 1] [1 0 0 1] [1 0 0 1] [ ], [ ], [ ], [1 1 0 0] [1 0 1 0] [1 0 0 1] [1 0 0 1] [1 0 0 1] [1 0 0 1] [ ], [ ], [ ], [0 1 1 0] [0 1 0 1] [0 0 1 1] [0 1 1 0] [0 1 1 0] [0 1 1 0] [ ], [ ], [ ], [1 1 0 0] [1 0 1 0] [1 0 0 1] [0 1 1 0] [0 1 1 0] [0 1 1 0] [ ], [ ], [ ], [0 1 1 0] [0 1 0 1] [0 0 1 1] [0 1 0 1] [0 1 0 1] [0 1 0 1] [ ], [ ], [ ], [1 1 0 0] [1 0 1 0] [1 0 0 1] [0 1 0 1] [0 1 0 1] [0 1 0 1] [ ], [ ], [ ], [0 1 1 0] [0 1 0 1] [0 0 1 1] [0 0 1 1] [0 0 1 1] [0 0 1 1] [ ], [ ], [ ], [1 1 0 0] [1 0 1 0] [1 0 0 1] [0 0 1 1] [0 0 1 1] [0 0 1 1] [ ], [ ], [ ]] [0 1 1 0] [0 1 0 1] [0 0 1 1] > >

bonjour, j'ai crée la procédure frtot: frtot:=proc(s,n);l:=[seq([s[i]],i=1..nops(s))];for ki from 1 to n do l:=[seq(seq([op(l[i]),s[j]],j=1..nops(s)),i=1..nops(l))];if s[1]::list then [seq(matrix(l[k]),k=1..nops(l))] else l fi;od;end; n représente le nombre d'éléments k-1 par exemple on fait frtot([1,0],2); on obtient [[1, 1, 1], [1, 1, 0], [1, 0, 1], [1, 0, 0], [0, 1, 1], [0, 1, 0], [0, 0, 1], [0, 0, 0]]

bonjour, une maniere de faire est: frtotx:=proc(s);l:=[seq([s[1][i]],i=1..nops(s[1]))];for ki from 2 to nops(s) do l:=[seq(seq([op(l[i]),s[ki][j]],j=1..nops(s[ki])),i=1..nops(l))];od;return(l);end; on fait par exemple frtotx([[1,2,3],[1,2]]); [[1, 1], [1, 2], [2, 1], [2, 2], [3, 1], [3, 2]]