mmcdara

6635 Reputation

18 Badges

8 years, 124 days

MaplePrimes Activity


These are answers submitted by mmcdara

Question 1:
I'm not sure there is a limitation of the number of plots you can display in a single plot3d command. For instance

N := 100:  # try 1000 if you want
F := [seq(i, i=1..N)]:
r := rand(0. .. 1.):
c := () -> ColorTools:-Color([r(), r(), r()]):
plot3d(F, x=0..1, y=0..1, color=[seq(c(), n=1..N)])

I would say the limitation is more related to human capabilities than to software's. Are you capable to visually separate let's say, 10 surfaces drawn together, or to undersand what they represent ?
Personally I begin having problems with 3 surfaces.

Question 2:
I suggest you to run one of these commands and see what kind of graphics Maple can do

plots[interactive]();

# or 
plots[interactive](abs(solnum));


There is an obvious difference at line 5: in aa1.mw Num:=100 whilie Bum:=200 in aa2.mw

Other differences:
Open aa1.mw, from the menubar: File > Export As > Maple Text (produces a file bamed aa1.txt).
Do the same for aa2.mw

Use some online file or text comparator if you don't have one, for instance Compare (in this case open the txt file and drag-and-drop the texts in the appropriate regions)
The differences are blue highlighted (aa1 is on the left)



So, contrary to what you write, these two programs are NOT identical

Maybe "identical programs" mean for you "the two programs, while different, should give the same result" ? 
But this is another question. 

So check he parts of the codes where differences occur and make yourself sure that those parts give the same results.
For instance are you sure these definitions of T11 have similar effects, see aa.mw

Here is a revised version of your aa2 code where I switch from aa1 code to aa2 code for T11, ..., T16 
This is why you get different results : aa2_mmcdara.mw
It is obvious that T11 (at least) has different expressions in the two codes (look after the plot):

# "T11 from aa1" = "T11 from aa2" iif k0 = -I, which is never the case:

k0 := (.5*Pi+(2*(N-1))*Pi/(Num-1))/(l1+2*l2+2*l3+2*l4)

            0.29089 + 0.00186 (N - 1) Pi


So, contrary to what you write, these two processes are NOT similar

 

Solve {E2, E3, E4} wrt {b, c, d} (for instance).

Plug the solution into the equality E1 - f(Ea) = 0.

Build an objective function J(T)(A) depending on the remaining parameter a (noted A), equal to the integral of  (E1 - f(Ea))2  over t from 0 to some value T (or over any other range).

Minimize J(T)(A) wrt to A for any given value of T (J(T)(A) represents the L2 norm of E1 - f(Ea) for the value a=A).

Here is an example

restart

Ea := 0.762014687e-2*t+a*t^2+b*t^3+c*t^4+d*t^5; 1; E1 := diff(Ea, t); 1; E2 := subs(t = 435, Ea); 1; E3 := subs(t = 528, Ea); 1; E4 := subs(t = 33168, Ea)

0.762014687e-2*t+a*t^2+b*t^3+c*t^4+d*t^5

 

0.762014687e-2+2*a*t+3*b*t^2+4*c*t^3+5*d*t^4

 

3.314763888+189225*a+82312875*b+35806100625*c+15575653771875*d

 

4.023437547+278784*a+147197952*b+77720518656*c+41036433850368*d

 

252.7450314+1100116224*a+36488654917632*b+1210255706308018176*c+40141761266824346861568*d

(1)

# Solve {E2, E3, E4} wrt {b, c, d}

Sol_234_bcd := solve({E2 = 3.259, E3 = 3.95, E4 = 3.259}, {b, c, d})

{b = -0.1526025156e-8-0.4222939510e-2*a, c = 0.1976033772e-11+0.4480294360e-5*a, d = -0.5819557876e-16-0.1312675972e-9*a}

(2)

# Remaining relation

res := eval(E1 = (5.012764943*10^(-24))*Ea/(exp(Ea/(4.100527530*10^(-21)))-1), Sol_234_bcd)

0.762014687e-2+2*a*t+3*(-0.1526025156e-8-0.4222939510e-2*a)*t^2+4*(0.1976033772e-11+0.4480294360e-5*a)*t^3+5*(-0.5819557876e-16-0.1312675972e-9*a)*t^4 = 0.5012764943e-23*(0.762014687e-2*t+a*t^2+(-0.1526025156e-8-0.4222939510e-2*a)*t^3+(0.1976033772e-11+0.4480294360e-5*a)*t^4+(-0.5819557876e-16-0.1312675972e-9*a)*t^5)/(exp(0.1858333303e19*t+0.2438710611e21*a*t^2+0.2438710611e21*(-0.1526025156e-8-0.4222939510e-2*a)*t^3+0.2438710611e21*(0.1976033772e-11+0.4480294360e-5*a)*t^4+0.2438710611e21*(-0.5819557876e-16-0.1312675972e-9*a)*t^5)-1)

(3)

# J(T)(A) is the L2 norm of (lhs-rhs)(res) for a = A

J := T -> A -> evalf(Int(eval((lhs-rhs)(res)^2, a=A), t=0..T, method=_d01ajc)):
 

