Kitonum

21440 Reputation

26 Badges

17 years, 40 days

MaplePrimes Activity


These are answers submitted by Kitonum

If  A  and  B  are 2 points then  t*A+(1-t)*B  ( 0<=t<=1 )  is the segment  AB .

Example:

A:=[1,1]:  B:=[3,2]:
plot([op(t*~A+(1-t)*~B), t=0..1], color=red, thickness=3, view=[0..4, 0..3], scaling=constrained);

                      

Addition.  You can also use  geometry:-segment  command or  plottools:-line  command.

seq(point(M||i, L[i]), i=1..nops(L));
seq(Equation(plane(Q||i, [M||i, n], [x,y,z])), i=1..nops(L));

1. Should be  coordinates  instead of   cordinates .

2. It will be easier to find the intersection of two curves by  solve  command:

solve([x^2+y^2-6600*x-4400*y+15730000=12100, x^2+y^2-6820*x-4840*y+17484500=6400], explicit);

We see that these circles do not intersect.

 

Visualization:

plots:-implicitplot([x^2+y^2-6600*x-4400*y+15730000=12100, x^2+y^2-6820*x-4840*y+17484500=6400], x=3100..3600,y=2000..2500, scaling=constrained, gridrefine=3);

                         

 

 

The procedure  FP  solves your problem for a plane  P . Using  map  command you can solve the problem for the list of several planes.

FP:=proc(P::`=`, var::list, A::list, B::list)
local n1, n2, n, k;
uses LinearAlgebra;
n1:=convert(map2(coeff, lhs(P), var), Vector);
n2:=convert(B-A, Vector);
n:=n1 &x n2;
k:=sort(primpart(n.convert(var-A, Vector)));
k*signum(lcoeff(k)) = 0;
end proc:

 

Examples of use ( L  is your list above):

FP(L[5], [x,y,z], [1,5,3], [-2,-4,3]);

map(FP, L, [x,y,z], [1,5,3], [-2,-4,3]);

 

Addition. The procedure  FP  will not give the correct answer if the plane  P is perpendicular to the vector AB, because in this case, there is no an unique solution. You are free to supplement the procedure for this case.


 

If we have  a*x^2+b*x+c=0 and  a>0 and  b>0 and  c>0  then if  d=b^2-4*a*c  there are 3 cases only:

1. If  d>0  then  both roots are different and negative.

1. If  d=0  then  both roots (actually 1 root)  are equal and negative.

1. If  d<0  then  there are no real roots.

All this is easy to prove, for example using the Vieta formula.

 

Visualization of all the cases:

A:=plot([2*x^2+4*x+1, x^2+4*x+4, x^2+3*x+6], x=-4..1, color=[red,blue,green, thickness=2]):
T:=plots:-textplot([[-4,4.5,"d = 0"],[-4,10.5,"d < 0"],[-3.5,16,"d > 0"]], font=[roman,bold,16]):
plots:-display(A,T);

                        


 

 

Here is a more efficient way:

restart;
GetParts:=proc(L::list)
local L1, n, a, S, L2, L3, L4;
 uses combinat, ListTools;
 L1:=sort(L); n:=nops(L); a:=`+`(L[])/2;
 S:={seq([i,L1[i]], i=1..n)};
 L2:=[seq(op(choose(S,j)), j=1..floor(n/2))];
 L3:=select(s->`+`(seq(s[i,2], i=1..nops(s)))=a, L2);
 L4:=map(s->[s,S minus s], L3);
 {map(t->[[seq(t[1,i,2], i=1..nops(t[1]))],[seq(t[2,i,2], i=1..nops(t[2]))]], L4)[]};
 map(t->t[1],[Categorize((x,y)->convert(x,set)=convert(y,set),convert(%, list))]);
 end proc:

Examples of use:

CodeTools:-Usage(GetParts([3,1,1,2,2,1]));
CodeTools:-Usage(GetParts([3,1,1,2,2,1,4,4,8,8]));
CodeTools:-Usage(GetParts([3,1,1,2,2,1,4,4,8,8,10,10,12,12,12]));

 

Edit.

The procedure getCoeff returnes the coefficient in front of the monomial  in the multivariate polynomial  :

getCoeff:=proc(P, T, t)
local L, H, i, k:
L:=[coeffs(P, T, 'h')]: H:=[h]: k:=0:
for i from 1 to nops(H) do
if H[i]=t then k:=L[i] fi:
od:
k;
end proc:

 

Examples of use:

f := a^2*b^2*c^2 + 2*a^2*b^2 + 2*a^2*c^2 + 2*b^2*c^2 + a^2 - 6*a*b - 6*a*c + b^2 - 6*b*c + c^2 + 8:
getCoeff(f, [a,b,c], a^2*b^2*c^2);
getCoeff(f, [a,b,c], a^2*b^2);
getCoeff(f, [a,b,c], a*b);
getCoeff(f, [a,b,c], a^2);
getCoeff(f, [a,b,c], 1);


                                               1

                                               2

                                              -6

                                               1

                                               8

