(* : Name : `TexmacsPlugin`*)
(* : Title : Set of Macro-instructions for working on TeXmacs*)
(* : Author : Bratschi Bertrand*)
(* : Package Version : 1.0*)
(* : Copyright : BB 2009 GNU.*)
    
BeginPackage["Plugin`Texmacs`"]

Needs["Graphics`InequalityGraphics`"]
Needs["Graphics`Arrow`"]
Needs["Graphics`ImplicitPlot`"]
Needs["Graphics`SurfaceOfRevolution`"]


InitPlug::usage = "Initie les conditions optimales pour une session Mathematica dans TeXmacs"

EPS::usage = "exporation de graphiques dans un fichiers eps"

JView::usage = "exporation de graphiques dans JavaView"

DeuxCourbes::usage = "DeuxCourbes[f1, f2, x1 ,x1] trace le graphe des deux fonctions f1 et f2 sur l'intervalle [x1,x2] en montrant leurs intersections."

Communic::usage="Communication contextuelle de resultats numeriques complementaires"

ImplicitD::usage="ImplicitD[F[x,y]] donne la derivee y'(x) pour F[x,y]=0 ImplicitD[F[x,y],{xo,y0}] evalue cette derivee en (xo,yo)"

Secteur::usage ="Secteur[alpha,beta] trace un secteur circulaire d'angle d'ouverture beta ( aplha est l'angle d'inclinaison de l'axe de symetrie )"

Extrama::usage = "Extrama[f,a,b] trace le graphe de la fonction f sur l'intervalle [a,b] en montrant ses extrema"

Region::usage ="Region[Conditions,x,y] montre la region du plan satisfaisant Conditions"

Surface::usage="Surface[f1,f2,xinf,xsup,a,b,n,r,h] trace la surface les courbes des fonctions f1 et f2 sur l'intervalle [xinf,xsup| en montrant la surface \
d'integration entre les courbes et les verticales x=a et x=b. n = nombre d'iterations (env200) r=1 <=> orthonorme h = hue (entre 0 et1 )"

Tangente::usage = "Tangente[f,xo,g,d] trace la tangente a la courbe de f(x) au point d'abscisse xo, sur l'intervalle [xo-g,xo+d] "

TangenteImp::usage = "TangenteImp[F,xo,yo,g,d] trace la tangente a la courbe d'equation implicite F(x,y)=0 au point (xo,y0) sur l'intervalle[xo-g,xo+d]"

Secante::usage = "[f,a,b,xinf,xsup] trace la secante par les points d'ascisses a et b a la courbe de f, trace sur l'intervalle [xinf,xsup]"

Normale::usage = "Normale[mu,sgm,a,b] trace la courbe de la loi normale centree en mu d'ecart type sgm et la surface sous la courbe pour a<x<b "

Horner::usage = "Horner[P[x],a] produit un tableau pour la division de p(x) par (x-a) selon le schema d'Horner"

(* ---------( b.bratschi decembre 2009-janvier 2010 )-------------*)

(*Init*)

InitPlug:=Do[Off[Show::gmed];]

(* EPS *)

EPS[graph_]:=
  If[$VersionNumber<6,
    Display["/usr/local/-imagetemp.eps",graph,"EPS"],
    Export["/usr/local/-imagetemp.eps",graph,"EPS"]]
    
(* JView *)

JView:=JavaView[GGG]    
    
(* Communic *)