# Three examples

Optimization:-NLPSolve('J(1)(A)', A=-10..10)

[HFloat(1.44705982152012e-5), [A = HFloat(-0.0057453901961797005)]]

(4)

Optimization:-NLPSolve('J(10)(A)', A=-10..10)

[HFloat(1.40484323209069e-4), [A = HFloat(-6.028295733191413e-4)]]

(5)

Optimization:-NLPSolve('J(0.01)(A)', A=-10..10)

[HFloat(1.45161997993698e-7), [A = HFloat(-0.571541174026821)]]

(6)

# J(T)(A) as a function of A for a given value of T

plot('J(0.01)(A)', A=-10..10):

# Explore  J(T)(A=-5..5) as T changes

PJ := proc(tau)
  plot('J(10^tau)(A)', A=-5..5, axis[2]=[mode=log])
end proc:

Explore(PJ(tau), parameters=[tau=-3.0 .. 1.0]):

# Integration over an arbitrary t-range (not necessary 0..T)

J2 := trange -> A -> evalf(Int(eval((lhs-rhs)(res)^2, a=A), t=trange, method=_d01ajc)):

Optimization:-NLPSolve('J2(1..3)(A)', A=-10..10)

[HFloat(8.74119900428081e-6), [A = HFloat(-0.0017860755658569705)]]

(7)
 

 

Download Aph1_mmcdara.mw


 

restart

with(Optimization):

J := proc (k2, k1) options operator, arrow; b*y-(1-delta*k2-k1)*y*Cv-w*delta*k2*y-Cepr*k2*y-Clm*k1^2-Am*k1*d-Rm*k1*d+R0m*k1^2*d^2-s1*(k0-k1-k2)*y-s2*y*(delta0-delta*k2-k1)-g1*(delta*k2+k1)^2*y^2-4900000*Cex end proc;

proc (k2, k1) options operator, arrow; b*y-(1-delta*k2-k1)*y*Cv-w*delta*k2*y-Cepr*k2*y-Clm*k1^2-Am*k1*d-Rm*k1*d+R0m*k1^2*d^2-s1*(k0-k1-k2)*y-s2*y*(delta0-delta*k2-k1)-g1*(delta*k2+k1)^2*y^2-4900000*Cex end proc

(1)

# No equality constraints
#
# Inequality constraints must be of the form f[i](k1, k2) <= 0
#
# Thus
#
# (1) 0 <= k1 and k1 <= 1 implies k1-1 <= 0 and -k1 <= 0
#     so
      f[1] := (k1, k2) -> k1-1;
      f[2] := (k1, k2) -> -k1;
#
# (2) 0 <= k2 and k2 <= 1 implies k2-1 <= 0 and -k2 <= 0
#     so
      f[3] := (k1, k2) -> k2-1;
      f[4] := (k1, k2) -> -k2;
#
# (3) k1+k2 <= 1/2 implies k1+k2-1/2 <= 0
#     so
      f[5] := (k1, k2) -> k1+k2-1/2;
#
# (4) k2 >= k1 implies k1-k2 <= 0
#     so
      f[6] := (k1, k2) -> k1-k2;

proc (k1, k2) options operator, arrow; k1-1 end proc

 

proc (k1, k2) options operator, arrow; -k1 end proc

 

proc (k1, k2) options operator, arrow; k2-1 end proc

 

proc (k1, k2) options operator, arrow; -k2 end proc

 

proc (k1, k2) options operator, arrow; k1+k2-1/2 end proc

 

proc (k1, k2) options operator, arrow; k1-k2 end proc

(2)

plots:-inequal({seq(f[i](k1, k2) <= 0, i=1..6)}, k1=0..1, k2=0..1);

 

# Lagrangian (we want to maximize J so to minimize -J

L := -J(k2, k1) + add(f[i](k1, k2)*mu[i], i=1..6)

-b*y+(-delta*k2-k1+1)*y*Cv+w*delta*k2*y+Cepr*k2*y+Clm*k1^2+Am*k1*d+Rm*k1*d-R0m*k1^2*d^2+s1*(k0-k1-k2)*y+s2*y*(-delta*k2+delta0-k1)+g1*(delta*k2+k1)^2*y^2+4900000*Cex+(k1-1)*mu[1]-k1*mu[2]+(k2-1)*mu[3]-k2*mu[4]+(k1+k2-1/2)*mu[5]+(k1-k2)*mu[6]

(3)

dLdk1 := collect(diff(L, k1), [k1, k2]);

(-2*R0m*d^2+2*g1*y^2+2*Clm)*k1+2*g1*delta*k2*y^2+Am*d-y*Cv+Rm*d-s1*y-s2*y+mu[1]-mu[2]+mu[5]+mu[6]

(4)

dLdk2 := collect(diff(L, k2), [k1, k2]);

2*delta^2*g1*k2*y^2+2*delta*g1*k1*y^2-Cv*delta*y-delta*s2*y+delta*w*y+Cepr*y-s1*y+mu[3]-mu[4]+mu[5]-mu[6]

(5)

