Ronan

1022 Reputation

14 Badges

13 years, 157 days
East Grinstead, United Kingdom

MaplePrimes Activity


These are replies submitted by Ronan

@vv Thank you. That is what I needed and it automatically reduces the coefficients of the conic.

@tomleslie I definately should use the geometry package more often.

As an aside my conic was very slow to plot I presume due to the coefficients. do can map,gcd coeffs be simply used to do this.

I did this but it,s not nice, though it speeded up plotting.

c := 3879333*(x + (2515*y)/846 - 305/423)*(x + (556007*y)/45855 + 285532/45855)/17417452 + 400869*(x - (19921*y)/882 - 18785/882)*(x + (65165*y)/23634 - 4636/11817)/3349510;
         3879333  /    2515     305\ /    556007     285532\
    c := -------- |x + ---- y - ---| |x + ------ y + ------|
         17417452 \    846      423/ \    45855      45855 /

         400869  /    19921     18785\ /    65165     4636 \
       + ------- |x - ----- y - -----| |x + ----- y - -----|
         3349510 \     882       882 / \    23634     11817/


c := expand(numer(c));
                2                              2              
 c := 59638518 x  + 172369863 x y + 100205640 y  - 238554072 x

    - 660468303 y


L := coeffs(expand(c));
  L := 59638518, 172369863, 100205640, -238554072, -660468303

c := c/gcd(gcd(gcd(gcd(L[1], L[2]), L[3]), L[4]), L[5]);
                 2                    2                  
       c := 738 x  + 2133 x y + 1240 y  - 2952 x - 8173 y




 

@Mac Dude  Thank you for answering. I see how yor advice works now.  Is you print statement for debugging purposes? 

Edit:-

I would be interested in having a print feature that runs when the package is loaded the gives the global varables that can be set.

@dharr I hacked the code around to follow your advice and have the package basically functioning now.

What should I do with ModuleUnload? Is that important? At present it is giving errors in Cmaple.exe

Warning, Exception in unload function 'ModuleUnload': Error, `TT` does not
evaluate to a module
Warning, Exception in unload function 'ModuleUnload': Error, cannot determine if

Also when I read in the Rat..Trig.mpl I get a list of warnings about the Types being overwritten. Not a problem when I load/run the package though.

Below is the ModuleLoad and ModuleUnload code. (Not tidiied up yet)

ModuleLoad:= proc()
uses TT= TypeTools;
global _T1, _T2L, _T2V, _T2VR, _T3L, _T3V, _T3VC, _T3VR, _T4L, _MyType,GeomClr,Prntmsg, prjpsn;
          GeomClr:="Blue";
          Prntmsg:="y";
          prjpsn:=3;

local 
     MyTypes:= {_T1, _T2L, _T2V, _T2VR, _T3L, _T3V, _T3VC, _T3VR, _T4L},
     AllMyTypes:= MyTypes union {_MyType};
     print(AllMyTypes);

     # ModuleUnload:= proc()
     #local T;
       #   for T in AllMyTypes do if TT:-Exists(T) then TT:-RemoveType(T) end if; 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(_T2VR, 'Vector[row](2, algebraic)');
          TT:-AddType(_T2L, [algebraic $ 2]);
          TT:-AddType(_T3V, 'Vector(3, algebraic)');
          TT:-AddType(_T3VC, 'Vector[column](3, algebraic)');
          TT:-AddType(_T3VR, 'Vector[row](3, algebraic)');
          TT:-AddType(_T3L, [algebraic $ 3]);
          TT:-AddType(_T4L, [algebraic $ 4]);
          TT:-AddType(_MyType, MyTypes);
          return
     end proc;
 ModuleUnload:= proc()
 uses TT= TypeTools;
     local T;
          for T in AllMyTypes do if Exists(T) then RemoveType(T) end if; end do;
          return
     end proc;

 

@dharr  I don't really understand the structure. Do you mean comment out "MyModule:= module() and it's   end module" and insert it all in ModuleLoad?

#MyModule:= module()
ModuleLoad:= proc()
uses TT= TypeTools;
global _T1, _T2L, _T2V, _T2VR, _T3L, _T3V, _T3VC, _T3VR, _T4L, _MyType,GeomClr,Prntmsg, prjpsn;
          GeomClr:="Blue";
          Prntmsg:="y";
          prjpsn:=3;