Edit.

1. If a matrix has one column, then it is better to set it as a vector not as a matrix.

2. For use at different  n  it is more comfortable to define  b as a procedure:

b := n -> Vector(n,  i->add(1/(i+j-1), j=1..n)):
 

Example of use:

seq(b(n), n=1..7);

       

 

It is better to avoid the construction  L:=[op(L), ...] , because it is very inefficient. The next version is faster and works properly:

restart; 
n := 0:
for a from -10 to 10 do
for b from -10 to 10 do
for c from -10 to 10 do
if a*b*c <> 0 then n:=n+1; k := (-a*b*c+a*b*z+a*c*y+b*c*x)/igcd(a*b, b*c, c*a, a*b*c); L[n] := [[[a, 0, 0], [0, b, 0], [0, 0, c]], k*signum(lcoeff(k)) = 0] fi;
od: od: od: 
L:=convert(L, list);
nops(L);

 

Unfortunately Maple is weak in the transformations of trigonometric expressions. Only after several attempts I was able to prove that  a[2]=aa[2] 

Probably the easiest way to prove that two numerical trigonometric expressions are equal (not fully correct to the position of pure mathematics) is to calculate their approximate values with high accuracy and then apply the  is  command.


 

s:=exp(6*Pi*I/9):
t:=exp(2*Pi*I/9):
a[2]:=-s*t;
aa[2]:=-exp(8*Pi*I/9);
 

-(-1/2+((1/2)*I)*3^(1/2))*exp(((2/9)*I)*Pi)

 

-exp(((8/9)*I)*Pi)

(1)

polar(a[2]);
subs(Pi=x, %);
convert(%, phaseamp, x);
convert(eval(%, x=Pi),cot);
simplify(%);
is(%=polar(aa[2]));

polar(1, arctan((-(1/2)*3^(1/2)*cos((2/9)*Pi)+(1/2)*sin((2/9)*Pi))/((1/2)*cos((2/9)*Pi)+(1/2)*3^(1/2)*sin((2/9)*Pi))))

 

polar(1, arctan((-(1/2)*3^(1/2)*cos((2/9)*x)+(1/2)*sin((2/9)*x))/((1/2)*cos((2/9)*x)+(1/2)*3^(1/2)*sin((2/9)*x))))

 

polar(1, -arctan(cos((2/9)*x+(1/6)*Pi)/sin((2/9)*x+(1/6)*Pi)))

 

polar(1, -arctan(cot((7/18)*Pi)))

 

polar(1, -(1/9)*Pi)

 

true

(2)

# The proof by approximate  calculations

is(evalf[15](a[2])=evalf[15](aa[2]));

true

(3)

 


 

Download TT.mw

 

Check:=proc(A::Matrix)
local m, n;
m:=op([1,1],A); n:=op([1,2],A);
{seq(`+`(convert(A[i],list)[ ]), i=1..m), seq(`+`(convert(A[..,j],list)[ ]), j=1..n)};
if nops(%)=1 then true else false fi;
end proc:

 

Example of use:

A:=<2,7,6; 9,5,1; 4,3,8>;
Check(A);

                       

 

 

In fact, your functions   f1(t1,t2,t3),  f2(t1,t2,t3), f3(t1,t2,t3)  define a mapping  R^3  into  R^3. In the example  the cuboid and its image shown under the mapping  f  (a rotation and translation):

restart;
with(plottools): with(plots):
A:=<1/3,2/3,2/3; -2/3,-1/3,2/3; 2/3,-2/3,1/3>:
# Matrix of a rotation
f:=unapply(convert(A.<x,y,z>+<3,3,3>, list), (x,y,z)); # A rotation and translation mapping procedure
F:=transform(f):
p:=display(cuboid([0,0,0], [1,2,2.5], color=khaki)):
display(p, F(p), scaling=constrained, axes=normal, orientation=[-15,80]);

  f := (x, y, z) -> [(1/3)*x+(2/3)*y+(2/3)*z+3, -(2/3)*x-(1/3)*y+(2/3)*z+3, (2/3)*x-(2/3)*y+(1/3)*z+3] 

                      

 


 

a:=(-2*theta+1)*phi/(phi-1)+theta;
b:=(2*theta-1)*phi/(-phi+1)+theta;
c:=-numer(op(1,a))/``(-denom(op(1,a)))+theta;

                    

 

Edit.  If you need to remove the parentheses in the denominator, you can write additional   applyop(expand, [1,3], c);

Another one-line solution (the best variant of the solutions):

c:=applyop(t->-t, {[1,1], [1,3,1]}, a);

                       

 

