Kitonum

21530 Reputation

26 Badges

17 years, 82 days

MaplePrimes Activity


These are answers submitted by Kitonum

fa:=proc(x)

local  i, j;

for i while x[i]=0 do; od;

for j from -1 by -1 while x[j]=0 do; od;

[i, ArrayNumElems(x)+j+1];

end proc; 

Because your system contains two redundant unknowns is easy to check that it has infinitely many solutions in four-dimensional space. But you do not look for solutions in the whole space, and on a discrete finite set  a=0.01 ... 7.11 by 0.01  and so on. I think that there does not exist exact solutions on this set.

 Natural formulation of the problem: on a given set of numbers to find a quartet  [a, b, c, d] , for which the left-hand sides of the system have the least differencies from the right-hand sides. As a measure of the difference consider  (7.11-(a+b+c+d))^2+(7.11-a*b*c*d)^2 . The procedure consists of two stages. To speed up work on the first stage we consider the wider step=0.1, and step=0.01 on the second stage near the optimum point of the  first stage.

restart:

R:=[infinity, []]:  # First stage

for a from 0.1 by 0.1 to 7.11 do

for b from a by 0.1 to 7.11 do

for c from b by 0.1 to 7.11 do

for d from c by 0.1 to 7.11 do

delta:=(7.11-(a+b+c+d))^2+(7.11-a*b*c*d)^2;

if delta<0.01 and delta<R[1] then R:=[delta, [a, b, c, d]]: fi:

od: od: od: od:

R;

 

a0:=R[2,1]: b0:=R[2,2]: c0:=R[2,3]: d0:=R[2,4]:  # Second stage

for a from a0-0.09 by 0.01 to a0+0.09 do

for b from b0-0.09 by 0.01 to b0+0.09 do

for c from c0-0.09 by 0.01 to c0+0.09 do

for d from d0-0.09 by 0.01 to d0+0.09 do

delta:=(7.11-(a+b+c+d))^2+(7.11-a*b*c*d)^2;

if delta<R[1] then R:=[delta, [a, b, c, d]]: fi:

od: od: od: od:

R;

         [.11296e-3, [.8, 1.8, 1.9, 2.6]]  # Result of the first stage

  [.266342400e-7, [.80, 1.76, 1.92, 2.63]]  # Result of the second stage

 

Verification:

7.11-convert([.80, 1.76, 1.92, 2.63],`+`);

7.11-convert([.80, 1.76, 1.92, 2.63],`*`);

                                 0.

                         0.00016320

fa:=proc(x)

local L, i, j;

L:=[];

for i while x[i]=0 do

od;

L:=[op(L), i];

for j from -1 by -1 while x[j]=0 do

od;

[op(L), ArrayNumElems(x)+j+1];

end proc; 

 

Example:

fa(<1|0|0|1|0|0>);

          [1, 4]

It is easy to prove that in any interval  RealRange(n, n+1) , where  n is positive integer, function  x -> frac(x*floor(x)) - 1/2  has exactly n roots. Thereforу in  RealRange(1,100)  there are  add(n, n=1..99) = 4950  roots.  

Use geometry package. Specify the coordinates of all the objects. The solution is obvious:

 

assume(y1>0, x2>0, x3>0, x3<x2):

point(A,0,0), point(B,x1,y1), point(C,x2,0), point(R,x3,0):

line(BC, [B, C]), line(AB, [A, B]), line(AC, [A, C]), ParallelLine(PR, R, BC):

intersection(P, PR, AB):

ParallelLine(PQ, P, AC):

intersection(Q, PQ, BC):

line(AQ, [A, Q]), line(BR, [B, R]):

intersection(M, PR, AQ), intersection(N, PQ, BR):

triangle(APM, [A, P, M]), triangle(PBN, [P, B, N]), triangle(RQC, [R, Q, C]):

S1, S2, S3:=area(APM), area(PBN), area(RQC);

is(S1+S2=S3);

3^((x+3)/(5*x-2))-4 >= 5*3^((9*x-7)/(5*x-2)):  #   The original inequality

convert((x+3)/(5*x-2), parfrac);

convert((9*x-7)/(5*x-2), parfrac);

# Change in the original inequality y=3^(17/5/(5*x-2))

solve(5*(3^(9/5))/y<=(3^(1/5))*y-4, y);  # Solution for y

solve(3^(17/5/(5*x-2))>=3*3^(4/5));  # The final result

restart;

with(RealDomain):

sys := {x = expand(a*(3*cos(t) - cos(3*t))), y = simplify(expand(a*(3*sin(t) - sin(3*t))))};