local
     MyTypes:= {_T1, _T2L, _T2V, _T2VR, _T3L, _T3V, _T3VC, _T3VR, _T4L},
     AllMyTypes:= MyTypes union {_MyType},
     ModuleLoad,
      ModuleUnload:= proc()
     local T;
          for T in AllMyTypes do if TT:-Exists(T) then TT:-RemoveType(T) end if; 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(_T2VR, 'Vector[row](2, algebraic)');
          TT:-AddType(_T2L, [algebraic $ 2]);
          TT:-AddType(_T3V, 'Vector(3, algebraic)');
          TT:-AddType(_T3VC, 'Vector[column](3, algebraic)');
          TT:-AddType(_T3VR, 'Vector[row](3, algebraic)');
          TT:-AddType(_T3L, [algebraic $ 3]);
          TT:-AddType(_T4L, [algebraic $ 4]);
          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;
export    
     Dsp:= proc(msg:=" empty",prnt:=Prntmsg )
          if prnt = "y" then print(msg); end if;
     end proc;

     ModuleLoad()    
    # end module;

 

@dharr The types are used in many of the modules. I just didn't include them here. Scoping could be the issue. I had a scoping problem back in December when I was last looking at this. I will check it out tonight.

@dharr I see. So i tried something probably dangerous so I could apply a series of mutations from a list.

L:=[w,y,w,y,w,y]
                    L := [w, y, w, y, w, y]

newPopvs:=[Px,Py,Pz,Pw]:
for i in L do
newPopvs:=Mutate1(i,newPopvs);
end do
                        [Px, Py, Pz, Pw]

 

@Carl Love That wotks very well for me. I created a proc to mutate the population at a vertex called Mutate. Then I tried to make it more generat by including the Population list. Called Mutate1, This is giving an error "illegat use of formal parameter". What am a doing wrong here?
 

restart:

GT:= GraphTheory:

Vs:= [x,y,z,w]:

n:= [$nops(Vs)];

[1, 2, 3, 4]

V:= table(Vs=~ n);

table( [( y ) = 2, ( x ) = 1, ( z ) = 3, ( w ) = 4 ] )

V[y]

2

Popvs:= [4, 3, -1, 5]:

newPopvs:=Popvs

[4, 3, -1, 5]

Nbs:= Array([{2}, {1,3,4}, {2,4}, {2,3}]);

Vector[row](4, {(1) = {2}, (2) = {1, 3, 4}, (3) = {2, 4}, (4) = {2, 3}})

X:= GT:-Graph(Vs, Nbs);

GRAPHLN(undirected, unweighted, [x, y, z, w], Array(1..4, {(1) = {2}, (2) = {1, 3, 4}, (3) = {2, 4}, (4) = {2, 3}}), `GRAPHLN/table/1`, 0)

 

GT:-SetVertexPositions(X, [[0,0], [1,0], [1.5,1], [2,0]]):

GT:-DrawGraph(X)

X1:=GT:-RelabelVertices( X, [seq](cat(Vs[i], "=",Popvs[i]),i=n )) ;

GRAPHLN(undirected, unweighted, [`x=4`, `y=3`, `z=-1`, `w=5`], Array(1..4, {(1) = {2}, (2) = {1, 3, 4}, (3) = {2, 4}, (4) = {2, 3}}), `GRAPHLN/table/1`, 0)

GT:-DrawGraph(X1)

newX:= GT:-RelabelVertices(X, [seq](cat(Vs[i], "=", add(Popvs[[i, Nbs[i][]]])), i= n));

GRAPHLN(undirected, unweighted, [`x=7`, `y=11`, `z=7`, `w=7`], Array(1..4, {(1) = {2}, (2) = {1, 3, 4}, (3) = {2, 4}, (4) = {2, 3}}), `GRAPHLN/table/1`, 0)

GT:-DrawGraph(newX);

Mutate := proc(vtx)
description " Mutates population at a vertex";
 local i;
 global Vs, Popvs, Nbs,n,newPopvs;
 
 print(vtx, "Pop at Vertex =  ",newPopvs[V[vtx]]);
 newPopvs[V[vtx]] := -newPopvs[V[vtx]] + add(newPopvs[i],i=[op(Nbs[V[vtx]])]);
print(vtx,"Mutated Pop =  ", newPopvs[V[vtx]]);
 end proc

proc (vtx) local i; global Vs, Popvs, Nbs, n, newPopvs; description " Mutates population at a vertex"; print(vtx, "Pop at Vertex =  ", newPopvs[V[vtx]]); newPopvs[V[vtx]] := -newPopvs[V[vtx]]+add(newPopvs[i], i = [op(Nbs[V[vtx]])]); print(vtx, "Mutated Pop =  ", newPopvs[V[vtx]]) end proc

``

Mutate1 := proc(vtx,poplist)
description " Mutates population at a vertex";
 local i;
 global Vs, Popvs, Nbs,n,newPopvs;
 
 print(vtx, "Pop at Vertex =  ",poplist[V[vtx]]);
 poplist[V[vtx]] := -poplist[V[vtx]] + add(poplist[i],i=[op(Nbs[V[vtx]])]);
