Carl Love

Carl Love

28050 Reputation

25 Badges

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

MaplePrimes Activity


These are answers submitted by Carl Love

Solving an equation is almost equivalent to solving the numerator of the difference of the two sides. This gives a usable solution:

solve(numer(p0 - p1),  y);

It still gives that warning, but a warning is not an "error", and "may have been lost" is not necessarily "were lost". 

You should collect the data inside the loop into matrices, then use a plot command after the loop.

This does side-by-side plots for your 3 values of k1. In your data-collection loop, the lines that I added or modified are followed by ####. For brevity here, I omitted lines that weren't needed to get the plots; however, the code executes fine if those lines are included.

#Data-collection loop:
beta:= {$1..8}:  ####
for k1 in K do
    plotdata[k1]:= Matrix(nops(beta), 4); ####
    for i to nops(beta) do ####
        b:= beta[i]; ####
        Etemp := eval(
            `πcentral`(p, e, z), 
            [A = 0, B = 2, alpha = 50, beta = b, c = 5, k = k1, mu = 10, v = 1]
        );
        Soln:= NLPSolve(Etemp, p = 5 .. 500, e = 0.5 .. 10, z = 0 .. 10, maximize);
        (etemp, ptemp, ztemp):= eval([e, p, z], Soln[2])[]; ####
        `πtemp` := Soln[1];
        y_temp:= eval(y(p, e), [alpha = 50, beta = b, p = ptemp, k = k1, e = etemp]);
        q_temp:= y_temp + ztemp;
        plotdata[k1][i] := <b | ptemp | etemp | q_temp> ####
    od
od:
plots:-display(
    <seq(
        plot(
            [seq](plotdata[k1][..,[1,j]], j= 2..4), legend= ['p', 'e', 'q'],
            style= pointline, symbol= [box, diamond, solidcircle], 
            labels= ['beta', ``], title= sprintf("k1 = %a", k1), axes= boxed
        ),
        k1= K
    )>^%T
);

Yes, this is called a traveling-salesman problem. In the code below, the variable met indicates which norm (or metric) is used to measure the distance between points. You may not know that your points are already sorted with respect to the standard Euclidean (or "2") norm. If the 1-norm (sum of distances in each dimension) is used, the order is different. The code below takes about 4 minutes. This problem is a canonical example of an NP-complete problem, for which there's no known fast algorithm for guaranteed shortest path.

In my initial matrix below, note that I trimmed off the repetition of the 1st point as the last point.

met:= 1: #Use 1-norm.
LT:= Matrix([
    [1, 1, 0], [3, 2, 0], [2, 3, 1], [1, 3, 1], [1, 4, 2], [1, 5, 0], [2, 5, 1], 
    [3, 5, 3], [4, 5, 3], [3, 4, 5], [4, 3, 2], [5, 3, 2], [5, 4, 1], [5, 2, 1],
    [5, 1, 0], [4, 1, 2], [3, 1, 2], [2, 1, 2], [1, 2, 1]
]):
W:= Matrix( #"Weight" matrix, or pairwise distances
    upperbound(LT)[1]$2, (i,j)-> LinearAlgebra:-Norm(LT[i]-LT[j], met),
    shape= symmetric, datatype= hfloat
):
(d,P):= CodeTools:-Usage(GraphTheory:-TravelingSalesman(GraphTheory:-Graph(W)));
memory used=21.20GiB, alloc change=0 bytes, 
cpu time=3.87m, real time=3.60m, gc time=33.45s

d, P := 42., [1, 19, 4, 3, 7, 6, 5, 10, 8, 9, 11, 12, 13, 14, 15, 
  2, 16, 17, 18, 1]

#d = 42 is the total distance.

LT__sorted:= convert(<LT, LT[1]>[P], listlist);
LT__sorted := [
    [1, 1, 0], [1, 2, 1], [1, 3, 1], [2, 3, 1], [2, 5, 1], 
    [1, 5, 0], [1, 4, 2], [3, 4, 5], [3, 5, 3], [4, 5, 3], 
    [4, 3, 2], [5, 3, 2], [5, 4, 1], [5, 2, 1], [5, 1, 0], 
    [3, 2, 0], [4, 1, 2], [3, 1, 2], [2, 1, 2], [1, 1, 0]
]

 