KKT_conditions := [
                    seq(mu[i] >= 0, i=1..6),             # Dual feasibility conditions
                    dLdk1 = 0,                           # Stationarity condition
                    dLdk2 = 0,                           # Stationarity condition
                    seq(``(f[i](k1, k2)) <= 0, i=1..6),  # Primal feasibility conditions
                    add(mu[i]*f[i](k1, k2) = 0, i=1..6)  # Complementary slackness
                  ]:

print~(KKT_conditions):

0 <= mu[1]

 

0 <= mu[2]

 

0 <= mu[3]

 

0 <= mu[4]

 

0 <= mu[5]

 

0 <= mu[6]

 

(-2*R0m*d^2+2*g1*y^2+2*Clm)*k1+2*g1*delta*k2*y^2+Am*d-y*Cv+Rm*d-s1*y-s2*y+mu[1]-mu[2]+mu[5]+mu[6] = 0

 

2*delta^2*g1*k2*y^2+2*delta*g1*k1*y^2-Cv*delta*y-delta*s2*y+delta*w*y+Cepr*y-s1*y+mu[3]-mu[4]+mu[5]-mu[6] = 0

 

``(k1-1) <= 0

 

``(-k1) <= 0

 

``(k2-1) <= 0

 

``(-k2) <= 0

 

``(k1+k2-1/2) <= 0

 

``(k1-k2) <= 0

 

(k1-1)*mu[1]-k1*mu[2]+(k2-1)*mu[3]-k2*mu[4]+(k1+k2-1/2)*mu[5]+(k1-k2)*mu[6] = 0

(6)

# I used the neutral ``(..) notation to kepp the standard horm of KKT relations.
# To get rid of this neutral operator use 'expand':

print~(expand(KKT_conditions)):


 

Download Q_KKT_mmcdara_1.mw

 

restart
N := 3:
S := [T, P]:
mul(mul(cat~(S, `__`, ||i)), i=1..N);

# or
# mul(mul(cat~(S, `_`, ||i)), i=1..N)

result:


mul.mw

If you really want the symbol "*" to appear:
 

restart

with(Physics):

N := 3:
S := [T, P]:

`%*`(seq(`%*`(cat~(S, `_`, ||i)[]), i=1..N))

`%*`(`%*`(`T_ 1`, `P_ 1`), `%*`(`T_ 2`, `P_ 2`), `%*`(`T_ 3`, `P_ 3`))

(1)

 

 

Download mulP.mw

Two stories:

  1. In French universities, Maple homeworks usually go something like this: the teacher gives the students a problem, and they have two options: either stay at the university after class and use Maple on the university's workstations, or go home and write the code in  text format (or in Maple if they've bought a student license). They then deliver their work in mw or txt format.
    After what "someone" corrects the job and tell them the possible error they produced.
    And if the student gets errors he has to correct them before delivering another code.
    A friend of mine who teaches Statistics at Bordeaux University told me that quite often students go on specific forums to ask for users to help them fix their code instead of trying to do that b themselves.
  2. It happens this "someone" it is a thesis student which does the correcting job to earn a few money. This same friend of mine told me about the case of one of his student who asked on a forum to fix issues on R homework codes that it was intended to correct himself but was too lazzy to do so.

Are you one ofthese two kinds of guys : the student waiting for a "une bonne poire" (I allow myself this french term you surely understand... for others I found "sucker" or "soft touch" using slang translators) to correct his paper, or the lazzy teacher assistant ?
I'm pretty sure the fact you stubbornly refuse for years to upload any Maple worksheet has something to do with that.

Finally, concerning your question, is this what you want?

 

If it is so, here are some hints for correction

  • First of all start by cleaning up your code (twice the same in a row).
     
  • Make a choice: either you want to use the geometry package, either you don't.
     
  • You wrie a procedure named distance but distance is also a function of the geometry do if you chosed to use geometry do not write a procedure named distance.
     
  • You are mixing notations several times: for instance circle(I1, r1) is the  plottools definition of a circle, not a geometry definition.
     
  • geometry has functions incircle to find the incircle of a given triangle and excircle to find the find three excircles of a given triangle: why don't simply use them (all the more that your procedure plot_exscribed_circles builds wrong excircles).
     
  • For ratio (R) = 1 your "Apollonius hyperbola" is a straight line whatever A and B:
    f := (x, y) -> sqrt((x - A[1])^2 + (y - A[2])^2)/sqrt((x - B[1])^2 + (y - B[2])^2) - 1:
    collect~(isolate(f(x, y)=0, y), x)
    
                                        2       2       2       2
             (2 A[1] - 2 B[1]) x   -A[1]  - A[2]  + B[1]  + B[2] 
       y = - ------------------- - ------------------------------
               2 (A[2] - B[2])            2 (A[2] - B[2])        
    

    For any other positive value of R it is a circle:

    f0 := sqrt((x - A[1])^2 + (y - A[2])^2)/sqrt((x - B[1])^2 + (y - B[2])^2) = R;
                                    (1/2)          
                           / 2    2\               
                           \x  + y /               
                     -------------------------- = R
                                          (1/2)    
                     /       2          2\         
                     \(x - 4)  + (y - 2) /         
    
    f0 *~ denom(lhs(f0)): 
    %^~2: 
    (lhs-rhs)(%): 
    tx := add(select(has, [op(expand( %))], x)):
    ty := add(select(has, [op(expand(%%))], y)): 
    sx := Student:-Precalculus:-CompleteSquare(tx, x):
    sy := Student:-Precalculus:-CompleteSquare(ty, y): 
    
    add(map(s -> s/(-R^2+1), [op(sx+sy)])): 
    f1 := map(add, (select=-remove)(has, [op(%)], {x, y}))
    
                           2                2             
              /        2  \    /        2  \          4   
              |     4 R   |    |     2 R   |      20 R    
              |x + -------|  + |y + -------|  = ----------
              |      2    |    |      2    |             2
              \    -R  + 1/    \    -R  + 1/    /  2    \ 
                                                \-R  + 1/ 
    

