mmcdara

6635 Reputation

18 Badges

8 years, 127 days

MaplePrimes Activity


These are answers submitted by mmcdara

At the end you get three different sets of solutions:

restart

u(xi):=c[0]+c[1]*a^(f(xi))

c[0]+c[1]*a^f(xi)

(1)

Eq1 := -(alpha^2 + beta)*u(xi) + k^2*diff(u(xi), xi $ 2) + b*u(xi)^3 = 0

-(alpha^2+beta)*(c[0]+c[1]*a^f(xi))+k^2*(c[1]*a^f(xi)*(diff(f(xi), xi))^2*ln(a)^2+c[1]*a^f(xi)*(diff(diff(f(xi), xi), xi))*ln(a))+b*(c[0]+c[1]*a^f(xi))^3 = 0

(2)

 

NULL

NULL

NULL

D1 := diff(f(xi), xi) = (a^(-f(xi))*p + q + r*a^f(xi))/ln(a);

diff(f(xi), xi) = (a^(-f(xi))*p+q+r*a^f(xi))/ln(a)

(3)

D2 := diff(f(xi), xi$2) = eval(diff(rhs(D1), xi), D1);

diff(diff(f(xi), xi), xi) = (-a^(-f(xi))*(a^(-f(xi))*p+q+r*a^f(xi))*p+r*a^f(xi)*(a^(-f(xi))*p+q+r*a^f(xi)))/ln(a)

(4)

DEq1_0 := eval(Eq1, {D1, D2})

-(alpha^2+beta)*(c[0]+c[1]*a^f(xi))+k^2*(c[1]*a^f(xi)*(a^(-f(xi))*p+q+r*a^f(xi))^2+c[1]*a^f(xi)*(-a^(-f(xi))*(a^(-f(xi))*p+q+r*a^f(xi))*p+r*a^f(xi)*(a^(-f(xi))*p+q+r*a^f(xi))))+b*(c[0]+c[1]*a^f(xi))^3 = 0

(5)

# Setting Z = a^f(xi)

DEq1_1 := collect(eval(expand(DEq1_0), a^f(xi) = Z), Z)

(2*k^2*r^2*c[1]+b*c[1]^3)*Z^3+(3*k^2*q*r*c[1]+3*b*c[0]*c[1]^2)*Z^2+(2*k^2*p*r*c[1]+k^2*q^2*c[1]+3*b*c[0]^2*c[1]-alpha^2*c[1]-beta*c[1])*Z+k^2*c[1]*p*q+b*c[0]^3-alpha^2*c[0]-beta*c[0] = 0

(6)

# I don't understand why yhis command doesn't work ???
coeffs(DEq1_1, Z);

Error, invalid arguments to coeffs

 

# Workaround

with(LargeExpressions):

collect(DEq1_1, Z, Veil[C] );
CoefficientNullity := [ seq( 0 = Unveil[C]( C[i] ), i=1..LastUsed[C] ) ];
sols := {solve(CoefficientNullity)}:

print(cat('_'$120)):
print~(sols):

Z^3*C[1]+3*Z^2*C[2]-Z*C[3]-C[4] = 0

 

[0 = 2*k^2*r^2*c[1]+b*c[1]^3, 0 = k^2*q*r*c[1]+b*c[0]*c[1]^2, 0 = -2*k^2*p*r*c[1]-k^2*q^2*c[1]-3*b*c[0]^2*c[1]+alpha^2*c[1]+beta*c[1], 0 = -k^2*p*q*c[1]-b*c[0]^3+alpha^2*c[0]+beta*c[0]]

 

________________________________________________________________________________________________________________________

 

{alpha = alpha, b = 0, beta = -alpha^2, k = 0, p = p, q = q, r = r, c[0] = c[0], c[1] = c[1]}

 

{alpha = alpha, b = 0, beta = -alpha^2, k = k, p = p, q = 0, r = 0, c[0] = c[0], c[1] = c[1]}

 

{alpha = alpha, b = 0, beta = k^2*q^2-alpha^2, k = k, p = p, q = q, r = 0, c[0] = c[1]*p/q, c[1] = c[1]}

 

{alpha = alpha, b = b, beta = beta, k = k, p = p, q = q, r = r, c[0] = 0, c[1] = 0}

 

{alpha = alpha, b = (alpha^2+beta)/c[0]^2, beta = beta, k = k, p = p, q = q, r = r, c[0] = c[0], c[1] = 0}

 

{alpha = alpha, b = -2*k^2*r^2/c[1]^2, beta = 2*k^2*p*r-(1/2)*k^2*q^2-alpha^2, k = k, p = p, q = q, r = r, c[0] = (1/2)*q*c[1]/r, c[1] = c[1]}

(7)

# After removing solutions which contain b=0 one gets three

sols := convert(remove((x -> member(b=0, x)), sols), list):
print~(sols):