restart;
Plane:=proc(L::listlist)
uses LinearAlgebra;
sort(Determinant(Matrix([[x,y,z]-~(L[1]),L[2]-L[1],L[3]-L[1]])));
(%=0)/igcd(coeffs(%));
end proc:

Examples of use:
Plane([[1,-1,3],[-15,-17,11],[2,1,0]]);
L := [[[-12, 2, -1], [-11, 1, -5], [-10, -2, 3]], [[-12, 2, -1], [-11, 1, -5], [-10, 6, 3]], [[-12, 2, -1], [-11, 1, -5], [-9, 5, -7]], [[-12, 2, -1], [-11, 1, -5], [-9, 8, -4]], [[-12, 2, -1], [-11, 1, -5], [-7, -6, -2]], [[-12, 2, -1], [-11, 1, -5], [-7, -2, -8]], [[-12, 2, -1], [-11, 1, -5], [-7, -2, 6]], [[-12, 2, -1], [-11, 1, -5], [-7, 3, -9]], [[-12, 2, -1], [-11, 1, -5], [-7, 3, 7]], [[-12, 2, -1], [-11, 1, -5], [-7, 6, -8]], [[-12, 2, -1], [-11, 1, -5], [-7, 9, 3]], [[-12, 2, -1], [-11, 1, -5], [-7, 10, -2]], [[-12, 2, -1], [-11, 1, -5], [-6, -4, -7]], [[-12, 2, -1], [-11, 1, -5], [-6, -4, 5]], [[-12, 2, -1], [-11, 1, -5], [-6, 8, -7]], [[-12, 2, -1], [-11, 1, -5], [-6, 8, 5]], [[-12, 2, -1], [-11, 1, -5], [-4, -6, 3]], [[-12, 2, -1], [-11, 1, -5], [-4, -2, -9]], [[-12, 2, -1], [-11, 1, -5], [-4, -2, 7]], [[-12, 2, -1], [-11, 1, -5], [-4, 6, -9]], [[-12, 2, -1], [-11, 1, -5], [-4, 6, 7]], [[-12, 2, -1], [-11, 1, -5], [-4, 10, 3]], [[-12, 2, -1], [-11, 1, -5], [-2, -6, 3]], [[-12, 2, -1], [-11, 1, -5], [-2, 6, -9]], [[-12, 2, -1], [-11, 1, -5], [-2, 6, 7]], [[-12, 2, -1], [-11, 1, -5], [-2, 10, 3]], [[-12, 2, -1], [-11, 1, -5], [3, 5, -7]], [[-12, 2, -1], [-11, 1, -5], [3, 8, -4]], [[-12, 2, -1], [-11, 1, -5], [4, -2, 3]], [[-12, 2, -1], [-11, 1, -5], [4, 6, 3]], [[-12, 2, -1], [-11, 1, -5], [5, 6, -2]], [[-12, 2, -1], [-11, 1, 3], [-10, -2, -5]], [[-12, 2, -1], [-11, 1, 3], [-10, 6, -5]], [[-12, 2, -1], [-11, 1, 3], [-9, 5, -7]], [[-12, 2, -1], [-11, 1, 3], [-9, 8, -4]], [[-12, 2, -1], [-11, 1, 3], [-7, -6, -2]], [[-12, 2, -1], [-11, 1, 3], [-7, -2, -8]], [[-12, 2, -1], [-11, 1, 3], [-7, -2, 6]], [[-12, 2, -1], [-11, 1, 3], [-7, 6, -8]], [[-12, 2, -1], [-11, 1, 3], [-7, 9, -5]]]:
Plane~(L);

 

I do not understand your code, and wrote a new recursive procedure that solves your problem:

bit:=proc(n::posint,k::nonnegint)
if k=0 then return [[0$n]] fi;
if k=n then return [[1$n]] fi;
if k>0 and k<n then {seq(seq(`if`(i[j]=0,subsop(j=1,i),NULL), j=1..n), i=bit(n,k-1))} fi;
[op(%)];
end proc:

 

Example of use: 

for k from 0 to 5 do
bit(5, k);
od;

 

Edit.  Of course, the easiest way to solve this problem, is the usage  combinat:-permute  command, for example:

combinat:-permute([1,1,0,0,0]);

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

 

Here is another version without recursion:

bit1:=proc(n::posint,k::nonnegint)
local NestedSeq, L;
uses ListTools;
if k=0 then return cat(0$n) fi;
NestedSeq:=proc(Expr::uneval, L::list)
local S;
eval(subs(S=seq, foldl(S, Expr, op(L))));
end proc:
[NestedSeq(cat(seq(`if`(`or`(seq(s=i||m,m=1..k)),1,0), s=1..n)),[Reverse([seq(i||p=i||(p-1)+1..n-k+p,p=2..k)])[],i1=1..n-k+1])];
end proc:

Example of use:

bit1(5,2);

First 168 169 170 171 172 173 174 Last Page 170 of 289