Théorème de Pascal

Cherchons une équation de la droite engendrée par deux points d'affixe donnée:

toReal[z_]:={Re[z], Im[z]}
eqDroite[a_, b_]:= (Det[
        {toReal[a]-{x,y}, toReal[b-a]}]==0) eqDroite[1+I, -2-3I]
[Graphics:Images/pascal_gr_1.gif]

Maintenant intersectons les côtés d'un quadrilatère:

intersect[a_,b_,c_,d_]:=First[
    {x,y}/.Solve[{eqDroite[a,b], eqDroite[c,d]},
                 {x,y}] ] dessin[a_,b_,c_,d_]:=Graphics[ {
        Line[{toReal[a], toReal[b]}],
        Line[{toReal[c], toReal[d]}],
        RGBColor[1,0,0], PointSize[0.03],
        Point[intersect[a,b,c,d] ]
                            }   ] Show[dessin[2+I, -1-I,2.5-2 I, -1+I] ];

[Graphics:Images/pascal_gr_2.gif]

Dessinons 6 points au hasard sur un cercle et traçons les intersections des côtés opposés:

{a,b,c,d,e,f}= Exp[2 I Pi Array[Random[]&, {6}] ];
Show[Graphics[Circle[{0,0},1]  ],
             dessin[a,b,d,e],
             dessin[b,c,e,f],
             dessin[c,d,f,a] ] ;

[Graphics:Images/pascal_gr_3.gif]

Faisons des variables a,b,...,f des complexes unimodulaires:

affecte[truc_, machin_]:=(    Re[truc]=Cos[machin]; 
                            Im[truc] = Sin[machin] )
Unprotect[Re, Im];
Clear[a,b,c,d,e,f];
affecte[a, aa];
affecte[b, bb];
affecte[c, cc];
affecte[d, dd];
affecte[e, ee];
affecte[f, ff];
Protect[Re, Im];

Démontrons le théorème de Pascal:

pt1 = intersect[a,b,d,e];
pt2 = intersect[b,c,e,f];
pt3 = intersect[c,d,f,a];

Vérifions que les trois points sont alignés:

Det[{pt1 - pt2, pt1 - pt3}]//Simplify
[Graphics:Images/pascal_gr_4.gif]


Converted by Mathematica      October 2, 2000