{alpha = alpha, b = b, beta = beta, k = k, p = p, q = q, r = r, c[0] = 0, c[1] = 0}

 

{alpha = alpha, b = (alpha^2+beta)/c[0]^2, beta = beta, k = k, p = p, q = q, r = r, c[0] = c[0], c[1] = 0}

 

{alpha = alpha, b = -2*k^2*r^2/c[1]^2, beta = 2*k^2*p*r-(1/2)*k^2*q^2-alpha^2, k = k, p = p, q = q, r = r, c[0] = (1/2)*q*c[1]/r, c[1] = c[1]}

(8)

# Of course you need a few other assumptions to remove all he solutions for which b could be <=0:

map(x -> select(has, x, b), sols);
b_PositivityConditions := map(x -> solve(rhs(x[1]) > 0), %);
 

[{b = b}, {b = (alpha^2+beta)/c[0]^2}, {b = -2*k^2*r^2/c[1]^2}]

 

[RealRange(Open(0), infinity), {alpha = alpha, c[0] < 0, -alpha^2 < beta}, {alpha = alpha, 0 < c[0], -alpha^2 < beta}]

(9)

# Final solutions:

FinalSolutions := [
                    `union`(sols[1], {b in b_PositivityConditions[1]}),
                    `union`(sols[2], b_PositivityConditions[2]),
                    `union`(sols[3], b_PositivityConditions[3])
                  ]:

print~(FinalSolutions):

{`in`(b, RealRange(Open(0), infinity)), alpha = alpha, b = b, beta = beta, k = k, p = p, q = q, r = r, c[0] = 0, c[1] = 0}

 

{alpha = alpha, b = (alpha^2+beta)/c[0]^2, beta = beta, k = k, p = p, q = q, r = r, c[0] = c[0], c[1] = 0, c[0] < 0, -alpha^2 < beta}

 

{alpha = alpha, b = -2*k^2*r^2/c[1]^2, beta = 2*k^2*p*r-(1/2)*k^2*q^2-alpha^2, k = k, p = p, q = q, r = r, c[0] = (1/2)*q*c[1]/r, c[1] = c[1], 0 < c[0], -alpha^2 < beta}

(10)
 

 

``

Download maple_sheet_mmcdara.mw

The case of spherical coordinates is more complex (read the reference I provided you in y previous reply).

restart

with(plots):

f := (x^2+y^2+z^2+12)^2 - 64*(x^2+y^2)

(x^2+y^2+z^2+12)^2-64*x^2-64*y^2

(1)


PAPPUS' THEOREM

crossection_radius := 2:
crossection_area   := Pi*crossection_radius^2:
Rotation_radius    := 4:
Torus_volume       := crossection_area*(2*Pi*Rotation_radius)

32*Pi^2

(2)


TRIPLE INTEGRAL IN CYLINDRICAL COORDINATES


The cut of the torus (considered here as a volume) at a given height z is an annulus (in green in the figure below). whose inner radius Ri and outer
radius Ro both depend on z.
In polar coordinates the surface of this annulus is easy to write as a double integral in, lets say, rho and theta, where rho ranges from Ri(z) to Ro(z).
Think to this cut as a slice of height dz.
To get the volume of the torus just integrate the slice surface from z=-2 to z=2.

R := Rotation_radius:
r := z -> sqrt(crossection_radius^2-z^2):

slice := proc(Z)
  local L, H, G, a:
  uses plottools:
  L := 6:
  H := 2:
  G := 20:
  a := display(
         plottools:-annulus([0, 0], R-r(Z)..R+r(Z), color="Chartreuse"),
         plottools:-circle([0, 0], R-r(Z), color=red, thickness=3),
         plottools:-circle([0, 0], R+r(Z), color=red, thickness=3)
       ):

  display(
    implicitplot3d(f, x=-L..L, y=-L..L, z=-H..Z, grid=[G, G, G], style=surface, color=gray, scaling=constrained),
    translate(extrude(a, 0..0.001), 0, 0, Z)
  )
end proc:


Explore(slice(z), parameters=[z=-1.999..1.999], initialvalues=[z=-1.999])

 

SliceSurface := z -> Int(rho, theta=0..2*Pi, rho=R-r(z)..R+r(z)):
'SliceSurface(z)' = SliceSurface(z);

SliceSurface(z) = Int(rho, theta = 0 .. 2*Pi, rho = 4-(-z^2+4)^(1/2) .. 4+(-z^2+4)^(1/2))

(3)

TorusVolume := Int(SliceSurface(z), z=-2..2);

value(%)

Int(Int(rho, theta = 0 .. 2*Pi, rho = 4-(-z^2+4)^(1/2) .. 4+(-z^2+4)^(1/2)), z = -2 .. 2)

 

32*Pi^2

(4)