Example of what you could/should do:
(and I consider I'm already "une bonne poire" doing this) here is way (not the simplest one!) to draw the incircle of triangle ABC

plot_inscribed_circle := proc(__A, __B, __C)
  local A, B, C, T, Ii:
  point(A, op(__A)):
  point(B, op(__B)):
  point(C, op(__C)):
  triangle(T, [A, B, C]);
  incircle(Ii, T,'centername'=o);
  draw(Ii, style = line, color = green, thickness = 2)
end proc:

plot_inscribed_circle(A, B, C)

Now it's up to you to do some effort... or not.

Stop sending us a mess of c... like you just did and telling us "hey guys, deal with this".
Have a little respect for people whose passion is helping others.

If any moderator thinks I've crossed a red line by writing this reply, may it feel free to delete it. 


Do not write 

# Equation of the line passing through A and B
    lineAB := sort(Equation(line(k, [A, B], [x, y])));

but

# Equation of the line passing through A and B
    line(k, [A, B], [x, y]):
    lineAB := Equation(k);

instead (do not embed the definition of the line within Equation)

Tou will stiill get an error for item=[1, 6, 12] because points A and B are confounded (so line k is not defined).

item;
detail(A);
                           [1, 6, 12]
           GeometryDetail(["name of the object", A], 

             ["form of the object", point2d], 

             ["coordinates of the point", [-2, -8]])

 detail(B);
           GeometryDetail(["name of the object", B], 

             ["form of the object", point2d], 

             ["coordinates of the point", [-2, -8]])

It is up to you to fix this problem

Here is an idea to avoid the error when line k is undefined 
 

 

 

restart

with(geometry):

# List of functions

mylist := [[-1, 9, -15], [1, -6, -15], [1, -6, 9], [1, 6, 12], [-2, 3, 12],

           [2, -9, 12], [-1, -6, -9], [-1, -9, -15], [1, 6, -15], [-2, 9, -12],

           [1, 3, 3], [-1, 6, -9], [3, -4, 2], [-5, 5, -2], [-3, -5, -4],

           [-2, 1, -3], [-5, -4, -2], [5, 5, 4], [-1, -2, -2], [-3, 1, -5]]:

 

# Function to generate LaTeX output

toX := s -> latex(s, output = string):

 

s := "":

 

for item in mylist do

    a := item[1];

    b := item[2];

    c := item[3];

    

    # The function and its derivative

    f := x -> a*x^3 + b*x^2 + c*x;

    sol := solve(diff(f(x), x) = 0, x);

    x1 := sol[1];

    x2 := sol[2];

    

    # Defining points and calculating distance

    point(o, 0, 0);

    point(A, x1, f(x1));

    point(B, x2, f(x2));

    try

      AB := simplify(distance(A, B));

    

      # Equation of the line passing through A and B
      line(k, [A, B], [x, y]):

      lineAB := Equation(k);

      # Distance from origin to the line and circle equation

      myr := distance(o, k);

      circle_eq := x^2 + y^2 = myr^2;

    

      # Generating LaTeX output

      s := cat(s, "\\begin{ex}\n",

               "  Given the function $y = ", toX(f(x)), "$.\n",

               "  \\begin{enumerate}[label=\\alph*)]\n",

               "    \\item The derivative of the function is $y'=", toX(diff(f(x), x)), "$.\n",

               "    \\item The maximum point of the function's graph is \n",

               "    \\item The equation of the line passing through the two extremum points of the graph is $", toX(lineAB), "$.\n",

               "    \\item The distance between the two extremum points $A$ and $B$ is $", toX(AB), "$.\n",

               "    \\item The equation of the circle with center at the origin and tangent to the line passing through the two extremum           points is $", toX(circle_eq), "$.\n",

               "  \\end{enumerate}\n",

               "\\end{ex}\n\n");
    catch:
      printf("\nline is undefined for item=%a   distance(A, B) = %a\n", item, AB):
      print(detail(A));
      print():
      print(detail(B));
    end try;

end do:

 

# Output the result


line is undefined for item=[1, 6, 12]   distance(A, B) = 0

 

"[["name of the object",A],["form of the object",point2d],["coordinates of the point",[-2,-8]]]"

 

NULL

 

"[["name of the object",B],["form of the object",point2d],["coordinates of the point",[-2,-8]]]"

 


line is undefined for item=[1, 3, 3]   distance(A, B) = 0

 

"[["name of the object",A],["form of the object",point2d],["coordinates of the point",[-1,-1]]]"

 

NULL

 

GeometryDetail(["name of the object", B], ["form of the object", point2d], ["coordinates of the point", [-1, -1]])

(1.1)

printf("%s", s);


 

Download Corrections_mmcdara.mw



Nevertheless this is a step-by-step Maple code which mimics what you would do by hand (note the result is exact and no complex expression ever occur... which is a necessary condition for the result to be found by hand). My first version: Another_way.mw

The version above uses solve, this new one is even simpler as it doesn't:
 

restart:

AB := 6:
BD := 4:

# Within triangle BCD

sin(theta)/BD = sin(3*theta)/DC ;
isolate(%, DC);
expand(%);

(1/4)*sin(theta) = sin(3*theta)/DC

 

DC = 4*sin(3*theta)/sin(theta)

 

DC = 16*cos(theta)^2-4

(1)

# Within triangle ABC

sin(2*theta)/BC = sin(theta)/AB;
isolate(%, BC);
expand(%);

sin(2*theta)/BC = (1/6)*sin(theta)

 

BC = 6*sin(2*theta)/sin(theta)

 

BC = 12*cos(theta)

(2)

Angle(BDA) = Pi-4*theta;

Angle(BDA) = Pi-4*theta

(3)

sin(Angle(BDA))/BC = sin(theta)/4:
eval(%, (3)):
isolate(%, BC);

BC = 4*sin(4*theta)/sin(theta)

(4)

simplify(eval((4) , (2)));
factor((rhs-lhs)(%)) = 0;
op(-1, lhs(%)) = 0;

eval(%, isolate((1), cos(theta)^2));

isolate(%, DC);

12*cos(theta) = 16*cos(theta)*(2*cos(theta)^2-1)

 

4*cos(theta)*(8*cos(theta)^2-7) = 0

 

8*cos(theta)^2-7 = 0

 

(1/2)*DC-5 = 0

 

DC = 10

(5)

 


Download Another_way_variant.mw


A first code:  P is made of 15 lists, S is the sum of the elements of each list:

L := [a, b, c, d]:
P := combinat:-choose(L):
P := subsop(1=NULL, P):
S := map(add, P):
print~(S):

                               a
                               b
                             a + b
                               c
                             a + c
                             b + c
                           a + b + c
                               d
                             a + d
                             b + d
                           a + b + d
                             c + d
                           a + c + d
                           b + c + d
                         a + b + c + d


Permuting all the lists in P gives a new collection PP of lists. But adding the elements of permuted lists always give the same result.
For instance add([a, b]) = a+b  and  add([b, a]) = a+b.
If you want the addition of the elements in [b, a] gives b+a you must cheat, for instance:

PP := map(op@combinat:-permute, P):

f := proc(p):
  if numelems(p) = 1 then
    cat(`#mo("`, p[1], `")`)
  else
    cat(`#mrow(`, seq( cat(`mo("`, op(i, p), `"),mo("&#x2b;"),`), i=1..numelems(p)-1 ), `mo("`, op(-1, p), `"))`)
  end if:
end proc:

# example (partial result)

PP[1..4];
print~(f~(PP[1..4])):
                   [[a], [b], [a, b], [b, a]]



All results here  permutations.mw
 

@JAMET 

There are 3 types of conics depending on the sign of the determant of matrix Q:

Q := < <A | B>, <B | C>>

# for a quadratic form written  A*x^2 + 2*B*x*y + C*y^2 + ...

In each type there exist several "degenerated" situations (for instance a parabola can reduce to two parallel straight lines, or an ellipse to  a single point).
Generally the classic rotation+translation transformation applies if ysed with precaution..

These special cases (cf Bibmath et Wiki for more details about special cases) make delicate the writting of a code aimed to build the reduced form in all situations.



For your conic:

(
This code Gender_and_Signature.mw determines the type and the signature of your quadratic form:

  • Determinant       ==> type = parabola,
  • Signature=(2, 1)  ==> sub type = parabola non degenerated parabola)

)

 