Communic:=
  If[Head[resultat]==Symbol,"aucun resultat pour le moment !",resultat,
    resultat]    
    
 (* ImplicitD *)   
 
 ImplicitD[expr_]:=
    Flatten[Solve[D[expr/.y\[Rule]y[x],x]\[Equal]0,y'[x]]/.y[x]\[Rule]y]
    
ImplicitD[expr_,{xo_,yo_}]:=(y'[x]/.ImplicitD[expr])/.{y\[Rule]yo}/.{x\[Rule]\
\
\
\
\
xo}

    
(* DeuxCourbes *)  

SelectLis[x1_,x2_,list_]:=
  Flatten[Union[
      Table[If[And[(x/.list)[[k]] >x1,(x/.list)[[k]] <x2],{list[[k]]},{}],{k,
          Length[list]}]],1]
          
          DeuxCourbes[f1_,f2_,x1_,x2_]:=
  With[{S=Union[
          Flatten[{Table[
                FindRoot[
                  f2-f1,{x,x1+(1/6)*k*(x2-x1),x1+(1/6)*(k+1)*(x2-x1)}],{k,0,
                  5}]},1]]},{resultat="abscisses des intersections :"<>ToString[x/.SelectLis[x1,x2,S]],
      GGG=Show[Plot[{f1,f2},{x,x1,x2}],
          Graphics[
            Flatten[{{PointSize[0.02]},
                Simplify[Point[{x,f1}]/.SelectLis[x1,x2,S]],{Dashing[{0.02}]},\


                Line[{{x,f1},{x,0}}]/.SelectLis[x1,x2,S]},1],
            PlotRange\[Rule]{{x1,x2},{}}]],EPS[GGG]}]
              
(* Secteur *)          
              
          Secteur[al_,be_]:=With[{cA={Cos[Pi(al-be/2)/180],Sin[Pi(al-be/2)180]},
  cB={Cos[Pi(al+be/2)/180],Sin[Pi(al+be/2)/180.]},cO={0,0}},{resultat="A(triangle OAB) = "<>ToString[Abs[Sin[1.*be]/2]]<>" \

\!\(r^2\)  A(secteur OAB) = " <>ToString[Pi be/360.]<>" \
\!\(r\^2\)",
GGG=Show[Graphics[{RGBColor[0.7,0.8,1],
        Disk[{0,0},1,Pi{al-be/2,al+be/2}/180],RGBColor[0,0,0],Circle[{0,0},1],\

        Line[{cO,cA}],Line[{cO,cB}],PointSize[.02],Point[cO],Dashing[{.02}],
        Line[{cA,cB}],
        AbsoluteDashing[{0.01,8}],
        Line[{cO,1.15{Cos[Pi*al/180],Sin[Pi*al/180]}}],
        Text["O",{0,-1/8}],Text["A",1.1*cA],Text["B",1.1*cB]},
      AspectRatio\[Rule]Automatic,Axes\[Rule]False,
      PlotRange\[Rule]All]],EPS[GGG]}]
            
(* Extrema *)           
 
Extrama[f_,x1_,x2_]:=
  With[{S=Union[
          Flatten[{Table[
                FindRoot[D[f,x],{x,x1+(k*(x2-x1))/6,x1+((k+1)*(x2-x1))/6}],{k, 0,5}]},1]]},{resultat=
        "abscisses des extrema :"<>
          ToString[Union[Floor[100000*x+0.5/.SelectLis[x1,x2,S]]/100000.]], 
      GGG=Show[Plot[f,{x,x1,x2}],
          Graphics[
            Flatten[{{{Hue[0.55],
                      Arrow[{x+(x2-x1)/9,f},{x-(x2-x1)/9,f},
                        HeadCenter\[Rule]0.55],
                      Arrow[{x-(x2-x1)/9,f},{x+(x2-x1)/9,f},
                        HeadCenter\[Rule]0.55],Hue[0.92],PointSize[.03]},
                    Point[{x,f}]}/.SelectLis[x1,x2,S],{Dashing[{.02}]},
                Line[{{x,f},{x,0}}]/.SelectLis[x1,x2,S]}],1]],EPS[GGG]}]
                
(* Region *)

Region[Conditions_,x_,y_]:=
  Do[{GGG=Show[
          Graphics[{Module[{x,y},
                InequalityPlot[Conditions,{x,-3,3},{y,-3,3},Axes-> False,
                    DisplayFunction-> Identity][[1]]]}],
          AspectRatio-> Automatic,PlotRange-> All,Frame-> True],EPS[GGG]}]
      
(* Surface *)   

Surface[f1_,f2_,xinf_,xsup_,a_,b_,n_,r_,h_]:=
  Do[{resultat=
        "Aire de la surface = "<>ToString[NIntegrate[Abs[f1-f2],{x,a,b}]],
      GGG=Show[{Graphics[{Line[{{xinf,0},{xsup,0}}],Hue[h],
                Table[Rectangle[{a+(i*(b-a))/n,
                      f2/.x\[Rule](a+(i*(b-a))/n)},{a+((i+1)*(b-a))/n,
                      f1/.x\[Rule](a+((i+1)*(b-a))/n)}],{i,1,n-1}]},
              If[r\[NotEqual]0,AspectRatio\[Rule]Automatic,{}],
              PlotRange\[Rule]All,AxesOrigin\[Rule]{0,0},Frame\[Rule]True],
            Plot[{f1,f2},{x,xinf,xsup}],
            Graphics[{Dashing[{0.02}],
                Line[{{x,Max[f1,f2]},{x,0}}]/.{{x\[Rule]a},{x\[Rule]b}}},
              PlotRange\[Rule]All,AxesOrigin\[Rule]{0,0},
              DisplayFunction\[Rule]Identity]}],EPS[GGG]}]
              
  (* VolumeR *)
  
  VolumeR[f_,xmin_,xmax_]:=
  Do[{resultat=Integrate[2Pi*f^2,{x,xmin,xmax}],
      GGG=SurfaceOfRevolution[f,{x,xmin,xmax}],EPS[GGG]}]            
  
  (* Tangente *)
              
  Tangente[f_,xo_,g_,d_]:=
  With[{p=D[f,x]/.x\[Rule]xo,yo=(f/.x->xo)},
    Do[{resultat="equation de la tangente : y ="<>ToString[p x+yo-p xo],
        GGG=Show[{Plot[f,{x,xo-g,xo+d}],
              Graphics[{Hue[0.92],PointSize[.03],Point[{x,f}]/.x\[Rule]xo}],
              Graphics[Dashing[{0.02}]],Plot[p x+yo-p xo,{x,xo-g,xo+d}]}],
        EPS[GGG]}]]  
              
  (* TangenteImp *) 
  
 TangenteImp[F_,xo_,yo_,g_,d_]:=
  With[{p=ImplicitD[F,{xo,yo}]},
    Do[{resultat=ToString["equation de la tangente: y = 
"  ToString[p x+yo-p xo,TraditionalForm]],
        GGG=Show[{ImplicitPlot[F\[Equal]0,{x,xo-g,xo+d}],
              Graphics[{Hue[0.92],PointSize[.03],Point[{xo,yo}]}],
              Graphics[Dashing[{0.02}]],Plot[p x+yo-p xo,{x,xo-g,xo+d}]}],
        EPS[GGG]}]]
                  
 (* Secante *)        
 
 Secante[f_,a_,b_,xinf_,xsup_]:=With[{p = ((f /. x -> b) - (f /. x -> a))/(b - a)}, Do[{resultat = ToString["equation de la secante: y =" ToString[Simplify[(f /. x -> a) + p*(x - a)], TraditionalForm]], 
    GGG=Show[{Plot[f, {x, xinf, xsup}], Graphics[{Hue[0.92], PointSize[0.03], Point[{x, f}] /. x -> a, Point[{x, f}] /. x -> b}], Graphics[{Dashing[{0.02}],Line[{{a,f/.x\
\[Rule]a},{a,0}}],Line[{{a,f/\
.\
x\
\
\
\[Rule]\
a},{0,f/.x\
\
\[Rule]a}}],Line[\
{{b,\
f/.\
x\
\
\[Rule]b},{\
b,0}}\
],\
Line[{\
{b,\
f/.x\
\
\
\[Rule]b},{\
0,\
f/.x\
\[Rule]\
b}}]}\
\
], \
Graphics[RGBColor[0,0,1]],
       Plot[(f /. x -> a) + p*(t - a), {t, xinf, xsup}]}],EPS[GGG]}]]
       
  (* Normale *)     
       
       Normale[mu_,sgm_,a_,b_]:=
  Do[{Surface[Exp[-(x-mu)^2/(2 sgm^2)]/(Sqrt[2Pi]*sgm),0,a-(1.3+b-a)/2,
        b+(1.3+b-a)/2,a,b,200,0,0.44],
      resultat="P ="<>
          StringDrop[resultat,StringPosition[resultat,"="][[1]][[1]]]}]
          
          (* Horner *)


deg[p_]:=Exponent[(Catalan+p), x]
  c[p_,k_]:=Part[CoefficientList[p, x],k+1]
  c1[p_,k_,a_]:=If[k\[Equal]deg[p],"\[DownArrow]",c2[p,k+1,a]*a]
  c2[p_,k_,a_]:=If[k\[Equal]deg[p],c[p,deg[p]],c1[p,k,a]+c[p,k]]
  
  Horner[p_, a_] := Do[{resultat = StringJoin["Quotient = ", 
        ToString[Developer`PolynomialDivision[p, x - a, x][[1]], TraditionalForm], 
        "     R = ", ToString[Developer`PolynomialDivision[p, x - a, x][[2]], \

         TraditionalForm]], 
      GGG = GridBox[Transpose[Table[{c[p, k], c1[p, k, a], c2[p, k, a]}, 
            {k, deg[p], 0, -1}]], RowLines -> True, ColumnLines -> True], 
      EPS[GGG]}]
      
      (* EQDQ *)
      
      EQDQ[ch_,{xp_,yp_},{g_,d_,h_,b_}]:=
  With[{scale=(20Norm[ch]+10^(-5))/Sqrt[(g+d)^2+(h+b)^2]},
    EPS[Show[{Table[
          Graphics[{Hue[0.6],
              Arrow[{x,y}-ch/(2*scale),{x,y}+ch/(2*scale),
                HeadCenter\[Rule]0.16,HeadScaling\[Rule]Relative]}],{x,xp-g,
            xp+d,(g+d)/13},{y,yp-b,yp+h,(h+b)/13}],
        Graphics[{PointSize[((g+d)^2+(h+b)^2)^(1/5)/55],Hue[0.9],
            Point[{xp,yp}]}]},AspectRatio\[Rule]Automatic,Frame\[Rule]True]]]
            
            
      (* ys[champ,xp,yp] donne la solution particuliere de leqdiff et yg la solution generale *) 
      
   te[ch_]:=(ch[[2]]/ch[[1]])/.y\[Rule]yy[xx]/.x\[Rule]xx
     
   yg[ch_,t_]:=(yy[xx]/.DSolve[D[yy[xx],xx]\[Equal]te[ch],yy[xx],xx][[1]])/.xx\[Rule]t

   ys[ch_,t_,xp_,yp_]:=yg[ch,t]/.Solve[yg[ch,xp]\[Equal]yp,C[1]][[1]]

     (* EQDR *)
     
EQDR[ch_,{xp_,yp_},{g_,d_,h_,b_}]:=
  EPS[Show[{EQDQ[ch,{xp,yp},{g,d,h,b}],
      Plot[ys[ch,v,xp,yp],{v,xp-g,xp+d},
        PlotStyle\[Rule]{{Thickness[0.008],GrayLevel[0.3]}}]},
    PlotRange\[Rule]{yp-b,yp+h}]]
    
    (* Famille de courbes a un parametre k *)
    
    Famille[f_,{xmin_,xmax_},{ymin_,ymax_},{kmin_,kmax_,dk_}]:=
  EPS[Show[Table[Plot[f,{x,xmin,xmax}],{k,kmin,kmax,dk}],
    PlotRange\[Rule]{ymin,ymax},AspectRatio\[Rule]Automatic]]
   
      
            

EndPackage[]

Null