Kitonum

21445 Reputation

26 Badges

17 years, 40 days

MaplePrimes Activity


These are answers submitted by Kitonum

A := plot(x^2, x = -2 .. 2, color = red, thickness = 2, axis[2] = [color = white], labels=[" "," "]):

B := plots[textplot]([[1.9, -0.1, "x values"], [0, 4, "y values"]], align = [below, left], font = [TIMES, ROMAN, 14]):

plots[display](A, B);

                          

 

Edited.

 

 

The procedure  IntersectionOfSegments  solves the problem for any segments on the plane. If the segments do not intersect, then the procedure returns NULL. If segments intersect at the single point, the procedure returns this point (as a list). If the intersection of segments is a segment, then the procedure returns this segment (as a listlist).

IntersectionOfSegments:=proc(S1::listlist,S2::listlist)

local A, B, C, D, f, g, T1, T2, S11, S21, T;

uses geometry;

point(A, S1[1]); point(B, S1[2]); point(C, S2[1]); point(D, S2[2]);

f:=unapply(lhs(Equation(line(AB, [A,B]),[x,y])),x,y);

g:=unapply(lhs(Equation(line(CD, [C,D]),[x,y])),x,y);

if is(f(S2[1][])*f(S2[2][])<=0) and is(g(S1[1][])*g(S1[2][])<=0) then  if is(f(S2[1][])<>0) or is(f(S2[2][])<>0)  then return rhs~(convert(solve({f(x,y), g(x,y)}),list))  elif

is(S1[1,1]<>S1[2,1]) then S11:=sort(S1,(a,b)->is(a[1]<=b[1])); S21:=sort(S2,(a,b)->is(a[1]<=b[1])); if is(S11[2,1]>=S21[1,1]) and is(S11[1,1]<=S21[2,1]) then T1:=sort([S11[1],S21[1]],(a,b)->is(a[1]<=b[1])); T2:=sort([S11[2],S21[2]],(a,b)->is(a[1]<=b[1]));

T:=[T1[2],T2[1]];

return `if`(T1[2]<>T2[1],sort([T1[2],T2[1]],(a,b)->is(a[1]<=b[1])), T1[2]) fi else

S11:=sort(S1,(a,b)->is(a[2]<=b[2])); S21:=sort(S2,(a,b)->is(a[2]<=b[2]));

if is(S11[2,2]>=S21[1,2]) and is(S11[1,2]<=S21[2,2]) then T1:=sort([S11[1],S21[1]],(a,b)->is(a[2]<=b[2])); T2:=sort([S11[2],S21[2]],(a,b)->is(a[2]<=b[2]));

T:=[T1[2],T2[1]];

`if`(is(T1[2]<>T2[1]),sort([T1[2],T2[1]],(a,b)->is(a[2]<=b[2])), T1[2])

fi;  fi; fi; 

end proc:

 

Examples of use:

IntersectionOfSegments([[0,1],[1,0]], [[0,-1],[1,2]]);

IntersectionOfSegments([[0,1],[1,0]], [[1/2,1/2],[2,-1]]);

IntersectionOfSegments([[0,1],[1,0]], [[-2,3],[-1,2]]);

IntersectionOfSegments([[0,0],[0,2]], [[0,1],[0,3]]);

IntersectionOfSegments([[0,0],[0,2]], [[0,5/2],[0,3]]);

IntersectionOfSegments([[0,0],[0,2]], [[0,2],[0,3]]);

                                                

 

 Segments.mws

 

 

 

I have plotted your system  for several values of  r, from which we can see:
1) There are always 2 positive solutions (2 points in the ranges omega=0..1, a=0..1).
2) These two points are located far enough from one another.

Further, using  fsolve  command, we find all the solutions for  20 values  r=0.1 .. 2



