Kitonum

21440 Reputation

26 Badges

17 years, 40 days

MaplePrimes Activity


These are answers submitted by Kitonum

Zeineb, in your example, you missed the square  [22, 33,  42, 31] .

The procedure  Anew  solves the problem for any matrix, in which both the dimensions of at least 3.

Anew:=proc(A::Matrix)
local m, n;
m:=op([1,1],A);  n:=op([1,2],A);
if m<3 or n<3 then return NULL fi;
if n::even then if m::even then
return Matrix([seq(op([seq([A[i,j],A[i+1,j+1],A[i+2,j],A[i+1,j-1]], j=2..n-2,2), seq([A[i+1,j],A[i+2,j+1],A[i+3,j],A[i+2,j-1]], j=3..n-1,2)]), i=1..m-2,2)]) else
return Matrix([seq(op([seq([A[i,j],A[i+1,j+1],A[i+2,j],A[i+1,j-1]], j=2..n-2,2), seq([A[i+1,j],A[i+2,j+1],A[i+3,j],A[i+2,j-1]], j=3..n-1,2)]), i=1..m-4,2), seq([A[m-2,j],A[m-2+1,j+1],A[m-2+2,j],A[m-2+1,j-1]], j=2..n-2,2)]) fi; fi;
if n::odd then if m::even then
return Matrix([seq(op([seq([A[i,j],A[i+1,j+1],A[i+2,j],A[i+1,j-1]], j=2..n-1,2), seq([A[i+1,j],A[i+2,j+1],A[i+3,j],A[i+2,j-1]], j=3..n-2,2)]), i=1..m-2,2)]) else
Matrix([seq(op([seq([A[i,j],A[i+1,j+1],A[i+2,j],A[i+1,j-1]], j=2..n-1,2), seq([A[i+1,j],A[i+2,j+1],A[i+3,j],A[i+2,j-1]], j=3..n-2,2)]), i=1..m-4,2), seq([A[m-2,j],A[m-2+1,j+1],A[m-2+2,j],A[m-2+1,j-1]], j=2..n-1,2)]) fi; fi;
end proc:

 

Example of use:

interface(rtablesize=infinity):
A := Matrix(5,10, [$ 1..50]); 
Anew(A);

              

 


 

For a given triangle it is not a very difficult task. We only need to set the ranges for parameterization:

restart;
with(geom3d):
point(A,1,0,0), point(B,1/2,0,sqrt(3)/2),point(C,0,sqrt(3)/2,1/2), point(OO,0,0,0):
plane(P1,[A,C,OO]), plane(P2,[B,C,OO]), plane(P3,y=tan(phi)*x, [x,y,z]):
Plane1:=Equation(P1,[x,y,z]):
Plane2:=Equation(P2,[x,y,z]):
Tr:={x=cos(phi)*sin(theta),y=sin(phi)*sin(theta),z=cos(theta)}:
eval({Plane1,y=tan(phi)*x}, Tr):
theta1:=solve(eval({Plane1,y=tan(phi)*x}, Tr), theta,explicit):
eval({Plane2,y=tan(phi)*x}, Tr):
theta2:=solve(eval({Plane2,y=tan(phi)*x}, Tr), theta,explicit):
plots:-display(plottools:-sphere(color="LightBlue", style=patch),plot3d([1.01*cos(phi)*sin(theta),1.01*sin(phi)*sin(theta),1.01*cos(theta)], phi=0..Pi/2, theta=eval(theta,theta2)..eval(theta,theta1),color="Green", style=surface), axes=none);

                     

plots:-display(plottools:-circle(), plots:-textplot([0, 0.9, infinity], font=[times, bold, 22]), axes=none);

I do not quite understand your problem. If you want to avoid premature calculation, you can write down all the constants as symbols.
 

Example:

`12`*x^`-4`*y^`2`/`3`/x^`6`/y^`-5`;
evalindets(%, 'symbol', parse);

                                                

 


 

phephoi := proc (A, B)
local check, i, j, C, E;
uses ListTools;
C := A;
for i from 1 to nops(A) do
   check := 0; 
   for j from 1 to nops(B) do
      if B[j] = A[i] then check := 1; break; end if;
   end do; 
   if check = 0 then C := subsop(Search(A[i],C) = NULL, C); end if;
end do;
C;
end proc:

 

Example of use:

A := [1, 2, 3, 5, 6, 7];
B := [2, 4, 7, 11, 8];
phephoi(A, B);

                           

 


 

If you are interested in the image of a clock face with Maple, look at this post

http://www.mapleprimes.com/posts/143906-Visualization-Of-Clock-And-Degrees-Problem

 

vv, this is a very elegant solution, vote up!

Here is another solution, based on the procedure named  ArcOnSphere . The procedure draws the shortest arc on a sphere, connecting the specified points (the points do not have to be opposites). Required parameters:  A  and  B  are two points on the sphere, C is the center of the sphere (by default  C = [0, 0, 0] ), G are the graphics options for the space curve  (by default  G=[color=red, thickness=3, scaling=constrained] ).