Reduced form and siplays for your conic
 

restart:

with(plots):
alias(PT=plottools):

f := (x, y) -> 9*x^2 - 24*y*x + 16*y^2 + 10*x - 70*y + 175;

proc (x, y) options operator, arrow; 9*x^2-24*y*x+16*y^2+10*x-70*y+175 end proc

(1)

xy := Vector(2, [x, y]):
XY := Vector(2, [X, Y]):
r  := theta -> Matrix(2$2, [cos(theta), -sin(theta), sin(theta), cos(theta)]):

rot := [entries(xy =~ r(theta) . XY, nolist)]

[x = cos(theta)*X-sin(theta)*Y, y = sin(theta)*X+cos(theta)*Y]

(2)

g := unapply(expand(f(op(rhs~(rot)))), (X, Y))

proc (X, Y) options operator, arrow; 9*cos(theta)^2*X^2+14*cos(theta)*X*sin(theta)*Y+9*sin(theta)^2*Y^2-24*sin(theta)*X^2*cos(theta)+24*sin(theta)^2*X*Y-24*cos(theta)^2*Y*X+24*cos(theta)*Y^2*sin(theta)+16*sin(theta)^2*X^2+16*cos(theta)^2*Y^2+10*cos(theta)*X-10*sin(theta)*Y-70*sin(theta)*X-70*cos(theta)*Y+175 end proc

