Carl Love

Carl Love

28055 Reputation

25 Badges

12 years, 356 days
Himself
Wayland, Massachusetts, United States
My name was formerly Carl Devore.

MaplePrimes Activity


These are answers submitted by Carl Love

The midpoint method is not implemented in dsolve(..., numeric, method= classical[...]), so you'll have to write your own. Here's my ad hoc version---tailored to this specific problem. As you can see, the error plot is a straight (in log-log mode) line with a slope of nearly exactly 2.

 

restart:

Digits:= 15:

f:= (t,y)-> I*y:

Exact:= unapply(rhs(dsolve({diff(y(t),t) = f(t,y(t)), y(0)= -I})), t);

proc (t) options operator, arrow; -I*exp(I*t) end proc

(1)

Mid:= proc(h::{positive, realcons})
local
     y0:= -I,
     t,
     y1:= evalf(y0+h/2*(f(0,y0)+f(h, y0+h*f(0,y0)))), #one step of Heun
     y2
;
     []; #Force evalhf failure.
     for t from h by h to 1 do
          y2:= y0 + 2*h*f(t,y1);
          y0:= y1;
          y1:= y2
     end do;
     #Return the error
     evalf(abs(Exact(1)-y0))
end proc:
          

plot([seq([10^k, Mid(10^k)], k= -5..-1)], axis= [mode= log], labels= [h, `error`]);

 

 

Download Midpoint_error.mw

You need to change cos(kz - `ωt`) to cos(k*z - omega*t). I ran the code, and everything works if you correct this expression in the three places that it occurs.

I am not sure what you mean by "the scale of plot". Do you want a logarithmic scale? Do you want to extend the range on the y-axes so that both plots have the same y-axis?

Your "final result" has three terms with dimensions of force and one term with dimensions of force/temperature. Was there an integral in your code that you expected would cancel the temperature, which is your variables alfa1 and alfa2? If so, I couldn't find it.

Kitonum wrote:

But you wrote that your method does not directly prove the uniqueness of the solutions found. And how much time require such proof?