There are cases where a discrete, plot-based technique such as you suggest is necessary, but this isn't one of them: Standard algebraic, analytic, numeric techniques will work for this. I think that you should use them when they work, because they'll give you much more mathematical flexibility. 

fsolve(1 - binomial(180000,r)*r!/180000^r = 0.25, r= 1..infinity);
                          322.2204929

This works because the right side of the equation is a continuous, increasing function of r for real r >= 1r isn't restricted to integers.

There may be some cases where you'd need to use a plot-based technique (such as you suggest) to answer that question, but this isn't one of them. Here, straightforward algebraic, analytic, numerical techniques work, and I think it's more mafhematically robust for you to use them. 

fsolve(1 - binomial(180000,r)*r!/180000^r = 0.25, r= 1..infinity);
             322.2204929

Note that Maple's plotting commands produce somewhat high-level and human-readable data structures before they're displayed as plots. The relevent data can be extracted from those, as in the following example. The particular data that you asked about is in two-column matrices, which there may be several of.

P:= plot(x^2, x= -2..2); #Store plot in variable P.
op(P); #Show the entire data structure.
data:= indets(P, And(rtable, (posint, 2) &under upperbound)); #Extract the 2-column matrices

In this case, there's one such matrix, which I now extract from the set produced by the previous command:

Curve:= data[1]; #1st (and only) item in the set

Curve contains about 200 points (version dependent) in this case. Mine has exactly 200. Each row is an (xy) pair in Cartesian coordinates (even if you used a different coordinate system, for example, polar).

Here's how to index matrices. The 1st entry in the 99th row is Curve[99, 1]; the 19th row is Curve[19]; the 2nd column (the y-coordinates) is Curve[.., 2]; etc. The are many indexing variations possible.

The command usually recommended for extracting data from a plot is plottools:-getdata. However, I strongly prefer the method that I described above.

If you make a numeric dsolve call such as

P:= dsolve({diff(y(x), x) = y(x), y(0)=1}, numeric, method= rkf45)

then will be a procedure. List its contents with

showstat(P)

For a procedure of this size, showstat will give you more-human-readable results than print(P).

The procedure P has a **local** Array _dat, which has another procedure stored in _dat[1]. This latter procedure does the bulk of the work.

You said that this was in a procedure. In the procedure's declarations area, include

uses plots;

Then within that procedure, any reference to a command from package plots will not need the plots:- prefix.

I'd recommend against using alias or macro inside a procedure, but I'm only guessing that they might cause problems, potentially by altering the global state. I don't know from experience.

Regarding your statement odeplot:= plots:-odeplot: If odeplot is a local variable of the procedure, there would be no problem with doing it that way. But I think that uses is very, very slightly more efficient because there's no need to allocate and dereference a local.

@Ronan You asked:

  • Q1. if A :=[2,3] how do I get the procedure to detect and print that it is _T2L?

See my additions to the attached worksheet/module, in green again. I also modified ModuleUnload so that you won't get those distracting but totally harmless warning messages about overwriting the types.

  • Q2. why does it need [ModuleLoad() right before end module]?

Good question. It's just for editing, testiing, rewriting the code. A ModuleLoad is automatically called when the module is loaded from a library/archive. When we're rewriting/editing the code in a worksheet session, the new code is not in a library, so that automatic execution of ModuleLoad doesn't happen. But we need the effects of ModuleLoad() to test the code.

restart

 

rt:=module()
option package;
export f1,f2;
local MyModule;

MyModule:= module()
uses TT= TypeTools;
global _T1, _T2L, _T2V, _T3L, _T3V, _MyType;
local
     MyTypes:= {_T1, _T2L, _T2V, _T3L, _T3V},
     AllMyTypes:= MyTypes union {_MyType},
     
     ModuleUnload:= proc()
     local T;
          for T in AllMyTypes do if TT:-Exists(T) then TT:-RemoveType(T) fi end do;
          return
     end proc,

     ModuleLoad:= proc()
     local
          g, #iterator over module globals
          e
     ;
          ModuleUnload();
          #op([2,6], ...) of a module is its globals.
          for g in op([2,6], thismodule) do
               e:= eval(g);
               #print("e",e);
               if g <> e and e in AllMyTypes then
                    error "The name %1 must be globally available.", g
               end if
          end do;
          TT:-AddType(_T1, algebraic);
          TT:-AddType(_T2V, 'Vector(2, algebraic)');
          TT:-AddType(_T2L, [algebraic $ 2]);
          TT:-AddType(_T3V, 'Vector(3, algebraic)');
          TT:-AddType(_T3L, [algebraic $ 3]);
          TT:-AddType(_MyType, MyTypes);
          return
     end proc;          