TRIPLE INTEGRAL IN CARTESIAN COORDINATES


Proceed as before but express the surface if the slice in cartesian coordinates.
Its better to use symmetry and integrate over que quadrant x >= 0, y >= 0.

The first integral in CartesianSlice expresses the surface of the disk of radius Ro(z) while the second measures the disk of radius Ri(z).

CartesianSlice := z -> 4*( Int(Int(1, y=0..sqrt((R+r(z))^2-x^2)), x=0..R+r(z)) - Int(Int(1, y=0..sqrt((R-r(z))^2-x^2)), x=0..R-r(z)) )

proc (z) options operator, arrow; 4*(Int(Int(1, y = 0 .. sqrt((R+r(z))^2-x^2)), x = 0 .. R+r(z)))-4*(Int(Int(1, y = 0 .. sqrt((R-r(z))^2-x^2)), x = 0 .. R-r(z))) end proc

(5)

TorusVolume := add(map(Int, [op(CartesianSlice(z))], z=-2..2));

Int(4*(Int(Int(1, y = 0 .. ((4+(-z^2+4)^(1/2))^2-x^2)^(1/2)), x = 0 .. 4+(-z^2+4)^(1/2))), z = -2 .. 2)+Int(-4*(Int(Int(1, y = 0 .. ((4-(-z^2+4)^(1/2))^2-x^2)^(1/2)), x = 0 .. 4-(-z^2+4)^(1/2))), z = -2 .. 2)

(6)


As Maple doesn't seem capable to compute this integral (unless changing the integration variables to get back to cylindrical coordinates,
which is obviously of  no interest here), one can proceed numericallly and check the result is the correct one.

# Volume comprised within Ro(z)

IntegrationTools:-Expand(op(1, TorusVolume));
IntegrationTools:-CollapseNested(op(2, %));
OuterVolume := 4*evalf(%);

4*(Int(Int(Int(1, y = 0 .. (-z^2+20-x^2+8*(-z^2+4)^(1/2))^(1/2)), x = 0 .. 4+(-z^2+4)^(1/2)), z = -2 .. 2))

 

Int(1, [y = 0 .. (-z^2+20-x^2+8*(-z^2+4)^(1/2))^(1/2), x = 0 .. 4+(-z^2+4)^(1/2), z = -2 .. 2])

 

392.4859219

(7)

# Volume comprised within Ri(z)

IntegrationTools:-Expand(op(2, TorusVolume));
IntegrationTools:-CollapseNested(op(2, %));
InnerVolume := 4*evalf(%);

-4*(Int(Int(Int(1, y = 0 .. (-z^2+20-x^2-8*(-z^2+4)^(1/2))^(1/2)), x = 0 .. 4-(-z^2+4)^(1/2)), z = -2 .. 2))

 

Int(1, [y = 0 .. (-z^2+20-x^2-8*(-z^2+4)^(1/2))^(1/2), x = 0 .. 4-(-z^2+4)^(1/2), z = -2 .. 2])

 

76.65858104

(8)

# Volume comprised between Ro(z) and Ri(z)

Volume := OuterVolume - InnerVolume;
identify(%);

315.8273409

 

32*Pi^2

(9)
 

 

Download torus_mmcdara.mw


First point: some stramge characters in the definition of P.
Second point: the variable x0 is never defined I guesses it was a type and arbitrarily replaced it by x.

Onece these corrections done:

  • Your design of experiment does not seem correctly constructed (if I correctly understood what you want to achieve)... I corrected it according to my understanding.
  • Fop can be integretated formally once for all. Thus there is no need to write Fop := unapply(...)and I feel it better to write 
    intFop := unapply(...)where intFopis the indefinite integral of Fopwrt x.


Note that the solution is trivial because IntFop is a sum of terms which are all indidually equal to 0 when x=0:

intFop(entries(titles, nolist));
eval(%, x=0)
                               0


Here is the code

restart

with(Student[Calculus1]):

P := -9*F*k*(2*sqrt(2)*(x^2+2)^2*((1/6)*x^2-1)*arctan((1/2)*x*sqrt(2))+Pi*(x^2+2)^2*((1/6)*x^2-1+epsilon*m*Br)*sqrt(2)+(4*(((1/6)*x^2-1)*x^2+5*x^2*(1/9)-14/9))*x*beta)/(16*(x^2+2)^2)+1/((2/3+(1/3)*x^2)*N) = 0;

-(9/16)*F*k*(2*2^(1/2)*(x^2+2)^2*((1/6)*x^2-1)*arctan((1/2)*x*2^(1/2))+Pi*(x^2+2)^2*((1/6)*x^2-1+epsilon*m*Br)*2^(1/2)+4*(((1/6)*x^2-1)*x^2+(5/9)*x^2-14/9)*x*beta)/(x^2+2)^2+1/((2/3+(1/3)*x^2)*N) = 0