Unique means one solution. So I would not use the word unique in this situation. We seek to prove that the two stated solutions are the complete set of solutions. When a solution is unique, my program will indeed prove it unique. (It is not absolutely guaranteed that it will always be able to complete such a proof; however, I've never seen a case with a unique solution where it failed to complete the proof.) So, to prove that the multiple solutions are the complete solution set, we add constraints so that we get proven unique solutions. If we add a complete (covers all logical possibilities) and mutally exclusive set of constraints (only one at a time, of course), and each addition produces (provably) 0 or 1 solutions, then we have all the solutions.

The additional time for my program to do the proof is about 0.02 seconds. Here it is:


restart:

read "C:/Users/Carl/desktop/logic_problems.mpl":

 

Statement of the logic problem:

Who Lives in the City?

 

lifted from

http://www.mathsisfun.com/puzzles/who-lives-in-the-city--solution.html

 

Five people are standing in a queue for plane tickets in Germany; each one has a name, an age, a favorite TV program, where they live, a hairstyle and a destination.

 

Names: Bob, Keeley, Rachael, Eilish, and Amy

TV programs: The Simpsons, Coronation Street ("Corrie"), Eastenders, Desperate Housewives, and Neighbours.

 Destinations: France, Australia, England, Africa, and Italy

 Ages: 14, 21, 46, 52, and 81

 Hairstyle: Afro, long, straight, curly, and bald

 Where they live: A town, a city, a village, a farm, and a youth hostel

 

1. The person in the middle watches Desperate Housewives.

 2. Bob is the first in the queue.

 3. The person who watches the Simpsons is next to the person who lives in a youth hostel.

 4. The person going to Africa is behind Rachael.

 5. The person who lives in a village is 52.

 6. The person who is going to Australia has straight hair.

 7. The person travelling to Africa watches Desperate Housewives.

 8. The 14-year-old is at the end of the queue.

 9. Amy watches Eastenders.

 10. The person heading to Italy has long hair.

 11. Keeley lives in a village.

 12. The 46-year-old is bald.

 13. The fourth in the queue is going to England.

 14. The people who watch Desperate Housewives and Neighbours are standing next to each other.

 15. The person who watches Coronation Street stands next to the person with an afro.

 16. A person next to Rachael has an afro.

 17. The 21-year-old lives in a youth hostel.

 18. The person who watches Corrie has long hair.

 19. The 81-year-old lives on a farm.

 20. The person who is travelling to France lives in a town.

 21. Eilish is not next to the person with straight hair.

gc():  st:= time():

Vars:= [PN, Name, TV, Dest, Ages, Hair, Lives]:

PN:= [$1..5]:

Name:= [Bob, Keeley, Rachael, Eilish, Amy]:

TV:= [Simpsons, Coronation, Eastenders, Desperate, Neighbours]:

Dest:= [Fra, Aus, Eng, Afr, Ita]:

Ages:= [14, 21, 46, 52, 81]:

Hair:= [afro, long, straight, curly , bald]:

Lives:= [town, city, village, farm, youth]:

Con1:= Desperate=3:

Con2:= Bob=1:

Con3:= NextTo(Simpsons,youth,PN):

Con4:= Succ(Afr,Rachael,PN):

Con5:= village=52:

Con6:= Aus=straight:

Con7:= Afr=Desperate:
Con8:= 14=5:

Con9:= Amy=Eastenders:

Con10:= Ita=long:

Con11:= Keeley=village:

Con12:= bald=46:

Con13:= Eng=4:

Con14:= NextTo(Desperate,Neighbours,PN):

Con15:= NextTo(Coronation,afro,PN):

Con16:= NextTo(Rachael,afro,PN):

Con17:= 21=youth:

Con18:= Coronation=long:

Con19:= 81=farm:

Con20:= Fra=town:

 

City:= LogicProblem(Vars):

with(City);

Con21:= Rel(Separated, Eilish, straight, PN, [1]):

Satisfy([Con||(1..21)]);

T1:= (time()-st)*seconds;

Warning, City is not a correctly formed package - option `package' is missing

"[[Typesetting:-mi("&!!",italic = "true",mathvariant = "italic"), Typesetting:-mi("&-",italic = "true",mathvariant = "italic"), Typesetting:-mi("&<",italic = "true",mathvariant = "italic"), Typesetting:-mi("&>",italic = "true",mathvariant = "italic"), Typesetting:-mi("&?",italic = "true",mathvariant = "italic"), Typesetting:-mi("&G",italic = "true",mathvariant = "italic"), Typesetting:-mi("&Soln",italic = "true",mathvariant = "italic"), Typesetting:-mi("AutoGuess",italic = "true",mathvariant = "italic"), Typesetting:-mi("CPV",italic = "true",mathvariant = "italic"), Typesetting:-mi("CollectStats",italic = "true",mathvariant = "italic"), Typesetting:-mi("ConstNum",italic = "true",mathvariant = "italic"), Typesetting:-mi("Consts",italic = "true",mathvariant = "italic"), Typesetting:-mi("ConstsInV",italic = "true",mathvariant = "italic"), Typesetting:-mi("DifferentBlock",italic = "true",mathvariant = "italic"), Typesetting:-mi("Equation",italic = "true",mathvariant = "italic"), Typesetting:-mi("FreeGuess",italic = "true",mathvariant = "italic"), Typesetting:-mi("GoBack",italic = "true",mathvariant = "italic"), Typesetting:-mi("Guess",italic = "true",mathvariant = "italic"), Typesetting:-mi("InternalRep",italic = "true",mathvariant = "italic"), Typesetting:-mi("IsComplete",italic = "true",mathvariant = "italic"), Typesetting:-mi("IsUnique",italic = "true",mathvariant = "italic"), Typesetting:-mi("NC",italic = "true",mathvariant = "italic"), Typesetting:-mi("NV",italic = "true",mathvariant = "italic"), Typesetting:-mi("PrintConst",italic = "true",mathvariant = "italic"), Typesetting:-mi("Quiet",italic = "true",mathvariant = "italic"), Typesetting:-mi("Reinitialize",italic = "true",mathvariant = "italic"), Typesetting:-mi("SameBlock",italic = "true",mathvariant = "italic"), Typesetting:-mi("Satisfy",italic = "true",mathvariant = "italic"), Typesetting:-mi("Separated",italic = "true",mathvariant = "italic"), Typesetting:-mi("UniquenessProof",italic = "true",mathvariant = "italic"), Typesetting:-mi("VarNum",italic = "true",mathvariant = "italic"), Typesetting:-mi("VarNumC",italic = "true",mathvariant = "italic"), Typesetting:-mi("X_O",italic = "true",mathvariant = "italic")]]"

NULL

`Multiple solutions.  Two of the possibilities:`

Matrix(5, 7, {(1, 1) = 1, (1, 2) = Bob, (1, 3) = Simpsons, (1, 4) = Aus, (1, 5) = 81, (1, 6) = straight, (1, 7) = farm, (2, 1) = 2, (2, 2) = Rachael, (2, 3) = Coronation, (2, 4) = Ita, (2, 5) = 21, (2, 6) = long, (2, 7) = youth, (3, 1) = 3, (3, 2) = Keeley, (3, 3) = Desperate, (3, 4) = Afr, (3, 5) = 52, (3, 6) = afro, (3, 7) = village, (4, 1) = 4, (4, 2) = Eilish, (4, 3) = Neighbours, (4, 4) = Eng, (4, 5) = 46, (4, 6) = bald, (4, 7) = city, (5, 1) = 5, (5, 2) = Amy, (5, 3) = Eastenders, (5, 4) = Fra, (5, 5) = 14, (5, 6) = curly, (5, 7) = town}), Matrix(5, 7, {(1, 1) = 1, (1, 2) = Bob, (1, 3) = Simpsons, (1, 4) = Fra, (1, 5) = 46, (1, 6) = bald, (1, 7) = town, (2, 1) = 2, (2, 2) = Rachael, (2, 3) = Coronation, (2, 4) = Ita, (2, 5) = 21, (2, 6) = long, (2, 7) = youth, (3, 1) = 3, (3, 2) = Eilish, (3, 3) = Desperate, (3, 4) = Afr, (3, 5) = 81, (3, 6) = afro, (3, 7) = farm, (4, 1) = 4, (4, 2) = Keeley, (4, 3) = Neighbours, (4, 4) = Eng, (4, 5) = 52, (4, 6) = curly, (4, 7) = village, (5, 1) = 5, (5, 2) = Amy, (5, 3) = Eastenders, (5, 4) = Aus, (5, 5) = 14, (5, 6) = straight, (5, 7) = city})

.109*seconds

Proving that those are the only two solutions requires a bit of ingenuity. We need to add constraints to get unique solutions. If what we add covers all the possibilities, then we're done. Here I chose a simple constraint that distinguishes the two solutons. The we'll try with the negation of that constraint.

 

Satisfy([4=46]);

Reinitialize():
Satisfy([Con||(1..21), 4<>46]);

T2:= (time()-st)*seconds;

NULL

`Unique solution:`

Matrix(5, 7, {(1, 1) = 1, (1, 2) = Bob, (1, 3) = Simpsons, (1, 4) = Aus, (1, 5) = 81, (1, 6) = straight, (1, 7) = farm, (2, 1) = 2, (2, 2) = Rachael, (2, 3) = Coronation, (2, 4) = Ita, (2, 5) = 21, (2, 6) = long, (2, 7) = youth, (3, 1) = 3, (3, 2) = Keeley, (3, 3) = Desperate, (3, 4) = Afr, (3, 5) = 52, (3, 6) = afro, (3, 7) = village, (4, 1) = 4, (4, 2) = Eilish, (4, 3) = Neighbours, (4, 4) = Eng, (4, 5) = 46, (4, 6) = bald, (4, 7) = city, (5, 1) = 5, (5, 2) = Amy, (5, 3) = Eastenders, (5, 4) = Fra, (5, 5) = 14, (5, 6) = curly, (5, 7) = town})

NULL

`Unique solution:`

Matrix(5, 7, {(1, 1) = 1, (1, 2) = Bob, (1, 3) = Simpsons, (1, 4) = Fra, (1, 5) = 46, (1, 6) = bald, (1, 7) = town, (2, 1) = 2, (2, 2) = Rachael, (2, 3) = Coronation, (2, 4) = Ita, (2, 5) = 21, (2, 6) = long, (2, 7) = youth, (3, 1) = 3, (3, 2) = Eilish, (3, 3) = Desperate, (3, 4) = Afr, (3, 5) = 81, (3, 6) = afro, (3, 7) = farm, (4, 1) = 4, (4, 2) = Keeley, (4, 3) = Neighbours, (4, 4) = Eng, (4, 5) = 52, (4, 6) = curly, (4, 7) = village, (5, 1) = 5, (5, 2) = Amy, (5, 3) = Eastenders, (5, 4) = Aus, (5, 5) = 14, (5, 6) = straight, (5, 7) = city})

.125*seconds

Since {4 = 46, 4 <> 46} is a complete and mutually exclusive set of constraints, and each case generated a unique solution, we are done proving that the original two solutions are the only solutions.

 

So, the additional time to prove that those are the only solutions was

T2-T1;

0.16e-1*seconds

 


Download City_LP.mw

Hmm. Somehow your default plot options got changed. Try this:

plot3d(x^2-y^2, x = -1 .. 1, y = -1 .. 1, style= patch);

If that shows the grid, then set the option as default by

plots:-setoptions3d(style= patch);

But I still wonder how your default got changed.

Actually, the representation of the table as matrices fits across my screen.

restart:
interface(rtablesize= 27):
M:= [seq(seq(seq(< < a,0 > | < b,c > >, a= 0..2), b= 0..2), c= 0..2)]:
T:= Matrix(27,27, (i,j)-> M[i].M[j] mod 3);

 

The piecewise command is easier to use than a chain of if-then-else statements.

Grades:= proc(x::realcons)
local a,b,c,d,f;
     piecewise(
          x < 0, undefined, x < 59.5, f, x < 69.5, d, x < 79.5, c,
          x < 89.5, b, x <= 100, a, undefined
     )
end proc:

If you still want to use if statements, then use elif, which is short for else if. That way, you can turn a chain of nested if statements into a single statement:

Grades:= proc(x::realcons)
local a,b,c,d,f;
     if x < 0 then undefined
     elif x < 59.5 then f
     elif x < 69.5 then d
     elif x < 79.5 then c
     elif x < 89.5 then b
     elif x <= 100 then a
     else undefined
     end if
end proc:

You need a for loop, an if-then statement, the isprime command, and a counter variable.

CountPrimes:= proc(n::posint)
local j, count:= 0;
     for j from 2 to n do
          if isprime(j) then
               count:= count+1
          end if
     end do;
     count
end proc:

CountPrimes(15);
                              
6

Go to the Maple Applications Center, and download and install the OrthogonalExpansions package. Then

OrthogonalExpansions:-FourierSeries(evalc(x*exp(I*x)), x= -Pi..Pi, infinity);

The evalc is necessary to get the correct coefficients at i=1. Don't confuse the summation index i with the imaginary I.

 

The last constraint, constraint 21, "Eilish is not next to the person with straight hair", needs to be specified as Rel(Separated, Eilish, straight, PN, [1]), which says that they are separated by at least 1 when measured wrt position. You merely have Eilish <> straight. Since Separated is an export of the dynamic module, this constraint needs to be specified after the with of the module.

When I do this, the program reports multiple solutions. The second solution that it gives is the same as the solution on the website from which you got the problem. From my reading, the first solution that the program gives also satisfies every constraint. Please verify this.

 

Here's how to get the answers with fsolve. This can be modified to instead use the multivariate Newton procedure that Markiyan directed you to.

restart:
eqns:= {
     t*((p-.764*z-2.194768)^2-1.170308549+.529948*(z-.382)^2)-(1-t)*p,
     t*((p+.382*z+.661624*y-1.907568)^2-1.018097144+.529984*(-.866*y-.5*z-.382)^2)+(1-t)*y,
     t*((p+.382*z-.661624*y-2.470348)^2-1.31636154+.529984*(.866*y-.5*z-.382)^2)+(1-t)*z
}:

(a,b):= (0,1):  h:= 0.0001:
N:= round((b-a)/h)+1;

Sols:= Array(1..N, 1..4):
inits:= {y=1,z=1,p=1}:
tt:= a:
for n to N do
     Sol:= fsolve(eval(eqns, t= tt), inits);
     Sol:= eval([y,z,p], Sol);
     Sols[n,..]:= < tt, Sol[] >;
     tt:= tt+h;
     inits:= {([y,z,p] =~ Sol)[]}
end do:

The solutions can be plotted as a space curve as a function of t like this:

plots:-spacecurve(convert(Sols[.., 2..4], listlist), labels= [y,z,p]);

Use an animation, so that one of a, c, n becomes the time parameter. Here I use a as the time parameter.

restart:
f:= (a,c,n)->
     64*a^2*n-16*a^4*n-256*c^2*n+32*c^4*n-96*a^2*c^2+ 8*a^2*c^4+24*a^4*c^2
     -64*a^2*n^2+256*a^2-124*a^4+ 15*a^6+256*n^2+64*a^2*c^2*n
:
plots:-animate(plot3d, [f(a,c,n), c= 0..2, n= 0..4], a= 0..2);



The above ideas can be made into a custom convert procedure:

`convert/decimalfraction`:= (x::float)-> op(1,x)/``(10^(-op(2,x))):

convert(.25, decimalfraction);

x^(1/3) is complex valued for negative because Maple uses the principal branch with `^`. The real-valued alternative is surd.

plot(surd(x,3), thickness= 5);

You can generate the procedure by calling LinearAlgebra:-Eigenvectors on a symbolic 2x2 matrix A = < < a, b > | < c, d > > and then reverse engineering the results. Doing that, I got the following

Eigen:= proc(A::'Matrix'(2,2))
local
     a:= A[1,1], b:= A[2,1], c:= A[1,2], d:= A[2,2],
     s:= sqrt((a-d)^2+4*b*c)/2,
     e1:= (a+d)/2 + s, e2:= (a+d)/2 - s,
     ev1:= < c, (d-a)/2+s >, ev2:= < c, (d-a)/2-s >
;
     if s=0 then [] else [e1, e2, ev1, ev2] end if
end proc:

This procedure needs a little modification. There are cases where s=0 but there are still two linearly independent eigenvectors. For example, any nonzero vector is an eigenvector of the zero matrix.

First 318 319 320 321 322 323 324 Last Page 320 of 395