export
     WhichMyType:= proc(X)
     local S:= select(T-> X::T, MyTypes), n:= nops(S);
         printf("%a is ", X);
         if n=0 then printf("not any of the special types.\n")
         else printf("type %a.\n", `if`(n=1, S[], Amd(S[])))
         fi
      end proc;

      ModuleLoad()    
      end module;
     

#Proceduews for export
     f1:= overload([
          proc(A::_T1, B::_T1, C::_T1)
          option overload;
          local r:= "A, B, C are T1."; #unnecessary; just an example.
               #statements to process this type
          end proc,

          proc(A::_T2L, B::_T2L, C::_T2L)
          option overload;
          local r:= "A, B, C are T2L.";
               #
          end proc,

          proc(A::_T2V, B::_T2V, C::_T2V)
          option overload;
          local r:= "A, B, C are T2V.";
               #
          end proc,

          proc(A::_T3L, B::_T3L, C::_T3L)
          option overload;
          local r:= "A, B, C are T3L.";
               #         
          end proc,

          proc(A::_T3V, B::_T3V, C::_T3V)
          option overload;
          local r:= "A, B, C are T3V.";
               #
          end proc,

          proc(A::_T2L, B::_T3L,$)
          option overload;
          local r:= "A, B, are mixed.";#I added this
               #
          end proc
     ]);

     
     f2:=overload([
          proc(A::_T2L,B::_T1)
               option overload;
               MyModule:-WhichMyType(A);
               A*B^2
          end proc,

          proc(A::_T3L,B::_T1)
               option overload;
               MyModule:-WhichMyType(A);
               A*B^3-2*B
          end proc
     ]);
          
end module;

#maplemint(rt);
#Example usage:





 

_m1759336810304

x:=[9,4]:
y:=[5,67]:
z:=[1,2]:                                 

rt:-f1(x,y,z);
rt:-f1(2,y,s);  #should produce an exception
x:=<9,4,r>:
y:=<5,6,r>:
z:=<1,2,w>:                                 
rt:-f1(x,y,z);
x:=[9,4]:
y:=[5,6,7]:
z:=[1,2]:
rt:-f1(x,y);
rt:-f2([2,3],5);
rt:-f2([2,3,8],19);

"A, B, C are T2L."

Error, invalid input: no implementation of f1 matches the arguments in call, 'f1(2,y,s)'

"A, B, C are T3V."

"A, B, are mixed."

[2, 3] is type _T2L.

[50, 75]

[2, 3, 8] is type _T3L.

[13718, 20577, 54872]-38

 

 

Download Module_Test_Types_2.mw

I guess that this is just a a very simplified example of what you actually want to do?

Matrix indices start at 1, not 0. So perhaps you want an Array or a table instead of a Matrix?

A Matrix can be indexed A[i, j] or A(i, j), but these mean slightly different things. A[i, j] assumes that i and j are valid indices. A(i,j):= ... will create them as valid indices if need be.

It's much easier to let the overload command do all the type-checking work rather than trying to do it in ModuleApply. Here is your module with my corrections. What I added is in green; what I removed is in orange.
 

restart
:

MyModule:= module()
uses TT= TypeTools;
global _T1, _T2L, _T2V, _T3L, _T3V, _MyType;
local
     MyTypes:= {_T1, _T2L, _T2V, _T3L, _T3V},
     AllMyTypes:= MyTypes union {_MyType},

     ModuleLoad:= proc()
     local
          g, #iterator over module globals
          e
     ;
          #op([2,6], ...) of a module is its globals.
          for g in op([2,6], thismodule) do
               e:= eval(g);
               if g <> e and e in AllMyTypes then
                    error "The name %1 must be globally available.", g
               end if
          end do;
          TT:-AddType(_T1, algebraic);
          TT:-AddType(_T2V, 'Vector(2, algebraic)');
          TT:-AddType(_T2L, [algebraic $ 2]);
          TT:-AddType(_T3V, 'Vector(3, algebraic)');
          TT:-AddType(_T3L, [algebraic $ 3]);
          TT:-AddType(_MyType, MyTypes)
     end proc,

     ModuleUnload:= proc()
     local T;
          for T in AllMyTypes do TT:-RemoveType(T) end do
     end proc,

     MyDispatch:= overload([
          proc(A::_T1, B::_T1, C::_T1)
          option overload;
          local r:= "A, B, C are T1."; #unnecessary; just an example.
               #statements to process this type
          end proc,

          proc(A::_T2L, B::_T2L, C::_T2L)
          option overload;
          local r:= "A, B, C are T2L.";
               #
          end proc,

          proc(A::_T2V, B::_T2V, C::_T2V)
          option overload;
          local r:= "A, B, C are T2V.";
               #
          end proc,

          proc(A::_T3L, B::_T3L, C::_T3L)
          option overload;
          local r:= "A, B, C are T3L.";
               #         
          end proc,
          #
          #The overloaded procedures MUST have option overload.


          #
          #I added this
          #
          proc(A::_T2L, B::_T3L, $)
          option overload;
          local r:= "A, B, are mixed.";
               #
          end proc,

          proc(A::_T3V, B::_T3V, C::_T3V)
          option overload;
          local r:= "A, B, C are T3V.";
               #
          end proc
     ]),
#
# I have added the Or(....(A::_T2L,B::_T3L)
#
     ModuleApply:= proc(
          (*
          A::'Or'(And(
               _MyType,
               satisfies(A-> andmap(T-> A::T implies B::T and C::T, MyTypes) )
          ),(A::_T2L,B::_T3L)),
          B::_MyType, C::_MyType
          *)
     )
          MyDispatch(args)
     end proc
;
     ModuleLoad()    
end module:
 

#Example usage:
#

x:=[9,4];
y:=[5,7];
z:=[1,9];                                 
MyModule(x,y,z);

[9, 4]

[5, 7]

[1, 9]

"A, B, C are T2L."

x:=[9,4];
y:=[5,6,7];
z:=p;                                 
MyModule(x,y);

[9, 4]

[5, 6, 7]

p

"A, B, are mixed."

MyModule([1,2],2,3);

Error, (in MyModule) invalid input: no implementation of MyDispatch matches the arguments in call, 'MyDispatch([1, 2], 2, 3)'

 

Download Module_Test_Types.mw

The algorithm shown by @dharr is fairly well known; I remember reading it in a magazine (perhaps Games) as a child. The following property of that algorithm is much less well known. It doesn't help much when applying the algorithm by hand, but it allows for a big simplification in a computer implementation. It's this: The steps where one needs to go down instead of up and right due to a previously used position or going off the upper right corner happen iff the previously used value is a multiple of the order.

Also, for the verification procedure, I added a check that the elements are all different, which is usually considered part of the definition of a true magic square.
 

restart
:

#Both procedures require 1D input!
#
MagicSq:= proc(n::And(posint, odd))
local M:= Matrix(n$2, datatype= integer[4]), i:= 0, j:= (n+1)/2, k:= 0;
    to n do
        i+= 2; j--;
        to n do M((i:= `if`(i=1, n, i-1)), (j:= `if`(j=n, 1, j+1))):= ++k od
    od;
    M
end proc
:                                

TypeTools:-AddType(
    'MagicSq',
    M-> M::'Matrix'('square') and (
            ()-> local n:= op([1,1], M), j, r:= j= 1..n, S:= add(M[j,-j], r);
            S = add(M[j,j], r)                         #equal diagnonal sums 
            and n^2 = nops({entries}(M, 'nolist'))         #distinct entries
            and andseq(S=add(M[j]) and S=add(M[..,j]), r) #row & column sums
        )()
):

interface(rtablesize= 15):

M:= MagicSq(15);