(3)

c := coeffs(g(X, Y), [X, Y], 'mon'):
z := c[ListTools:-Search(X*Y, [mon])]

14*cos(theta)*sin(theta)+24*sin(theta)^2-24*cos(theta)^2

(4)

solve(z, theta);
Theta := %[1];

-arctan(4/3)+Pi, arctan(3/4), -arctan(4/3), arctan(3/4)-Pi

 

-arctan(4/3)+Pi

(5)

R := r(Theta);

ROT := [entries(xy =~ r(Theta) . XY, nolist)]

R := Matrix(2, 2, {(1, 1) = -3/5, (1, 2) = -4/5, (2, 1) = 4/5, (2, 2) = -3/5})

 

[x = -(3/5)*X-(4/5)*Y, y = (4/5)*X-(3/5)*Y]

(6)

G0 := eval(g(X, Y), theta=Theta)

25*X^2-62*X+34*Y+175

(7)

if has(G0, X^2) then
  G1       := Student:-Precalculus:-CompleteSquare(G0, X);
  delta__X := op([2, 1, 2], op(1, G1));
  st       := solve(identity(s*(Y+t)=G1-op(1, G1), Y), [s, t])[];
  delta__Y := eval(t, st);
  `Reduced Form` := eval(G1, {X=U-delta__X, Y=V-delta__Y});

elif has(G0, Y^2) then
  G1       := Student:-Precalculus:-CompleteSquare(G0, Y);
  delta__Y := op([2, 1, 2], op(1, G1));
  st       := solve(identity(s*(X+t)=G1-op(1, G1), X), [s, t])[];
  delta__X := eval(t, st);
  `Reduced Form` := eval(G1, {X=U-delta__X, Y=V-delta__Y});
end if;

25*(X-31/25)^2+34*Y+3414/25

 

-31/25

 

[s = 34, t = 1707/425]

 

1707/425

 

25*U^2+34*V

(8)

pf  := implicitplot(
         f(x, y)
         , x=-12..12, y=-12..12
         , grid=[60$2]
         , color=blue
         , legend=typeset(f)
       ):

pUV := implicitplot(
         `Reduced Form`
         , U=-10..10, V=-10..10
         , grid=[60$2]
         , color=red
         , style=point, symbol=circle
         , legend=typeset(`Reduced Form`=0)
       ):

A1 := display(PT:-arrow([0, 0], [0, -10], .2, .4, .1, color=green)):
A2 := display(PT:-arrow([0, 0], [10, 0], .2, .4, .1, color=green)):

pU := textplot([0, -10, U], font=[Helvetica, 10], align=right):
pV := textplot([10,  0, V], font=[Helvetica, 10], align=above):

display(
  pf
  , PT:-rotate(PT:-translate(pUV, -delta__X, -delta__Y), Theta)

  , PT:-rotate(PT:-translate(A1,  -delta__X, -delta__Y), Theta)
  , PT:-rotate(PT:-translate(A2,  -delta__X, -delta__Y), Theta)

  , PT:-rotate(PT:-translate(pU,  -delta__X, -delta__Y), Theta)
  , PT:-rotate(PT:-translate(pV,  -delta__X, -delta__Y), Theta)

  , view=[-5..12, 0..12]
  , scaling=constrained
)

 

 

 

Download Reduced_Parabola_2.mw



Ice on the cake