(1)

titles := Vector[row]([k, epsilon,  Br, beta, m,F, N, result]);

titles := Vector[row](8, {(1) = k, (2) = epsilon, (3) = Br, (4) = beta, (5) = m, (6) = F, (7) = N, (8) = result})

(2)

data := table([k=[seq(.1 .. .9, .1)], epsilon=[0.5$9], Br=[0.1$9], beta=[1$9], m=[1.5$9],F=[1.5$9], N=[0.5$9]]);

table( [( m ) = [1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5], ( epsilon ) = [.5, .5, .5, .5, .5, .5, .5, .5, .5], ( F ) = [1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5], ( k ) = [.1, .2, .3, .4, .5, .6, .7, .8, .9], ( N ) = [.5, .5, .5, .5, .5, .5, .5, .5, .5], ( Br ) = [.1, .1, .1, .1, .1, .1, .1, .1, .1], ( beta ) = [1, 1, 1, 1, 1, 1, 1, 1, 1] ] )

(3)

DOE := `<|>`( seq(<data[i]>, i in titles[1..-2]) )

DOE := Matrix(9, 7, {(1, 1) = .1, (1, 2) = .5, (1, 3) = .1, (1, 4) = 1, (1, 5) = 1.5, (1, 6) = 1.5, (1, 7) = .5, (2, 1) = .2, (2, 2) = .5, (2, 3) = .1, (2, 4) = 1, (2, 5) = 1.5, (2, 6) = 1.5, (2, 7) = .5, (3, 1) = .3, (3, 2) = .5, (3, 3) = .1, (3, 4) = 1, (3, 5) = 1.5, (3, 6) = 1.5, (3, 7) = .5, (4, 1) = .4, (4, 2) = .5, (4, 3) = .1, (4, 4) = 1, (4, 5) = 1.5, (4, 6) = 1.5, (4, 7) = .5, (5, 1) = .5, (5, 2) = .5, (5, 3) = .1, (5, 4) = 1, (5, 5) = 1.5, (5, 6) = 1.5, (5, 7) = .5, (6, 1) = .6, (6, 2) = .5, (6, 3) = .1, (6, 4) = 1, (6, 5) = 1.5, (6, 6) = 1.5, (6, 7) = .5, (7, 1) = .7, (7, 2) = .5, (7, 3) = .1, (7, 4) = 1, (7, 5) = 1.5, (7, 6) = 1.5, (7, 7) = .5, (8, 1) = .8, (8, 2) = .5, (8, 3) = .1, (8, 4) = 1, (8, 5) = 1.5, (8, 6) = 1.5, (8, 7) = .5, (9, 1) = .9, (9, 2) = .5, (9, 3) = .1, (9, 4) = 1, (9, 5) = 1.5, (9, 6) = 1.5, (9, 7) = .5})

(4)

#DOE := <seq(Vector(9, data[i]), i in titles[1 .. -2])>

Fop := lhs(P):
intFop := unapply(int(Fop, x), [entries(titles, nolist)]);

proc (k, epsilon, Br, beta, m, F, N, result) options operator, arrow; -(1/16)*F*k*2^(1/2)*arctan((1/2)*x*2^(1/2))*x^3+(9/8)*F*k*2^(1/2)*arctan((1/2)*x*2^(1/2))*x+(1/16)*F*k*x^2-(5/4)*F*k*ln((1/2)*x^2+1)-(9/16)*F*k*2^(1/2)*Pi*epsilon*m*Br*x-(1/32)*F*k*2^(1/2)*Pi*x^3-(3/16)*F*k*x^2*beta+(5/4)*F*k*ln((1/2)*x^2+1)*beta+(9/16)*F*k*2^(1/2)*Pi*x+(3/2)*2^(1/2)*arctan((1/2)*x*2^(1/2))/N end proc

(5)

V := Vector(9, i -> intFop(entries(DOE[i], nolist))):

NewtonsMethod~(V, x=1)

Vector[column]([[0.], [0.3e-21], [0.2e-21], [0.1e-21], [0.4e-22], [0.1e-22], [0.1e-22], [0.], [0.1e-23]])

(6)

  


 

Download Help_Newton_Method_mmcdara.mw


I mention Maple 2015 in the title for Maple 2019 and later use the notion of DataFrame which could answer your problem in a simpler way (or maybe not?).

To fix the idea I simulated a N by Q data set where N=100 individuals answered Q=4 questions:

  1. the first has 2 possible outcomes,
  2. so has the second,
  3. the third has 3 possible outcomes,
  4. and the last one has 2 possible outcomes.
     