Matrix(15, 15, {(1, 1) = 122, (1, 2) = 139, (1, 3) = 156, (1, 4) = 173, (1, 5) = 190, (1, 6) = 207, (1, 7) = 224, (1, 8) = 1, (1, 9) = 18, (1, 10) = 35, (1, 11) = 52, (1, 12) = 69, (1, 13) = 86, (1, 14) = 103, (1, 15) = 120, (2, 1) = 138, (2, 2) = 155, (2, 3) = 172, (2, 4) = 189, (2, 5) = 206, (2, 6) = 223, (2, 7) = 15, (2, 8) = 17, (2, 9) = 34, (2, 10) = 51, (2, 11) = 68, (2, 12) = 85, (2, 13) = 102, (2, 14) = 119, (2, 15) = 121, (3, 1) = 154, (3, 2) = 171, (3, 3) = 188, (3, 4) = 205, (3, 5) = 222, (3, 6) = 14, (3, 7) = 16, (3, 8) = 33, (3, 9) = 50, (3, 10) = 67, (3, 11) = 84, (3, 12) = 101, (3, 13) = 118, (3, 14) = 135, (3, 15) = 137, (4, 1) = 170, (4, 2) = 187, (4, 3) = 204, (4, 4) = 221, (4, 5) = 13, (4, 6) = 30, (4, 7) = 32, (4, 8) = 49, (4, 9) = 66, (4, 10) = 83, (4, 11) = 100, (4, 12) = 117, (4, 13) = 134, (4, 14) = 136, (4, 15) = 153, (5, 1) = 186, (5, 2) = 203, (5, 3) = 220, (5, 4) = 12, (5, 5) = 29, (5, 6) = 31, (5, 7) = 48, (5, 8) = 65, (5, 9) = 82, (5, 10) = 99, (5, 11) = 116, (5, 12) = 133, (5, 13) = 150, (5, 14) = 152, (5, 15) = 169, (6, 1) = 202, (6, 2) = 219, (6, 3) = 11, (6, 4) = 28, (6, 5) = 45, (6, 6) = 47, (6, 7) = 64, (6, 8) = 81, (6, 9) = 98, (6, 10) = 115, (6, 11) = 132, (6, 12) = 149, (6, 13) = 151, (6, 14) = 168, (6, 15) = 185, (7, 1) = 218, (7, 2) = 10, (7, 3) = 27, (7, 4) = 44, (7, 5) = 46, (7, 6) = 63, (7, 7) = 80, (7, 8) = 97, (7, 9) = 114, (7, 10) = 131, (7, 11) = 148, (7, 12) = 165, (7, 13) = 167, (7, 14) = 184, (7, 15) = 201, (8, 1) = 9, (8, 2) = 26, (8, 3) = 43, (8, 4) = 60, (8, 5) = 62, (8, 6) = 79, (8, 7) = 96, (8, 8) = 113, (8, 9) = 130, (8, 10) = 147, (8, 11) = 164, (8, 12) = 166, (8, 13) = 183, (8, 14) = 200, (8, 15) = 217, (9, 1) = 25, (9, 2) = 42, (9, 3) = 59, (9, 4) = 61, (9, 5) = 78, (9, 6) = 95, (9, 7) = 112, (9, 8) = 129, (9, 9) = 146, (9, 10) = 163, (9, 11) = 180, (9, 12) = 182, (9, 13) = 199, (9, 14) = 216, (9, 15) = 8, (10, 1) = 41, (10, 2) = 58, (10, 3) = 75, (10, 4) = 77, (10, 5) = 94, (10, 6) = 111, (10, 7) = 128, (10, 8) = 145, (10, 9) = 162, (10, 10) = 179, (10, 11) = 181, (10, 12) = 198, (10, 13) = 215, (10, 14) = 7, (10, 15) = 24, (11, 1) = 57, (11, 2) = 74, (11, 3) = 76, (11, 4) = 93, (11, 5) = 110, (11, 6) = 127, (11, 7) = 144, (11, 8) = 161, (11, 9) = 178, (11, 10) = 195, (11, 11) = 197, (11, 12) = 214, (11, 13) = 6, (11, 14) = 23, (11, 15) = 40, (12, 1) = 73, (12, 2) = 90, (12, 3) = 92, (12, 4) = 109, (12, 5) = 126, (12, 6) = 143, (12, 7) = 160, (12, 8) = 177, (12, 9) = 194, (12, 10) = 196, (12, 11) = 213, (12, 12) = 5, (12, 13) = 22, (12, 14) = 39, (12, 15) = 56, (13, 1) = 89, (13, 2) = 91, (13, 3) = 108, (13, 4) = 125, (13, 5) = 142, (13, 6) = 159, (13, 7) = 176, (13, 8) = 193, (13, 9) = 210, (13, 10) = 212, (13, 11) = 4, (13, 12) = 21, (13, 13) = 38, (13, 14) = 55, (13, 15) = 72, (14, 1) = 105, (14, 2) = 107, (14, 3) = 124, (14, 4) = 141, (14, 5) = 158, (14, 6) = 175, (14, 7) = 192, (14, 8) = 209, (14, 9) = 211, (14, 10) = 3, (14, 11) = 20, (14, 12) = 37, (14, 13) = 54, (14, 14) = 71, (14, 15) = 88, (15, 1) = 106, (15, 2) = 123, (15, 3) = 140, (15, 4) = 157, (15, 5) = 174, (15, 6) = 191, (15, 7) = 208, (15, 8) = 225, (15, 9) = 2, (15, 10) = 19, (15, 11) = 36, (15, 12) = 53, (15, 13) = 70, (15, 14) = 87, (15, 15) = 104})