print(vtx,"Mutated Pop =  ", poplists[V[vtx]]);
 end proc

proc (vtx, poplist) local i; global Vs, Popvs, Nbs, n, newPopvs; description " Mutates population at a vertex"; print(vtx, "Pop at Vertex =  ", poplist[V[vtx]]); poplist[V[vtx]] := -poplist[V[vtx]]+add(poplist[i], i = [op(Nbs[V[vtx]])]); print(vtx, "Mutated Pop =  ", poplists[V[vtx]]) end proc

newPopvs

[4, 3, -1, 5]

Mutate(x);
Mutate(z);
newPopvs

x, "Pop at Vertex =  ", 4

x, "Mutated Pop =  ", -1

z, "Pop at Vertex =  ", -1

z, "Mutated Pop =  ", 9

[-1, 3, 9, 5]

``

Mutate1(x,newPopvs)

x, "Pop at Vertex =  ", 4

Error, (in Mutate1) illegal use of a formal parameter

newPopvs:=Popvs;
Mutate(y);
newPopvs;
Mutate(w);
newPopvs

[4, 3, -1, 5]

y, "Pop at Vertex =  ", 3

y, "Mutated Pop =  ", 5

[4, 5, -1, 5]

w, "Pop at Vertex =  ", 5

w, "Mutated Pop =  ", -1

[4, 5, -1, -1]

newPopvs:=Popvs

[4, 3, -1, 5]

Mutate(w);
newPopvs;
Mutate(y);
newPopvs;
Mutate(w);
newPopvs

w, "Pop at Vertex =  ", 5

w, "Mutated Pop =  ", -3

[4, 3, -1, -3]

y, "Pop at Vertex =  ", 3

y, "Mutated Pop =  ", -3

[4, -3, -1, -3]

w, "Pop at Vertex =  ", -3

w, "Mutated Pop =  ", -1

[4, -3, -1, -1]

NULL

newPopvs:=Popvs

[4, 3, -1, 5]

``

Mutate(y);
newPopvs;
Mutate(w);
newPopvs;
Mutate(y);
newPopvs

y, "Pop at Vertex =  ", 3

y, "Mutated Pop =  ", 5

[4, 5, -1, 5]

w, "Pop at Vertex =  ", 5

w, "Mutated Pop =  ", -1

[4, 5, -1, -1]

y, "Pop at Vertex =  ", 5

y, "Mutated Pop =  ", -3

[4, -3, -1, -1]

NULL


 

Download Q_24-12-22_NeighborArray.mw

@dharr  Thank you.  I really like the approach.  I thought I just broke your answer. Then when I looked the table mapping is doing something odd. It changed order to x,w,y,z  This then messes up the the populations displayed.

@Carl Love  @Joe Riel  Thank you.

@Joe Riel So is that all I need to change? Not a computer till later tonight. Will check then.

Do I make it local to MyModule or RT-local (outside of Mymodule)?

@rlopez Thank you 

@C_R So simple when one knows!

   @Carl Love

The overloaded routine Spreadw has one procedure that is being skipped. I can't figure out why?   Section highlighted in blue.

The apparently same concept works in routine f2 highlighted in green.

Any insights here?

restart