restart;
ArcOnSphere:=proc(A::list, B::list, C::list:=[0,0,0], G::list(equation):=[color=red, thickness=3, scaling=constrained])
local Av, Bv, Cv, CA, CB, V, M, Phi;
uses Student[LinearAlgebra], plots;
Av, Bv, Cv:= op(convert~([A, B, C], Vector));
CA:=Av-Cv; CB:=Bv-Cv;
V:=CA &x CB;
M:=RotationMatrix(alpha, V);
Phi:=arccos(CA.CB/Norm(CA)/Norm(CB));
spacecurve(M.CA+Cv, alpha=0..Phi, op(G));
end proc:

 

Example of use:

L:=[[sqrt(3)/2,0,1/2], [0,1/2,sqrt(3)/2], [0,1,0], [1/sqrt(2),1/sqrt(2),0]]:  # 4 points on the unit sphere
L1, L2, L3, L4:=seq(ArcOnSphere(op(L[i..i+1])), i=1..nops(L)-1), ArcOnSphere(L[nops(L)], L[1]):  # The arcs connecting these points
Labels:=["A", "B", "C", "D"]:
T:=plots[textplot3d]([seq([op(L[i]+0.05*L[i]), Labels[i]], i=1..nops(L))], font=[times,bold,16]):
plots[display](L1, L2, L3, L4, T, plottools[sphere](style=surface));

                

 

 

interface(rtablesize=infinity):  # It is necessary that the matrices be displayed explicitly
A, B := LinearAlgebra:-RandomMatrix(15),  LinearAlgebra:-RandomMatrix(15);  # Specifying of two matrices
A+B,  3*A,  A^2,  A.B,  A^(-1);

 

Please note that for multiplying matrices, we use a dot rather than a sign  "*" 

DuplicationMatrix:=proc(n)
local A, a, L1, L2;
uses ListTools;
A:=Matrix(n, symbol=a, shape=symmetric);
L1:=[seq(seq(A[i,j], j=1..n), i=1..n)];
L2:=convert(L1, set);
Matrix(n^2,n*(n+1)/2, {seq(seq((i,j)=`if`(j=Search(L1[i], L2),1, 0), j=1..n*(n+1)/2), i=1..n^2)});
end proc:

 

Example of use:
C:=DuplicationMatrix(3);

                                      

 

Check.

A, V1, V2:=<a,b,c; b,d,e; c,e,f>, <a,b,c,d,e,f>, <seq(seq(A[i,j], j=1..3), i=1..3)>;
C.V1=V2;

 


 


 


 

Under the condition that  u, v, delta, lambda, phi, beta, alpha  are in the interval  ]0,1]  there are no solutions.

The proof.

Let   A=(alpha+lambda+u+delta)/(u+v+alpha) ,  B=(alpha+lambda+u+delta)/(u+v)

From the first inequality we have  beta/phi>B  and from the fourth inequality we have  beta/phi<A .  We have a contradiction because  A<B .

Theta:=[ 0, Pi/3, 2*Pi/3, Pi]:
Phi:=[ 0, Pi/3, 2*Pi/3, Pi, 4*Pi/3, 5*Pi/3, 2*Pi, 7*Pi/3]:
F:=(theta,phi)->[cos(phi)*sin(theta), sin(phi)*sin(theta), cos(theta)]:
{seq(seq(F(theta,phi), phi=Phi), theta=Theta)};
A:=plots[pointplot3d](%, color=red, symbol=solidcircle, symbolsize=20):
B:=plottools[sphere]([0,0,0], 1):
plots[display](A, B);

 

 


 

a := [1, 4, 2, 6, 8]:  b:={a[ ]};
{seq(seq(parse(cat(i,j)), j=b minus {i}), i=b)};
select(`<`, b union %, 50);

                 {1, 2, 4, 6, 8, 12, 14, 16, 18, 21, 24, 26, 28, 41, 42, 46, 48}

 

or using  combinat:-permute  instead of nested  seq  :

a := [1, 4, 2, 6, 8]:  b:={a[ ]};
map(parse@cat@op, combinat:-permute(b,2));
select(`<`, b union {%[ ]}, 50);

 

Edit.
                     

Apply  evalf  command to your answer.

restart;
with(Student[NumericalAnalysis]):
f:=x->abs(x):
a, b:=-1., 1.:
h:=(b-a)/4:
xx:=[a,a+h,a+2*h,a+3*h,b]:
yy:=map(f, xx):
xy:=zip((u,v)->[u,v], xx, yy);
s2:=CubicSpline(xy, independentvar=x);
P:=expand(Interpolant(s2));
plot([f(x), P], x=-1..1);
Draw(s2);
M:=maximize(abs(abs(x) - P), x=-1..1);

 

Edit.

 

restart; 
1 = int(abs(A*exp(-(1/3)*x^2))^2, x = -infinity .. infinity); 
solve({%, A > 0}); 
A := eval(``(A^4)^(1/4), %);  
# The final result

                        

 

Addition. If in the future you are going to do any numerical manipulations with  A , you must first use  expand  command, for example:

evalf(expand(A));

                                  0.6787185469

 

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