xavier

72 Reputation

7 Badges

13 years, 195 days

MaplePrimes Activity


These are answers submitted by xavier

I found an other method with subs:

F4 := proc (opt, par) local a; a := seq(`if`(par[i] = -1,opt[i] = NULL,NULL),i = 1 .. nops(opt)); return map(l -> `if`(l::list,subs(a,l),l),opt) end proc;

F4([Joe, [Mike,Abraham, Leon,Joe], [Terresa, Cody,Joe],Cody,Mike], [-1,2,2,-1,-1]);
            [Joe, [Abraham, Leon], [Terresa], Cody, Mike]

I found this method with map and select. for each lists of the big list,I clean in one time all the elements opt[i] with par[i]=-1.

F2 := proc (opt, par) local a, R; a := map(i -> opt[i],select(i -> par[i] = -1,[seq(i,i = 1 .. nops(opt))])); R := map(l -> `if`(l::list,select(x -> not member(x,a),l),l),opt); return R end proc;

F2([Joe, [Mike,Abraham, Leon, Joe], [Terresa, Cody, Joe],Cody,Mike], [-1,2,2,-1,-1]);
            [Joe, [Abraham, Leon], [Terresa], Cody, Mike]

 

here is a method that I found:

sh := proc (l0) local l, A, x; l := l0; A := []; while l <> [] do x := rand(1 .. nops(l))(); A := [op(A), l[x]]; l := [seq(l[j],j = 1 .. x-1), seq(l[j],j = x+1 .. nops(l))] end do; return A end proc;

sh2 := proc (L) randomize(); return Array(ArrayDims(L),map(sh,convert(L,listlist))) end proc;

sh([1,5,4,3,2,4,2]);
[2, 5, 2, 4, 4, 3, 1]
 

sh shuffles a list.

A:=Array(1..3,1..5,[[11,12,13,14,15],[21,22,23,24,25],[31,32,33,34,35]]);
[11 12 13 14 15]
[ ]
A := [21 22 23 24 25]
[ ]
[31 32 33 34 35]
 

sh2(A);
[14 13 11 15 12]
[ ]
[25 21 24 23 22]
[ ]
[35 31 33 32 34]
 

sh2 creates a new array by shuffling the rows of A.

here is a solution for sorting a list of lists of numbers for Maple versions inferior to Maple 12.

I supposed that [1,2] is inferior to [1,2,1] or [1,2,3]. etc...

 plus := proc (l, d) local e, i; e := 0; for i to min(nops(l),nops(d)) do if l[i] < d[i] then e := l; break elif d[i] < l[i] then e := d; break end if end do; if e = 0 then if nops(d) <= nops(l) then e := d else e := l end if end if; return e end proc;

plus([1,3],[1,2,3]);
[1, 2, 3]
 

mini := proc (L) local x, i; x := L[1]; for i from 2 to nops(L) do x := plus(x,L[i]) end do; return x end proc;

soust := proc (l, d0) local A, d, i, e, D, j; A := []; d := d0; for i to nops(l) do e := 0; D := d; for j to nops(d) do if l[i] = d[j] then e := 1; D := [seq(D[k],k = 1 .. j-1), seq(D[k],k = j+1 .. nops(D))]; break end if end do; if e = 0 then A := [op(A), l[i]] end if; d := D end do; return A end proc;

ord := proc (L0) local L, A, i; L := L0; A := []; for i to nops(L) do A := [op(A), mini(L)]; L := soust(L,[A[nops(A)]]) end do; return A end proc;

ord([[1,3],[1,2],[1,2,3],[3,2],[3,1],[3,1,2]]);
[[1, 2], [1, 2, 3], [1, 3], [3, 1], [3, 1, 2], [3, 2]]
 

a := [[1, 7], [2, 3], [5, 4], [1, 2], [8, 9], [7, 9], [1, 6]]:ord(a);

[[1, 2], [1, 6], [1, 7], [2, 3], [5, 4], [7, 9], [8, 9]]
 

 

here is a solution:

a:=[ [ 6,3],[5,6],[6,6],[5,8],[4,7],[5.5,10],[6,12],[5,11],[5,13]];

L:=map(x->`if`(x[1]=6,x,NULL),a);
 

L is the result.

 

I have found a sudoku 6*6 with exactly 8 clues which has an unique solution.

here is the sudoku:

040 | 003

000 | 060

------------

000 | 004

006 | 002

------------

030 | 010

000 | 000

-------------

I wonder if an other person has found less clues than me for a 6*6 sudoku.

I can say that the minimum number of clues for a 6*6 sudoku is inferior or egal to 8.

 

 

 

 