subs(sin(t)=solve(sys[2], sin(t)), subs(cos(t)=sqrt(1-sin(t)^2), sys[1]));

eq:=subs(y=abs(y), simplify(lhs(%)^2=rhs(%)^2)) ;

a:=1:   plots[implicitplot](eq, x=-4..4, y=-4..4, thickness=2, numpoints=10000);

The next procedure solves the problem:

Divs:=proc(n)

local L, M, Div, k, i, K, j, T, P;

uses numtheory;

 

if n=1 then return [1,1] else

 

L[1]:=[[n]];

M:=[];

Div:=divisors(n) minus {1, n};

for k in Div while n/k>=k do

M:=[op(M), [n/k, k]];

od;

L[2]:=M;

 

for i from 3 to bigomega(n) do

K:=[];

for j from 1 to nops(L[i-1]) do

Div:=divisors(L[i-1][j,1]) minus {1, L[i-1][j,1]};

for k in Div while L[i-1][j,1]/k>=k and k>=L[i-1][j,2] do

K:=[op(K),[L[i-1][j, 1]/k, k, op(L[i-1][j][2..nops(L[i-1][j])])]];

od; od;

L[i]:=K;

od;

 

L:=[seq(L[i], i=1..bigomega(n))];

 

M:=[]; T:=[seq(ithprime(k), k=1..bigomega(n))];

for i from 1 to nops(L) do

P[i]:=[seq(T[k], k=1..i)];

for j from 1 to nops(L[i]) do

M:=[op(M), mul(P[i][t]^(L[i][j,t]-1), t=1..nops(P[i]))];

od: od:

 

[n, min(M)]; fi;

 

end proc:

 

Example:

 

[seq(Divs(n), n=1..100)];

 

alpha:=Pi/2:

plot3d([r*cos(t), r*sin(t)*cos(alpha), r*sin(t)*sin(alpha)], t=0..Pi, r=0..1, scaling=constrained, axes=normal, view=[-1..1, -1..1, -1..1]);

Easy to prove that the formula

a(n)=-1/3*n^5+65/12*n^4-193/6*n^3+1057/12*n^2-108*n+48

gives the integer values ​​for each n.

The first 10 terms of the sequence:

1, 3, 6, 12, 33, 51, -22, -384, -1383, -3557

In Maple a function can be specified as follows:

 f:=x->f(x)

For your example:

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

f(x+1);

(x+1)^2+2*(x+1)

 

The natural domain and the range of the function  x->sqrt(x+1)  of real variable x  can be found as follows:

 

Domain:=solve(x+1>=0);

r:=convert(domain, list);

Range=minimize(sqrt(x+1), x=r[1]..r[2])..maximize(sqrt(x+1), x=r[1]..r[2]);

                                Domain:=RealRange(0, infinity)

                                            r:=[-1, infinity]

                                          Range=0..infinity

 

Thanks Aser. Your code is perfect!

 

Adjustment of Brian Bovril's  code:

 

restart;

with(combinat);

DartSum := proc (Darts, Total)

local L, N, S, x, n;

 L := choose([seq(10, i = 1 .. Darts), seq(20, i = 1 .. Darts), seq(30, i = 1 .. Darts), seq(40, i = 1 .. Darts), seq(50, i = 1 .. Darts)], Darts):

N := nops(L); n:=0;

 for x to N do

 S := add(i, i = L[x]);

if S <> Total

then next

else print(L[x]); n:=n+1;

 end if

 end do;

if n=0 then print("does not exist"); fi; 

 end proc;

The routine:

Darts:=proc(n::integer, L::list, Total::integer)  # n - the number of shots,  L -  the list of the numbers on the target,  Total - total amount of points  

local l, M, S, T, U, c;

l:=nops(L);

M:=[seq(floor(Total/L[i]), i=1..l)];

S:=seq([seq([k,L[i]], k=0..M[i])], i=1..l);

T:=combinat[cartprod]([S]):

U:=[];

while not T[finished] do

c:=T[nextvalue]();

if add(c[i,1], i=1..l)=n and add(c[i,1]*c[i,2], i=1..l)=Total then U:=[op(U), c]; fi;  od;

U; # List of all variants

end proc;

 

Examples:

We will use "a prime" sign instead "a dot" sign. Your second-order equation with the initial conditions  x''+2 x'+3 x=4 t, x(0)=1, x'(0)=2,  can be written as a system of first-order equations  {x'=y, y'=-3 x-2 y+4 t, x(0)=1, y(0)=2} . Then solve this system by  Euler method just as one first-order equation.

First 272 273 274 275 276 277 278 Last Page 274 of 290