This code returns the type and subtype of a quadratic form (Note: I'm not sure about these designations; maybe one should use "class" instead and dropt types and subtypes ?)
 

restart:

ConicType := proc(f)
  local ind, IND, F, r, M, lambda,Determinant, Signature, T, TT:


  ind := [indets(f, name)[]];
  if numelems(ind)=2 then
    F := eval(f, ind=~[X, Y]);
  else
    F := eval(f, ind=~[X]);
  end if;

  IND := [X, Y, X2, XY, Y2];
  F   := subs(X^2=X2, X*Y=XY, Y^2=Y2, F):
  r   := [1=eval(F, IND=~0), seq(IND[i]=coeff(F, IND[i]), i=1..5)];
  M   := eval( Matrix(3$2, [X2, XY/2, X/2, XY/2, Y2, Y/2, X/2, Y/2, 1]), r);

  Determinant := LinearAlgebra:-Determinant(M[1..2, 1..2]):
  lambda      := convert(Re~(evalf(LinearAlgebra:-Eigenvalues(M))), list):
  Signature   := [
                   numelems(select(`>`, lambda, 0)),
                   numelems(select(`<`, lambda, 0))
                 ];

  if Determinant < 0 then
    T := "type: Hyperbola":
    if Signature in  {[2, 1], [1, 2]} then
      TT := "subtype: Hyperbola":
    elif Signature = [1, 1] then
      TT := "subtype: two secant straight lines":
    end if:
  elif Determinant = 0 then
    T := "type: Parabola":
    if Signature in  {[2, 1], [1, 2]} then
      TT := "subtype: Parabola":
    elif Signature in {[2, 0], [0, 2]} then
      TT := "subtype: not a real conic":
    elif Signature = [1, 1] then
      TT := "subtype: two parallel straight lines":
    elif Signature in {[1, 0], [0, 1]} then
      TT := "subtype: a single straight line":
    end if:

  elif Determinant > 0 then
    T := "type: Ellipse":
    if Signature in {[3, 0], [0, 3]} then
      TT := "subtype: not a real conic":
    elif Signature in  {[2, 1], [1, 2]} then
      TT := "subtype: Ellipse":
    elif Signature in {[2, 0], [0, 2]}  then
      TT := "subtype: a single point":
    end if:
  end if:


  ['Determinant' = Determinant, 'Signature' = Signature, T, TT]
end proc:

randomize();

172633099638661

(1)

f := randpoly([u, v], degree = 2, coeffs=rand(-1..1));
plots:-implicitplot(f, u=-10..10, v=-10..10, grid=[100$2], color=blue, thickness=3);
ConicType(f)

-u^2+u

 

 

[Determinant = 0, Signature = [1, 1], "type: Parabola", "subtype: two parallel straight lines"]

(2)

 

 


 

Download Conic_Classification.mw

 


UPDATED 09/14/2024

This is typically a problem which is not well posed as it enables an infinity of solutions.

To make you understand this let's take this mechanical analogy

You are in 1D. A rod is made of two rods of same length L, the lewt one weights 10 kg, the right one 1kg.
The left extremity of the left rod is at position x=1 (so the system extends from x=1 to x=2).
Compute the position of the center of mass (the mean in Statistics) ?
Would you say: that it is (10*L/2 +1*(L+L/2)) / 11 = 13*L/2
if so you would be wrong: you missed a fundamental assumtion about the density of the mass distribution in each rod. 
The answer 13*L/2 is correct iif you assume the density is constant in each bar.

Relation with your problem.
If the probability density function (coninuous case) or the probability mass function (discrete case) is constant over each interval, then you can resume each interval by its "center of mass" anf rewrite your problem in termes of "weighted data": 

 

So your problem has an infinity of answers unless you correctly formulate assumptions on what happens within each class, or on the distribution of the underlying population those classes are built from.


More importantly
: I hope the question you pose is a simple amusement because in real data analysis you never compute statistics from data organized in classes.
You compute them from the raw data that you can organized further on as classes... if you want.
Computing statistics on classes and numbers implies loss of information and ambiguity.
This loss of information prevents from calculating statistics for class-based data.


Nevertheless here is my contribution to your problem stat2.mw.

I UPDATED this reply by adding file BOUNDS.mw which provides bounds for the mean, variance and quartiles when no assumption are made on the distribution of the data or when you do not know them:that's the only objective answer an honorable person should give you.
Whatever tthose assumptions might be your are assured that those bounds are these ones:

_____________________________________________________________________________________

Auxilliary point concerning your MMA results:

At the evidence the person who answered your question reduced you problem to a problem of assessing statistics on weighted data (which is wrong).

For your information, is one of the World reference code in statistics; its Weighted.Desc.Stat package is aimed to compute statistics for weighted data. 
Considering data consist in the vector x centers of classes  (which corresponds to the homogenous mass density distribution in the mechanical analogy) and in vector mu of weights, on gets these estimators when x is the vector of the centers of classes:.

> x <- c(1.25, 3.75, 6.25, 8.75)
> mu <- c(18, 11, 13, 6)
> w.mean(x, mu)
[1] 4.114583
> w.var(x, mu)
[1] 7.028537
> w.sd(x, mu)
[1] 2.651139
> 

Note thatthe variance here differs from MMA's (=7.549370660)


The formula Weighted.Desc.Stat uses to assess this variance, and why it uses it, are reproduced below.


(1)  Replace all occurrence of 

myfac[i]

by

myfac(i)


(2)  Replace all occurrence sum by add.
    
 (look to the terms addition and sum in the help pages, Page types=Dictionary)

sum_vs_add.mw


Orignal reply deleted by the author.

Revised version: Updated.mw

 


From the reference you give:

 

restart

a := 1;

h := 1;

# pA := [0, 0, 0]; # useless

pB := [a, 0, 0];

pC := [a, a, 0];

pD := [0, a, 0];

pS := [0, 0, h];

1

 

1

 

[1, 0, 0]

 

[1, 1, 0]

 

[0, 1, 0]

 

[0, 0, 1]

(1)

local D:
symbols := [B, C, D, S]:

use geom3d in
  seq(point(s, p||s), s in symbols);
  plane(SBC, [S, B, C]);
  plane(SCD, [S, C, D]);
  sbc    := < NormalVector(SBC) >;
  scd    := < NormalVector(SCD) >;

  # from the reference you give :
  # "the dihedral angle, φ... satisfies 0 ≤ φ ≤ π/2"
  # So 2*π/3 and 3*π/4 cannot be solutions as you say.
  
  cosphi := abs(Statistics:-Correlation(sbc, scd));
end use:

phi := identify(arccos(cosphi))

(1/3)*Pi

(2)

 


 

Download Dihedral_Angle.mw


As you've already noticed, there's nothing immediate..
The trick to derive equations 9, 11 and 13 is to multiply both sides of equation 7 by G' and integrate wrt eta (without without forgetting the "constant" K)

(Done with Maple 2015)
 

restart

eq_7 := diff(G(eta), eta$2) + sigma*G(eta) = nu

diff(diff(G(eta), eta), eta)+sigma*G(eta) = nu

(1)

 

sigma < 0

 

negsol := rhs( ( dsolve(eq_7) assuming sigma < 0) ):
negsol := expand(convert(negsol, trig)):


CS      := [C, S]:
replace := convert(indets(negsol, function), list) =~ CS:
negsol  := collect(eval(negsol, replace), CS):
B1B2    := solve({coeff(negsol, C)=B1, coeff(negsol, S)=B2}, [_C1, _C2]):

eq_8 := eval(eval(negsol, %[]), (rhs=lhs)~(replace));

B1*cosh((-sigma)^(1/2)*eta)+B2*sinh((-sigma)^(1/2)*eta)+nu/sigma

(2)

use IntegrationTools in

  # multiply both member of eq_7 by G'

  expand~(eq_7*~diff(G(eta), eta));
 
  # Integrate over eta

  map((Expand@Int), %, eta);
 
  # evaluate

  value~(%);
 
  # divide each term by G^2 (assuming G <> 0)

  expand(% /~ G(eta)^2);
 
  # isolate (G'/G)^2

  ref := isolate(%, (diff(G(eta), eta) / G(eta))^2);
 
  # add an integration "constant"

  ref := lhs(ref) = rhs(ref) + __K;
 
  # plug in ref the expression of G(eta) given by eq_8

  aux := eval(ref, G = (eta -> eq_8));

  # solve for __K

  K := simplify(solve(aux, __K));

  # Identify the denominator of K

  den := simplify(denom(K), {eq_8=G(eta)});

  # Rewrite K according to theprevious result

  K := numer(K)/den;

  # Finally

  eq_9 := eval(ref, __K=K);

end use:

eq_9;

(diff(G(eta), eta))^2/G(eta)^2 = 2*nu/G(eta)-sigma+(B1^2*sigma^2-B2^2*sigma^2-nu^2)/(sigma*G(eta)^2)

(3)

 

sigma > 0

 

eq_10 := eval( rhs( ( dsolve(eq_7) assuming sigma > 0) ), [_C1=B1, _C2=B2])

sin(sigma^(1/2)*eta)*B2+cos(sigma^(1/2)*eta)*B1+nu/sigma

(4)

use IntegrationTools in
 
  # plug in ref the expression of G(eta) given by eq_8

  aux := eval(ref, G = (eta -> eq_10));

  # solve for __K

  K := simplify(solve(aux, __K), size):
  K := simplify(numer(K))/denom(K);

  # Identify the denominator of K

  den := simplify(denom(K), {eq_10=G(eta)});

  # Rewrite K according to theprevious result

  K := numer(K)/den;

  # Finally

  eq_11 := eval(ref, __K=K);

end use:

eq_11

(diff(G(eta), eta))^2/G(eta)^2 = 2*nu/G(eta)-sigma+(B1^2*sigma^2+B2^2*sigma^2-nu^2)/(sigma*G(eta)^2)

(5)

 

sigma = 0

 

zerosol := dsolve(eval(eq_7, sigma = 0)):
eq_12   := rhs(eval(zerosol, {_C1=B1, _C2=B2}));

(1/2)*nu*eta^2+B1*eta+B2

(6)

use IntegrationTools in

  # multiply both member of eq_7 by G'

  expand~(eval(eq_7, sigma=0)*~diff(G(eta), eta));
 
  # Integrate over eta

  map((Expand@Int), %, eta);
 
  # evaluate

  value~(%);
 
  # divide each term by G^2 (assuming G <> 0)

  expand(% /~ G(eta)^2);
 
  # isolate (G'/G)^2

  ref := isolate(%, (diff(G(eta), eta) / G(eta))^2);
 
  # add an integration "constant"

  ref := lhs(ref) = rhs(ref) + __K;
 
  # plug in ref the expression of G(eta) given by eq_8

  aux := eval(ref, G = (eta -> eq_12));

  # solve for __K

  K := simplify(solve(aux, __K), size):
  K := simplify(numer(K))/denom(K);

  # Identify the denominator of K

  den := simplify(denom(K), {eq_12=G(eta)});

  # Rewrite K according to theprevious result

  K := simplify(numer(K)/den);

  # Finally

  eq_13 := eval(ref, __K=K);

end use:

eq_13

(diff(G(eta), eta))^2/G(eta)^2 = 2*nu/G(eta)+(B1^2-2*B2*nu)/G(eta)^2

(7)

 


 

Download This_way.mw

1 2 3 4 5 6 7 Last Page 1 of 57