select_sort := proc (l0) local minimum, l, A, ki, k, i; minimum := proc (l) local a, i; a := l[1]; for i from 2 to nops(l) do if l[i] < a then a := l[i] end if end do; return a end proc; l := l0; A := []; for ki to nops(l) do A := [op(A), minimum(l)]; for k to nops(l) do if l[k] = A[nops(A)] then i := k; break end if end do; l := [seq(l[j],j = 1 .. i-1), seq(l[j],j = i+1 .. nops(l))] end do; return A end proc; merge := proc (l0, d0) local l, d, A; l := l0; d := d0; A := []; while l <> [] and d <> [] do if l[1] < d[1] then A := [op(A), l[1]]; l := [seq(l[k],k = 2 .. nops(l))] else A := [op(A), d[1]]; d := [seq(d[k],k = 2 .. nops(d))] end if end do; if l = [] then A := [op(A), op(d)] else A := [op(A), op(l)] end if; return A end proc; split := proc (l) local l1, l2, li, di, l3; l1 := [seq(l[i],i = 1 .. 1/2*nops(l)-1/2*`mod`(nops(l),2))]; l2 := [seq(l[i],i = 1/2*nops(l)-1/2*`mod`(nops(l),2)+1 .. nops(l))]; li := select_sort(l1); di := select_sort(l2); l3 := merge(li,di); return l3 end proc; l:=[1,0.6,4,3,0.2,5,7]; split(l); [0.2, 0.6, 1, 3, 4, 5, 7]
there are two ways to do it: 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; st:=time(): z:=perm([seq(i,i=1..5)]); z := [[1, 2, 3, 4, 5], [4, 5, 2, 3, 1], [4, 5, 3, 1, 2], [4, 5, 3, 2, 1], [5, 1, 2, 3, 4], [5, 1, 2, 4, 3], [4, 5, 1, 2, 3], [4, 5, 1, 3, 2], [4, 5, 2, 1, 3], [4, 3, 1, 2, 5], [4, 3, 1, 5, 2], [4, 3, 2, 1, 5], [4, 3, 2, 5, 1], [4, 3, 5, 1, 2], [4, 3, 5, 2, 1], [4, 2, 3, 5, 1], [4, 2, 5, 1, 3], [4, 2, 5, 3, 1], [4, 1, 3, 5, 2], [4, 1, 5, 2, 3], [4, 1, 5, 3, 2], [4, 2, 1, 3, 5], [4, 2, 1, 5, 3], [4, 2, 3, 1, 5], [3, 5, 2, 4, 1], [3, 5, 4, 1, 2], [3, 5, 4, 2, 1], [4, 1, 2, 3, 5], [4, 1, 2, 5, 3], [4, 1, 3, 2, 5], [3, 5, 1, 4, 2], [3, 5, 2, 1, 4], [3, 5, 1, 2, 4], [3, 4, 2, 5, 1], [3, 4, 5, 1, 2], [3, 4, 5, 2, 1], [3, 2, 4, 5, 1], [3, 2, 5, 1, 4], [3, 2, 5, 4, 1], [3, 4, 1, 2, 5], [3, 4, 1, 5, 2], [3, 4, 2, 1, 5], [3, 1, 4, 5, 2], [3, 1, 2, 5, 4], [3, 1, 4, 2, 5], [3, 1, 5, 2, 4], [3, 1, 5, 4, 2], [3, 2, 1, 4, 5], [3, 2, 1, 5, 4], [3, 2, 4, 1, 5], [2, 5, 1, 3, 4], [2, 5, 1, 4, 3], [2, 5, 3, 1, 4], [2, 5, 3, 4, 1], [2, 5, 4, 1, 3], [2, 5, 4, 3, 1], [3, 1, 2, 4, 5], [2, 4, 5, 3, 1], [2, 4, 3, 1, 5], [2, 4, 3, 5, 1], [2, 4, 5, 1, 3], [2, 3, 5, 4, 1], [2, 4, 1, 3, 5], [2, 4, 1, 5, 3], [2, 3, 4, 1, 5], [2, 3, 4, 5, 1], [2, 3, 5, 1, 4], [2, 1, 5, 4, 3], [2, 3, 1, 4, 5], [2, 3, 1, 5, 4], [2, 1, 3, 5, 4], [2, 1, 4, 3, 5], [2, 1, 4, 5, 3], [2, 1, 5, 3, 4], [1, 5, 3, 2, 4], [1, 5, 3, 4, 2], [1, 5, 4, 2, 3], [1, 5, 4, 3, 2], [2, 1, 3, 4, 5], [1, 4, 5, 2, 3], [1, 4, 5, 3, 2], [1, 5, 2, 3, 4], [1, 5, 2, 4, 3], [1, 4, 2, 5, 3], [1, 4, 3, 2, 5], [1, 4, 3, 5, 2], [1, 3, 5, 4, 2], [1, 4, 2, 3, 5], [1, 3, 5, 2, 4], [1, 3, 2, 5, 4], [1, 3, 4, 2, 5], [1, 3, 4, 5, 2], [1, 2, 5, 3, 4], [1, 2, 5, 4, 3], [1, 3, 2, 4, 5], [1, 2, 3, 5, 4], [1, 2, 4, 3, 5], [1, 2, 4, 5, 3], [5, 4, 3, 2, 1], [5, 4, 1, 3, 2], [5, 4, 2, 1, 3], [5, 4, 2, 3, 1], [5, 4, 3, 1, 2], [5, 3, 4, 1, 2], [5, 3, 4, 2, 1], [5, 4, 1, 2, 3], [5, 3, 1, 4, 2], [5, 3, 2, 1, 4], [5, 3, 2, 4, 1], [5, 2, 4, 1, 3], [5, 2, 4, 3, 1], [5, 3, 1, 2, 4], [5, 2, 1, 4, 3], [5, 2, 3, 1, 4], [5, 2, 3, 4, 1], [5, 1, 3, 4, 2], [5, 1, 4, 2, 3], [5, 1, 4, 3, 2], [5, 2, 1, 3, 4], [5, 1, 3, 2, 4]] time()-st; 0. second method: with(combinat): st:=time(): z:=permute([1,2,3,4,5]): time()-st; 0. permute is faster then perm for numbers >5 if you want to get a permutation put: x:=z[i]; n:=z[i][j];for a number in this permutation (1<=i<=nops(z), 1<=j<=nops(z[i]) )
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; evalb(occi(map(op,convert(A,listlist)) = occi(map(op,convert(B,listlist))));
G:=l->({op(map(b->[b,convert(map(a->`if`(a=b,1,0),l),`+`)],convert({op(l)},list)))}); G can replaces sort.
2- M:=[];for i from 1 to 4 do l:=[i];for j from 1 to 3 do l:=[op(l),l[nops(l)]*3];od;M:=[op(M),l];od:M:=Array(M); 3- som := proc (l) local a, i; a := 0; for i to nops(l) do a := a+l[i] end do; return a end proc; or som := proc (l) options operator, arrow; convert(l,`+`) end proc; 4- f := proc (n) local a, i; a := 1; for i from 2 to n do a := a*i end do; return a end proc; or g := proc (n) options operator, arrow; if n = 1 then 1 else n*g(n-1) end if end proc;

you must use quotes ' '

sum('f(t)', t =-2 .. 2);

6
 

a method for sierpinski:

> t1:=(l,n)->[l[1]+3^n,l[2]];


t1 := (l, n) -> [l[1] + 3 , l[2]]

> t2:=(l,n)->[l[1]+2*3^n,l[2]];


t2 := (l, n) -> [l[1] + 2 3 , l[2]]

> t3:=(l,n)->[l[1],l[2]+3^n];


t3 := (l, n) -> [l[1], l[2] + 3 ]

> t4:=(l,n)->[l[1],l[2]+2*3^(n)];


t4 := (l, n) -> [l[1], l[2] + 2 3 ]

> t5:=(l,n)->[l[1]+3^n,l[2]+2*3^(n)];


t5 := (l, n) -> [l[1] + 3 , l[2] + 2 3 ]

> t6:=(l,n)->[l[1]+2*3^(n),l[2]+2*3^(n)];


t6 := (l, n) -> [l[1] + 2 3 , l[2] + 2 3 ]

> t7:=(l,n)->[l[1]+2*3^(n),l[2]+3^n];


t7 := (l, n) -> [l[1] + 2 3 , l[2] + 3 ]

> f:=proc(n,t);g:=(l,t,n)->seq([seq(t(l[k][io],n-2),io=1..nops(l[k]))],k=1..nops(l));if n=1 then [[[0,0],[1,0],[1,1],[0,1]]];else [op(f(n-1,t)),seq(g(f(n-1,t),t[i],n),i=1..nops(t))];fi;end;
Warning, `g` is implicitly declared local to procedure `f`


f := proc(n, t)
local g;
g := (l, t, n) -> seq(
[seq(t(l[k][io], n - 2), io = 1 .. nops(l[k]))],
k = 1 .. nops(l));
if n = 1 then [[[0, 0], [1, 0], [1, 1], [0, 1]]]
else [op(f(n - 1, t)),
seq(g(f(n - 1, t), t[i], n), i = 1 .. nops(t))]
end if
end proc

> g:=proc(n,t);l:=f(n,t);display({seq(polygonplot(l[k],color=black),k=1..nops(l))},scaling=constrained,axes=none);end;
Warning, `l` is implicitly declared local to procedure `g`


g := proc(n, t)
local l;
l := f(n, t);
display({seq(polygonplot(l[k], color = black),
k = 1 .. nops(l))}, scaling = constrained,
axes = none)
end proc

> with(plots):
Warning, the name changecoords has been redefined

> g(5,[t1,t2,t3,t4,t5,t6,t7]);

 


 

f := proc (p) local e, n; e := 0; if not isprime(p) then e := 1 else for n from 1 to p-2 do if not isprime(n^2+n+p) then e := 1; break end if end do end if; if e = 0 then p end if end proc;

g := proc (n) options operator, arrow; map(f,[seq(i,i = 1 .. n)]) end proc;

primes p,less than 50,that have the property n^2+n+p is prime for all n <= p-2 are:

g(50);
[2, 3, 5, 11, 17, 41]
 

 

 

 

I found a solution:

f := proc (n, a, b) local A, x; A := []; if n <= b-a+1 then A := [`mod`(rand(),b-a+1)+a]; while nops(A) < n do x := `mod`(rand(),b-a+1)+a; if not member(x,A) then A := [op(A), x] end if end do end if; return A end proc;

f(8,1,2^4);
[10, 7, 2, 12, 1, 11, 6, 9]
 

 

1 2 3 Page 1 of 3