rt:=module()
option package;
export f2,Spreadw;
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},
     ModuleLoad,
      ModuleUnload:= proc()
     local T;
          for T in AllMyTypes do if TT:-Exists(T) then TT:-RemoveType(T) end if; 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
     
    

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

          proc(A::_T3L,B::_T1,C::_T1,E::_T1,clr)
               option overload;
               local s,t;
               MyModule:-WhichMyType~([A,B,C,E]);
               s:=A*B^3;
               t:=2*B+sqrt(C)-sin(E);
               s-t;
          end proc,

          proc(A::_T2L)
               option overload;
               local s;
               MyModule:-WhichMyType(A);
               s:=A*6;
          end proc
     ]);

     Spreadw :=overload([
         
          # s0 from 3 Quadrances
          
          proc(p0::_T1,p1::_T1,p2::_T1)
           option overload;
               1/4*((p0 + p1 + p2)^2 - 2*p0^2 - 2*p1^2 - 2*p2^2)/(p2*p1),  "3 Quadrances";
          end proc,

          # 2 Points wrt origin
          proc(p0::_T2L,p1::_T2L,clr := GeomClr)
           option overload;
           if clr=b or clr=B or clr=blue or clr=Blue then
                1 - LinearAlgebra:-BilinearForm(p0, p1, conjugate = false)^2/(LinearAlgebra:-BilinearForm(p0, p0, conjugate = false)*LinearAlgebra:-BilinearForm(p1, p1, conjugate = false)), "2 Points Blue";
           elif clr=g or clr=G or clr=green or clr=Green then
               -1/4*(p0[1]*p1[2] - p0[2]*p1[1])^2/(p0[1]*p0[2]*p1[1]*p1[2]), "2 Points Green";
           elif clr=r or clr=R or clr=red or clr=Red then
               -(p0[1]*p1[2] - p0[2]*p1[1])^2/((p0[1]^2 - p0[2]^2)*(p1[1]^2 - p1[2]^2)), "2 Points Red";
          end if;
          end proc,

          #3 Points wrt p0 
          proc(p0::_T2L, p1::_T2L, p2::_T2L, clr:=GeomClr)
           option overload;
               local P0,P1; 
               P0 := p0 - p2; 
               P1 := p1 - p2; 
               print(P0,P1);
               if clr=b or clr=B or clr=blue or clr=Blue then
                   1 - LinearAlgebra:-BilinearForm(P0, P1, conjugate = false)^2/(LinearAlgebra:-BilinearForm(P0, P0, conjugate = false)*LinearAlgebra:-BilinearForm(P1, P1, conjugate = false)), "3 Points Blue";
                elif clr=g or clr=G or clr=green or clr=Green then
                   -1/4*(P0[1]*P1[2] - P0[2]*P1[1])^2/(P0[1]*P0[2]*P1[1]*P1[2]), "3 Points Green";
                elif clr=r or clr=R or clr=red or clr=Red then
                   -(P0[1]*P1[2] - P0[2]*P1[1])^2/((P0[1]^2 - P0[2]^2)*(P1[1]^2 - P1[2]^2)), "3 Points Red";
               end if;
               end proc,

          # 2 Vectors
          proc(p0::_T2V,p1::_T2V,clr:=GeomClr)
               if clr=b or clr=B or clr=blue or clr=Blue then
                    1 - LinearAlgebra:-BilinearForm(p0, p1, conjugate = false)^2/(LinearAlgebra:-BilinearForm(p0, p0, conjugate = false)*LinearAlgebra:-BilinearForm(p1, p1, conjugate = false)), "Vectors Blue";
               elif clr=g or clr=G or clr=green or clr=Green then
                    -1/4*(p0[1]*p1[2] - p0[2]*p1[1])^2/(p0[1]*p0[2]*p1[1]*p1[2]), "Vectors Green";
               elif clr=r or clr=R or clr=red or clr=Red then
                    -(p0[1]*p1[2] - p0[2]*p1[1])^2/((p0[1]^2 - p0[2]^2)*(p1[1]^2 - p1[2]^2)), "Vectors Red";
               end if;
          end proc

]);
end module:
#maplemint(rt)
#GeomClr:=Blue

rt:-Spreadw(1,1,1);

rt:-Spreadw([1,1],[1,0],b);
rt:-Spreadw([1,2],[1,0],r);
rt:-Spreadw([1,1],[1,2],g);


rt:-Spreadw([0,0],[1,1],[1,0],b);
rt:-Spreadw([0,0],[1,2],[1,0],r);
rt:-Spreadw([0,0],[1,1],[1,2],g);


rt:-Spreadw(<1,1>,<1,0>,b);
rt:-Spreadw(<1,2>,<1,0>,r);
rt:-Spreadw(<1,1>,<1,2>,g);
rt:-f2([2,3],5);
rt:-f2([2,3,8],19);#should produce an exception
rt:-f2([2,3,8],19,7,3,g);
rt:-f2([2,3]);

@Carl Love 

A follow up question. Why does a:: [algebraic $ 3]  not work on a procedure input usless it is added to Types?

It works for  is(a:: [algebraic $ 3])  and if.....then without having been addet to Types.

restart

 

a:=[2,5,2]

[2, 5, 2]

 
 

is(a:: [algebraic $ 3]) ;

is(a:: [algebraic $ 2])

true

FAIL

tst:=proc(A:: [algebraic $ 3])   
 local r:= "A is T3L";


   print(r);
       
end proc;

proc (A::[`$`(algebraic, 3)]) local r; r := "A is T3L"; print(r) end proc

 

tst(a)

is(a:: [algebraic $ 3]) ;

 

 

Error, invalid input: tst expects its 1st argument, A, to be of type [algebraic $ 3], but received [2, 5, 2]

 

tst1:=proc(A)   
 local r:= "A is T3L";
if   is(a:: [algebraic $ 3])then

   print(r);
end if;        
end proc;

proc (A) local r; r := "A is T3L"; if is(a::[`$`(algebraic, 3)]) then print(r) end if end proc

tst1(a)

"A is T3L"

 


 

Download Q_24-11-2022_Type_Test_on_input.mw

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