I generate a 4 dimensional array, named PivotArray, whose each index contains the number of individuals matching this index.
For instance if 10 individuals answered 1 to quastion 1, 1 to question 2, 3 to question 3 and 2 to question 4, then PivotArray[1, 1, 3, 2] = 10.
Once done it remains you several possibilities to build a 2D array which represents the pivot table you need.
For instance you can "group" questions 1 and 2 on one side and questions 3 and 4 on the other side (then your pivot table will have dimensions (4, 6)).
Or group questions 1, 2 and 4 and left question 3 apart  (and then your pivot table will have dimensions (8, 3)).

The attached file build the 2D array given the 4D array and a particular "grouping".

A tool to extract all the indicuals wich give predefined answers is proposed.

Finally a "smart" presentation of the 2D pivot array is proposed (be extremely careful because this part is not completely generic).
More of this, if you use Maple >= 2108, replace

InsertContent(Worksheet(Group(Input( T )))):

by

InsertContent(Worksheet( T )):


If you need more help I advice you to provide a more detailed example of your data (how many outomes has each question).

Last by not least: I never use Statistics:-ChiSquareIndependenceTest (I use to use R instead for this kind of computations [more poreful and versatile]), so I don't know how Maple behaves.

PivotTable0.mw


As my Maple 2015 doesn't accept polygonbyname("rectangle", ...) I replaced it by rectangle(...).
But this should work with your newer Maple's version:
 

restart;
with(plots); with(plottools);
L := point([2, 2], color = black, symbol = solidcircle, symbolsize = 30);
K := line([2, 2], [1, 2], color = red, linestyle = dash, thickness = 4);
K1 := line([2, 2], [2+1.5*((1/2)*sqrt(2)), 2+1.5*((1/2)*sqrt(2))], color = blue, linestyle = dash, thickness = 4);
K3 := rectangle([0, 0], [4, 4], color = "Red");
K2 := annulus([2, 2], 1 .. 3/2, color = blue, style = 'polygon', transparency = .8); 
K4 := disk([2, 2], 3/2, color = white, style = 'polygon', transparency = 0);
display(L, K, K1, K2, K4, K3, size = [300, 300], axes = none);

Couronne_mmcdara.mw


 


 

restart
kernelopts(version)
     Maple 2015.2, APPLE UNIVERSAL OSX, Dec 20 2015, Build ID 1097895

h := (t, x) -> (m*t^2 + 6*t - 2*x)^2/(36*g*t^2):  # Your syntax is not supported by Maple 2015

# Answer to your question
T := [1,5,10,15,20]:
Vector(h~(T, x)):


# More generally: evaluation of h(t, x) on the grid T times X:
X := [$1..5]:
TX := Matrix(numelems(T), numelems(X), (i, j) -> (T[i], X[j])):
h~(TX):


A_solution.mw