type(M, MagicSq);

true

(*~~~
Create and verify a large square---over a million entries---to check code efficiency:
                                                                                   ~~~*)
printf(
    "\n\nResource usage for magic-square construction:\n"
        ".............................................\n"
):
M:= CodeTools:-Usage(MagicSq(1001)):

printf(
    "\n\nResource usage for magic-square verification:\n"
        ".............................................\n"
);
CodeTools:-Usage(type(M, MagicSq));



Resource usage for magic-square construction:
.............................................
memory used=119.57MiB, alloc change=48.82MiB, cpu time=1.67s, real time=1.43s, gc time=468.75ms


Resource usage for magic-square verification:
.............................................
memory used=28.56MiB, alloc change=15.30MiB, cpu time=406.00ms, real time=401.00ms, gc time=0ns

true

 

NULL

Download MagicSquare.mw

 

Like this:

ex:=
    G1*P3 + G1*P5 + G1*P6 + G2*P3 + G2*P6 + G3*P2 + G3*P5 + G4*P2 + G4*P3 + G4*P5 
    + G4*P6 + G5*P2 + G5*P3
    + G5*P5 + G5*P6 + G6*P3 + G6*P6 + G7*P2 + G7*P5 + G8*P2 + G8*P3 + G8*P5 + G8*P6
:
V:= indets(ex)[]:
codegen[optimize](unapply(ex, [V]), tryhard)(V);

    (G3 + G4 + G5 + G7 + G8)*P2 + (G1 + G3 + G4 + G5 + G7 + G8)*P5 + (P3 + P6)*(G1 + G2 + G4 + G5 + G6 + G8)

By the way, collect will also accept a list of variables: 

collect(ex, [P3,P6,P2,P5]);

It can be done with a one-line procedure:

Rose:= (n::integer)-> plots:-polarplot(sin(n*t), filled, color= `if`(n::odd, pink, aqua));

Test:

Rose(2);  Rose(3);

Given a planar graph G, the command

PD:= GraphTheory:-PlaneDual(G)

returns the graph PD whose vertices are the regions (a.k.a. "faces") of and such that {u,v} is an edge of PD iff the corresponding faces of share an edge. Unfortunately, this command doesn't give the face-to-vertex correspondence; however, it may be enough for your purposes.

The list of lists FL of vertices of G that define its faces can be obtained by 

GraphTheory:-IsPlanar(G, 'FL')

Vertices of degree 0, 1, or 2 in G can be a nuisance. I know this from long experience; I don't know whether they have any bad effect on these particular commands. Those vertices usually add nothing of interest mathematically to the study of planar graphs (or graphs embeddable on other surfaces), but they make many algorithms more complicated. I recommend that they be removed from G. Those of degree 0 or 1 can be removed outright. For a degree-2 vertex v, remove it and connect the two other vertices of its neighborhood if they aren't already connected. Continue recursively removing vertices of degree < 3 until there are no more.

First 33 34 35 36 37 38 39 Last Page 35 of 395