restart; A := sqrt(a^2+r^2/(1+r)^2); B := sqrt(a^2/(a^2+r^2/(1+r)^2)); C := A*EllipticE(B)-r^2*EllipticK(B)/((1+r)^2*A); Sys := [0.4e-3*a^2*omega^2+(-a*(1+r)+a*omega^2+4*r*C/(a*Pi))^2-0.1e-3 = 0, 0.1e-1^2+(1/4)*(-a*(1+r)+a*omega^2+4*r*C/(a*Pi))*(omega^2-r-1-4*r*C/(a^2*Pi)+4*r*(EllipticE(B)*a/A+(1/2)*A*(2*a/A^2-2*a^3/A^4)*(EllipticE(B)/B-EllipticK(B)/B)/B-(1/2)*r^2*(2*a/A^2-2*a^3/A^4)*(EllipticE(B)/((-B^2+1)*B)-EllipticK(B)/B)/((1+r)^2*B*A)+r^2*EllipticK(B)*a/((1+r)^2*A^3))/(a*Pi))/(a*omega^2) = 0]
``

for r from .1 by .4 to 3 do plots[implicitplot](Sys, omega = 0 .. 1, a = 0 .. 1, color = [red, blue], gridrefine = 3) end do;

 

  ``
 
k := 0; for r from .1 by .1 to 2 do k := k+1; R[k] := select(proc (t) options operator, arrow; type(t, list) end proc, [fsolve([unapply(lhs(Sys[1]), omega, a), unapply(lhs(Sys[2]), omega, a)], [0 .. .5, 0 .. .5]), fsolve([unapply(lhs(Sys[1]), omega, a), unapply(lhs(Sys[2]), omega, a)], [.5 .. 1, 0 .. .5]), fsolve([unapply(lhs(Sys[1]), omega, a), unapply(lhs(Sys[2]), omega, a)], [.5 .. 1, .5 .. 1])]) end do; R := convert(R, list)

[[[.55189342177016799, 0.52431461641003288e-1], [.93383938926180514, .53338248276142544]], [[.46250332378929390, 0.72758651318677351e-1], [.88817852842152373, .56222809614503744]], [[.42229390627299519, 0.86435264660787292e-1], [.85730294549654143, .58278309248713640]], [[.39907870108135558, 0.96275026018332394e-1], [.83601062548785647, .59774986188025252]], [[.38404296323155524, .10360928671805222], [.82110760120672703, .60866463461621511]], [[.37364151962067857, .10919662048170491], [.81061459410152591, .61658402650931882]], [[.36613882671326664, .11351405352637163], [.80326294335716726, .62225471487074130]], [[.36057464448168222, .11688069125666914], [.79820979149940114, .62621402063324668]], [[.35637098643751855, .11951938513944992], [.79487660177182277, .62885527577329777]], [[.35315776023335510, .12159084485844696], [.79285478475201123, .63047103935557873]], [[.35068648980084291, .12321392389437709], [.79184857795078184, .63128210232676287]], [[.34878397380331478, .12447833231432544], [.79163928279779795, .63145728658857211]], [[.34732573768927623, .12545294618314468], [.79206216848842827, .63112719769611616]], [[.34622003518224042, .12619141606556106], [.79299113903073674, .63039393728282592]], [[.34539778583632549, .12673605725106553], [.79432829947728390, .62933807101854191]], [[.34480602927520432, .12712061087985253], [.79599669887633709, .62802370031524453]], [[.34440350743272119, .12737223950383192], [.79793517724653231, .62650220794269245]], [[.34415764945020853, .12751299931122388], [.80009464992632358, .62481505173854120]], [[.34404241754955591, .12756093579153637], [.80243537571112963, .62299588000446253]], [[.34403678456682168, .12753091650021651], [.80492492869812401, .62107214245582377]]]

(1)

``

plot([R[1], R[4], R[7], R[10]], style = point, color = [red, blue, green, yellow], symbol = solidcircle, symbolsize = 8, view = [0 .. 1, 0 .. 1], legend = ['r' = .1, 'r' = .4, 'r' = .7, 'r' = 1]);

 

``


We have plotted only 4 pairs of points as for  r>=1 the points practically merge.

Download Syst1.mw

Your integrand is only defined on a finite set of points. To integrate, it is necessary  to continue on a certain range. For example on the range t=1..10  you can use splines:

x:=[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]:

rho:= [0.045, 0.0459, 0.0564, 0.05689, 0.06015, 0.06235, 0.0654, 0.0687, 0.07012, 0.07251]:

eta:= [1.15, 1.256, 1.56, 1.85, 1.86, 2.01, 2.35, 2.56, 2.86, 2.901]:

f:=[seq(rho[i]*x[i]^4*eta[i]^2, i=1..10)]:

F:=unapply(CurveFitting[Spline](x,f,t), t);

plot(F,1..10, color=red, thickness=2);

int(F(t), t=1..10);

          

 

                 

 

 Addition. For some reason, Maple does not plot for t>8, although at certain points value of the function is calculated correctly:

F(9), F(10);

f[9], f[10];

                               3763.08485500000, 6102.29730500000

                                        3763.084855, 6102.297305

 

A bug?

 

 

p  is a polynomial not necessarily a cubic polynomial.

CriticalPoints:=p->solve(diff(p, x), x):

 

Example of use:

CriticalPoints(x^2*(x-1));

                                                     0, 2/3

Do

f:=x->x^2+6*x+12:

g:=x-> f(x)*exp(x):

f(2);

g(2);


                                          28

                                   28 exp(2)

 

or more automatically

restart;

sol:=dsolve({diff(f(x), x) = 2*x+6, f(0) = 12});

f:=unapply(eval(f(x), sol), x);

g:=x-> f(x)*exp(x):

f(2);

g(2);

 

Edited.

MUKUNDS 

1) Many sub-expressions in your system are repeated. For a more compact notation, I gave them the names A, B, C

2) Variables  omega  and  a are squared, so it is enough to solve the system only for  omega>=0  and  a>=0 .

3) First, we plot both equations, from which find the ranges for each root.

4) Using  fsolve  command we find these roots.

 

restart; r := 0.5e-1; A := sqrt(a^2+r^2/(1+r)^2); B := sqrt(a^2/(a^2+r^2/(1+r)^2)); C := A*EllipticE(B)-r^2*EllipticK(B)/((1+r)^2*A); Sys := [0.4e-3*a^2*omega^2+(-a*(1+r)+a*omega^2+4*r*C/(a*Pi))^2-0.1e-3 = 0, 0.1e-1^2+(1/4)*(-a*(1+r)+a*omega^2+4*r*C/(a*Pi))*(omega^2-r-1-4*r*C/(a^2*Pi)+4*r*(EllipticE(B)*a/A+(1/2)*A*(2*a/A^2-2*a^3/A^4)*(EllipticE(B)/B-EllipticK(B)/B)/B-(1/2)*r^2*(2*a/A^2-2*a^3/A^4)*(EllipticE(B)/((-B^2+1)*B)-EllipticK(B)/B)/((1+r)^2*B*A)+r^2*EllipticK(B)*a/((1+r)^2*A^3))/(a*Pi))/(a*omega^2) = 0]
``

plots[implicitplot](Sys, omega = 0 .. 1, a = 0 .. .7, color = [red, blue], gridrefine = 5);

 

 

  

NULL

fsolve(Sys, {a = 0 .. 0.1, omega = 0.6 .. 0.8});

fsolve(Sys, {a = 0.5 .. 1, omega = 0.8 .. 1});

                                

The other 6 solutions easy to find by all changes of signs of found 2 solutions.

Download Syst.mw

See some other ways to solve the problem here

I've fixed several additional errors and inaccuracies in your procedure. Now it is working properly both in Standard and in Classic worksheets.

Euler := proc(f::procedure, a, b, alpha, n::integer)

local w, h, i, xN, yN;

w := Matrix(2, n+1);  h := (b-a)/n;  i := 1;  xN := a; yN := alpha;

while i <= n+1 do

w[1, i] := evalf(xN); w[2, i] := evalf(yN);

yN := evalf(yN+h*f(xN, yN)); xN := evalf(xN+h);

i := i+1

end do;

interface(rtablesize = infinity);

w;

end proc:

 

Example of use with a visualization:

Data := Euler((x, y)->exp(x), 0, 2, 1, 10);

A := plot(Data[1], Data[2], color = blue, legend = "Approximate solution"):

B := plot(exp(x), x = 0 .. 2, 0 .. 8, color = red, legend = "Exact solution"):

plots[display](A, B);

Here is a simple example:

with(plots):

A:=listplot3d([[1,2],[3,4],[5,6],[7,8]], color=red):

B:=listplot3d([[1,3],[3,5],[5,7],[7,9]], color=yellow):

C:=listplot3d([[1,4],[3,6],[5,8],[7,10]], color=blue):

display(A,B,C, axes=normal);

For a better visual perception of the plot the font for tickmarks and labels can also be changed. Compare:

A := plot(x^2, x = 0 .. 1, color = red, labels = [x, y]):

B := plot(x^2, x = 0 .. 1, thickness = 3, color = red, axis = [thickness = 2, tickmarks = [thickness = 2]], axesfont = [times, bold, 13], labelfont = [times, bold, 14], labels = [x, y]):

plots[display](<A | B>, scaling = constrained);

 

 

 

 

An example:

solve((x-1)*(x+1)*(x^2+1)=0, useassumptions) assuming real, positive;

                                                     1

This means extraction the sequence of expressions from a list  or a set. [...][]  or  {...}[]  are equivalent to  op([...])  or  op({...})

 

Addition: see help on  set  or  list

The procedure  Sort  solves the problem. In  Sort procedure  the procedure  OrderOfDerivative , which returns the order of derivatives, was used.

restart;

OrderOfDerivative:=proc(A)

local n, A1;

n:=0;

A1:=A;

while op(0,A1)=diff do

A1:=op(A1)[1]; n:=n+1;

od;

n;

end proc:

 

Example of use:

OrderOfDerivative(diff(x(t),t,t));

                               2

 

The code of the basic procedure  Sort :

Sort:=proc(Expr)

local  L;

L:=sort([op(Expr)], (a,b)->OrderOfDerivative(indets(a, `function`)[1])>=OrderOfDerivative(indets(b, `function`)[1]) );  # The sorted list of op(Expr)

``(add(select(s->has(s,diff), L)))+add(select(s->not has(s,diff), L));  # Conversation  L  into  sum

end proc:

 

 

Example of use:

Expr:=a*diff(x(t),t)+b*x(t)+r*diff(x(t),t,t)+a*diff(y(t),t)+b*diff(y(t),t,t)+c*y(t): # The initial expression

Sort(Expr);

             

 

 

Unfortunately we have to "freeze" the terms with derivatives by the construction ``(...), or in the process of summing elements of the list  L  Maple randomly rearranges the list of terms.


  

The simple procedure  Hist  builds a histogram for any lists  X  and  P  and the width  h . The options are:  C  is the color of filling (by default  blue) and  V is the view of the plot.

Hist := proc (X::list, P::list, h::numeric, C::{string, symbol} := blue, V::list := [X[1]-0.6*h .. X[-1]+0.6*h, 0 .. max(P)])

local n, S, A, B;

n := nops(X);

S := seq(piecewise(X[i]-(1/2)*h <= x and x <= X[i]+(1/2)*h, P[i]), i = 1 .. n);

A := plot([S], x = X[1]-(1/2)*h .. X[n]+(1/2)*h, color = C, filled);

B := plot([S], x = X[1]-0.51*h .. X[n]+0.51*h, tickmarks = [default, [seq(P[i] = P[i], i = 1 .. n)]], color = black, thickness = 2);

plots:-display(A, B, view = V);

end proc:

 

The initial example:

Hist([1, 3, 5, 7], [1/8, 1/4, 1/2, 1/8], 1.8);

                              

 

The second example with 2 used options:

Hist([1, 2, 3, 4], [1/8, 1/4, 1/2, 1/8], 0.8, cyan, [-0.5 .. 5.2, -0.05 .. 0.6]);

                               

 

 

 

First 192 193 194 195 196 197 198 Last Page 194 of 289