..., this could answer your problem  (content of the file can't be uploaded)

proposal_mmcdara.mw

The trick is that its better to solve A=0 wrt to lambda[1] (which expresses lambda[1] as a rational function of x) and next to fit this relation by a simple model that you can easily "invert" to get x as a function of lambda[1] if you prefer.

restart

x:= Vector([1, 2, 0, 4]);

Statistics:-ColumnGraph(x)

x := Vector(4, {(1) = 1, (2) = 2, (3) = 0, (4) = 4})

 

 

__distance := 1e-10:
__offset   := 0.5:
__width    := 1.:

Statistics:-ColumnGraph(x, 'offset' = __offset, 'distance' = __distance, 'width' = __width)
 

 

__distance := 0.5:
__offset   := 0.75:
__width    := 0.5:

Statistics:-ColumnGraph(x, 'offset' = __offset, 'distance' = __distance, 'width' = __width)

 

__distance := 0.8:
__offset   := 0.9:
__width    := 0.2:

Statistics:-ColumnGraph(x, 'offset' = __offset, 'distance' = __distance, 'width' = __width)

 

# If width = 0.2, then the half width is 0.1 and you need to offset the first
# bar by 0.9 for it to be centered at x=1.
#
# The distance between the right of this first bar and the left of the second one
# must be 0.8 for this second bar to be centered at x=2.
#
# Thus, for a given width w, offset must be 1-w/2 and distance must be 1-w for
# the bars to be centered at x=1, 2,3, ...

# Do this to understand what happens

Statistics:-ColumnGraph['interactive'](x)

 

 

Download ColumnGraph_mmcdara.mw


I understand your concern to keep this succession of questions and answers active,, but I don't think people here will appreciate for long that you ask questions on the same subject in separate threads.
 

restart;
with(plottools):
with(plots):

bg := display(
	circle([-14,12], 10, color=gray),
	pointplot([[-14,-22], [-14,22]], connect, color=black),
        pointplot([[-30,2], [10,2]], connect, color=black,linestyle = dash),
        pointplot([[-30,12], [10,12]], connect, color=black,linestyle = dash),
	pointplot([-14,12], symbol=solidcircle, symbolsize=10, color=blue)
	
):
frame := proc(t)
	local P := [-14+10*sin(2*Pi*t/3), 12+10*cos(Pi-2*Pi*t/3)],R := [-14+10*sin(2*Pi*t/3), 0], H := [t,-10*cos((2*Pi)/3*t) + 12];
	display(
		
		pointplot([P,H,R], symbol=solidcircle, symbolsize=10, color=blue),
		
		
		line(P, R, color=red, thickness=5),
                
                plot(-10*cos((2*Pi)/3*x) + 12, x=0..t, color=red, discont,labels=["",""])
                # example
                , axis[1]=[tickmarks=[0,3,6], gridlines=50]
                , axis[2]=[tickmarks=[0,2,12,22], gridlines=[20, color=red, linestyle=3]]
	);
end proc:
t0 := time(); 
animate(frame, [t], t = 0 .. 6, background = bg, scaling = constrained, size = [1000, 700], view = [-30 .. 10, -10 .. 25], frames = 120); # not the place to set gridlines or tickmarks
time()-t0;
               1.493  # 1.5 second for 120 frames (MAPLE 2015.2)


More fun with GrandeRoue.mw and even more with GrandeRoue_2.mw (scrolling of the sine curve):
 

 

 

 

 

 


 

 



 

NULL

NULL

Animation Sinus

 

NULL

NULL

restart;

with(plottools):

with(plots):

h := 2:  

col := t -> `if`(floor(t/2/Pi)::even, red, blue);

proc (t) options operator, arrow; `if`((floor((1/2)*t/Pi))::even, red, blue) end proc

(1)

bg := display(
        circle([-2,0], 1, color=gray),
        pointplot([[-2,-h], [-2,h]], connect, color=black),
        pointplot([-2,0], symbol=solidcircle, symbolsize=10, color=blue),
        seq(
         plot(sin(t), t=(n-1)*2*Pi..n*2*Pi, color=col((n-1)*2*Pi), discont, gridlines)
         , n=1..4
       )
):

frame := proc(t)
        local P := [-2+cos(t), sin(t)], Q := [-2,sin(t)], H := [t,sin(t)];
        display(
                pointplot([[-2,0], P, Q], connect, color=blue),
                pointplot([P,Q,H], symbol=solidcircle, symbolsize=10, color=blue),
                line(Q, H, color=gray),
                arc([-2,0], 1, 0..t, color=col(t), thickness=5),
                line([-2,0], Q, color=col(t), thickness=5)
        );
end proc:

animate(frame, [t], t = 0 .. 8*Pi, background = bg, scaling = constrained, view = -h .. h, size = [1000, 700], frames = 120);

 

 

 

 


 

Download AnimSinusCouleurs_mmcdara.mw
 


For this kind of problems (or even more complex ones)  I like using the events option.
So I propose you two solutions:

  1. the first one uses only the events option to manage the changing of eq1's rhs,
  2. the second one uses options events and discrete_variables.
     

The first one is sufficient for your problem, but using also discrete_variables enables handling much more complex situations:

A_solution.mw

Of course this would have worked the same:

sol4 := dsolve(
  {
    diff(T(x), x) = piecewise(T(x) < 4, rhs1a, rhs1b),
    # or 
    # diff(T(x), x) = (rhs1b-rhs1a)*Heaviside(T(x)-4) + rhs1a,
    eqn2,
    T(0) = 0, 
    q(0) = 0
  },
  numeric
);

display(
  odeplot(sol , [x, T(x)], x = 1 .. 3.2, color=blue, legend="rhs1a"),
  odeplot(sol4, [x, T(x)], x = 1 .. 3.2, color=red , legend="rhs1a & rhs1b"),
  gridlines=true
);

but I prefer using events and discrete_variables which both offer more possibilities (which is of course a personal opinion).

Note that doing this would not give you the value of x where the "bifurcation" occurs (this is why the plotting range is set arbitrarily to 1..3.2). If this value of x maters to you, the simplest thing to do is to use events.

I'm not sure I inderstood correctly your problem, if not, just forget this.

restart

with(combinat):

# Holder

alph := parse~([$"A".."P"]);

# Number of players

NC   := 4:
game := alph[1..NC]:

# Random order of the players

parts := randperm(game):

# Build all series of NC/4 games each

game[1] := parts:
for n from 2 to NC-1 do
  game[n] := [game[n-1][1], ListTools:-Rotate(game[n-1][2..-1], 1)[]];
end do:

# Smart display

for __n from 1 to NC-1 do
  Games[__n] := op~([ seq([{game[__n][k..k+1][]}, vs,  {game[__n][k+2..k+3][]}], k=1..NC/4) ]);
end do;

[A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P]

 

[{A, B}, vs, {C, D}]

 

[{A, C}, vs, {B, D}]

 

[{A, D}, vs, {B, C}]

(1)

# Number of players

NC   := 16:
game := alph[1..NC]:

# Random order of the players

parts := randperm(game):

# Build all series of NC/4 games each

game[1] := parts:
for n from 2 to NC-1 do
  game[n] := [game[n-1][1], ListTools:-Rotate(game[n-1][2..-1], 1)[]];
end do:

# Smart display

for __n from 1 to NC-1 do
  Games[__n] := op~([ seq([{game[__n][k..k+1][]}, vs,  {game[__n][k+2..k+3][]}], k=1..NC/4) ]);
end do;

[{C, M}, vs, {F, L}, {C, L}, vs, {F, K}, {F, L}, vs, {J, K}, {F, K}, vs, {B, J}]

 

[{L, M}, vs, {F, K}, {F, L}, vs, {J, K}, {F, K}, vs, {B, J}, {J, K}, vs, {A, B}]

 

[{F, M}, vs, {J, K}, {F, K}, vs, {B, J}, {J, K}, vs, {A, B}, {B, J}, vs, {A, H}]

 

[{K, M}, vs, {B, J}, {J, K}, vs, {A, B}, {B, J}, vs, {A, H}, {A, B}, vs, {D, H}]

 

[{J, M}, vs, {A, B}, {B, J}, vs, {A, H}, {A, B}, vs, {D, H}, {A, H}, vs, {D, P}]

 

[{B, M}, vs, {A, H}, {A, B}, vs, {D, H}, {A, H}, vs, {D, P}, {D, H}, vs, {G, P}]

 

[{A, M}, vs, {D, H}, {A, H}, vs, {D, P}, {D, H}, vs, {G, P}, {D, P}, vs, {E, G}]

 

[{H, M}, vs, {D, P}, {D, H}, vs, {G, P}, {D, P}, vs, {E, G}, {G, P}, vs, {E, O}]

 

[{D, M}, vs, {G, P}, {D, P}, vs, {E, G}, {G, P}, vs, {E, O}, {E, G}, vs, {I, O}]

 

[{M, P}, vs, {E, G}, {G, P}, vs, {E, O}, {E, G}, vs, {I, O}, {E, O}, vs, {I, N}]

 

[{G, M}, vs, {E, O}, {E, G}, vs, {I, O}, {E, O}, vs, {I, N}, {I, O}, vs, {C, N}]

 

[{E, M}, vs, {I, O}, {E, O}, vs, {I, N}, {I, O}, vs, {C, N}, {I, N}, vs, {C, L}]

 

[{M, O}, vs, {I, N}, {I, O}, vs, {C, N}, {I, N}, vs, {C, L}, {C, N}, vs, {F, L}]

 

[{I, M}, vs, {C, N}, {I, N}, vs, {C, L}, {C, N}, vs, {F, L}, {C, L}, vs, {F, K}]

 

[{M, N}, vs, {C, L}, {C, N}, vs, {F, L}, {C, L}, vs, {F, K}, {F, L}, vs, {J, K}]

(2)
 

 

Download Games.mw

Are these lists of Games  ehaustive (because there are more with 16 players)?
 



EDITED 2023/03/19

Behind this intriguing title lies the fact that there exist several formulas to assess the weighted variance.


POINT 1
The most common formulas (biased and unbiased estimators) are given in the attached file (which is the one I already attached to my original answer)
Ecart_type.mw



POINT 2
This second file presents different formulas to assess the empirical weighted variance.
You will see that Maple's Variance(A, weights=B) corresponds to the formula one can find in two different external references.
Ecart_type.mw

I advice you to read carefully the two first pages of Berkeley where a discussion about what formula we should use is developped, in a nustshell this all depenf on the nature of the weights.
Given your weghts are integers, I would lean more towards saying that they represents the number of occurrences of each of your four outcomes?
Am I right?
If it so the good formula to use is the unbiased one in the first attached file here or the first one in the second attached file here. 
Whatever it would be great that Statistics:-Variance proposed different options to assess the variance of a weighted sample (just as it dioes to assess Quantiles)





POINT 3
In the previous files I didn't address the point concerning the discrepancy between Maple's Variance(A, weights=B) result and the result (variance=4.473676) your TI gives.

As you probably know these two points of view lead to different formulas for raw and centered moments of order larger than 1 (in particular the variance).
In this third file two points of view are discussed 

  1. In the first point of view the couple (A, B) is a sample of a random variable.
     
  2. In the second one (red text in the fle) the couple (A, B) represents the whole population.

At the end of it you will see that your TI adopts the second point of view.
Ecart_type.mw

 

See the edited answer for more details and explanations

 

 

restart:

with(Statistics):

A := [8, 9, 16, 18]:
B := [78, 31, 59, 81]:

# Direct formula fior the mean

Moyenne := add(A*~B) / add(B);
evalf(%);

3305/249

 

13.27309237

(1)

# Direct formula for the standard deviation
# (1): biased estimator

ET :=  sqrt(add((A -~ Moyenne)^~2*~B) / add(B));
evalf(%);

(1/249)*1240874^(1/2)

 

4.473675667

(2)

# Direct formula for the standard deviation
# (2): unbiased estimator

ET :=  sqrt(add((A -~ Moyenne)^~2 *~ B) / (add(B)-1));
evalf(%);

(1/15438)*4789153203^(1/2)

 

4.482686100

(3)

# Alternative way to compute the mean and the standard deviation (unbiased estimator)

C := [seq(A[i]$B[i], i=1..numelems(A))]:
[Mean, StandardDeviation](C);

[HFloat(13.273092369477911), HFloat(4.482686100195402)]

(4)
 

 

Download Ecart_type.mw
 

 

@Mariusz Iwaniuk @oggsait

... whose steps ar guided by the result the OP wants to get.
So it is not a solution that Maple produces by itself but a solution we force Maple to proivide...

In particular, step (5), I don't know how to force Maple to convert cosh(X)^2-1 into sinh(X)^2 without using eval (as I did) or simplify with the rule i use  in eval.
I also used several steps to transform sqrt(2)*sqrt(p[2])/sqrt(p[1]) into sqrt(2*p[2]/p[1]) because I wasn't able to do this more simply using ad hoc assumptions.

To @oggsait : I don't know if you will find some interest in that?
 

restart:

with(IntegrationTools):

f := 1/(u*sqrt(1+p*u^2/q))

1/(u*(1+p*u^2/q)^(1/2))

(1)

F := Int(f, u);

Int(1/(u*(1+p*u^2/q)^(1/2)), u)

(2)

`(1)`  = value(F);
`(2)`  = isolate(rhs(%)=X, u);
`(3)`  = allvalues(rhs(%));
`(4)`  = simplify([rhs(%)]) assuming p > 0, q < 0, x > x[0];
`(5)`  = eval(rhs(%), cosh = (z -> sqrt(1+sinh(z)^2)));
`(6)`  = eval(rhs(%), sinh(X)=S);
`(7)`  = simplify(rhs(%)) assuming S > 0;
`(8)`  = eval(rhs(%), S=sinh(X));
`(9)`  = eval(rhs(%), [p=P^2, q=Q^2]);
`(10)` = simplify(rhs(%)) assuming P > 0, Q < 0;
`(11)` = eval(rhs(%), Q=P*sqrt(q/p));
`(12)` = eval(rhs(%), sinh(X) = 1/sech(X));
`(13)` = eval(rhs(%), [X=x-x[0], q=``(-2*p[2]), p=p[1]]);  # assuming p[2] < 0

 

`(1)` = -arctanh(1/(1+p*u^2/q)^(1/2))

 

`(2)` = (u = RootOf(_Z^2*tanh(X)^2*p+tanh(X)^2*q-q))

 

`(3)` = (u = (-(tanh(X)^2*q-q)/(tanh(X)^2*p))^(1/2), u = -(-(tanh(X)^2*q-q)/(tanh(X)^2*p))^(1/2))

 

`(4)` = [u = (q/sinh(X)^2)^(1/2)/p^(1/2), u = -(q/sinh(X)^2)^(1/2)/p^(1/2)]

 

`(5)` = [u = (q/sinh(X)^2)^(1/2)/p^(1/2), u = -(q/sinh(X)^2)^(1/2)/p^(1/2)]

 

`(6)` = [u = (q/S^2)^(1/2)/p^(1/2), u = -(q/S^2)^(1/2)/p^(1/2)]

 

`(7)` = [u = q^(1/2)/(p^(1/2)*S), u = -q^(1/2)/(p^(1/2)*S)]

 

`(8)` = [u = q^(1/2)/(p^(1/2)*sinh(X)), u = -q^(1/2)/(p^(1/2)*sinh(X))]

 

`(9)` = [u = (Q^2)^(1/2)/((P^2)^(1/2)*sinh(X)), u = -(Q^2)^(1/2)/((P^2)^(1/2)*sinh(X))]

 

`(10)` = [u = -Q/(P*sinh(X)), u = Q/(P*sinh(X))]

 

`(11)` = [u = -(q/p)^(1/2)/sinh(X), u = (q/p)^(1/2)/sinh(X)]

 

`(12)` = [u = -(q/p)^(1/2)*sech(X), u = (q/p)^(1/2)*sech(X)]

 

`(13)` = [u = -(``(-2*p[2])/p[1])^(1/2)*sech(x-x[0]), u = (``(-2*p[2])/p[1])^(1/2)*sech(x-x[0])]

(3)

 


 

Download A_thirteen_steps_solution.mw

3 4 5 6 7 8 9 Last Page 5 of 57