Cours d'introduction à
Mathematica 3.0

par
Nicolas Martignoni
Collège Sainte-Croix
1700 Fribourg (Suisse)
Version 2.0

© Copyright 1992-1998 Nicolas Martignoni.
Tous droits réservés.

Chapitre cinquième:

Solutions aux exercices

Chapitre premier: notions de base

1.3. Exercices

Exercice 1

Pour faire cet exercice, il suffit de placer le pointeur dans chaque cellule et de taper ou .

Une solution plus expéditive, mais moins instructive est l'utilisation de la commande Evaluate Notebook du menu Kernel, article Evaluation.

Exercice 2

Première solution:

?Plot*

Plot         Plot3Matrix  PlotJoined   PlotPoints   PlotRegion
Plot3D       PlotDivision PlotLabel    PlotRange    PlotStyle

ou bien

Information["Plot*"]

Plot         Plot3Matrix  PlotJoined   PlotPoints   PlotRegion
Plot3D       PlotDivision PlotLabel    PlotRange    PlotStyle

Deuxième solution:

Pour la deuxième partie de l'exercice, il n'existe que la première solution:

?*Graphic*

ContourGraphics  Graphics         GraphicsData
DensityGraphics  Graphics3D       GraphicsSpacing
EmbeddedGraphics GraphicsArray    SurfaceGraphics
FullGraphics

ou bien

Information["*Graphic*"]

ContourGraphics  Graphics         GraphicsData
DensityGraphics  Graphics3D       GraphicsSpacing
EmbeddedGraphics GraphicsArray    SurfaceGraphics
FullGraphics

Exercice 3

Les parenthèses servent uniquement à marquer le groupement. Les crochets sont utilisés pour marquer les arguments des fonctions. Les accolades délimitent les listes de Mathematica. Les doubles crochets servent à extraire un ou plusieurs éléments d'une liste.

Exercice 4

La commande Why The Beep?... montre la fenêtre suivante.

Il semble donc que la chaîne de caractères cherchée soit absente du fichier. En fait, s'il est inscrit malgré tout dans ce notebook, c'est que j'ai triché: j'ai introduit un espace invisible à l'intérieur du mot. Ce n'est donc en fait plus la même chaîne de caractères.

Exercice 5

En tapant le mot «factoring» dans la fenêtre de l'aide et en cliquant sur le bouton Master Index, on obtient entre autres

Cela nous donne notre réponse, avec FactorInteger pour factoriser les entiers et Factor pour factoriser les polynômes. On obtient notamment les exemples suivants en recherchant directement ces fonctions à l'aide du bouton Built-in Functions.

{{641, 1}, {6700417, 1}}

Factor[x17 + 1]

Exercice 6

N[, 770]

3.14159265358979323846264338327950288419716939937510582097494459\
   2307816406286208998628034825342117067982148086513282306647093\
   8446095505822317253594081284811174502841027019385211055596446\
   2294895493038196442881097566593344612847564823378678316527120\
   1909145648566923460348610454326648213393607260249141273724587\
   0066063155881748815209209628292540917153643678925903600113305\
   3054882046652138414695194151160943305727036575959195309218611\
   7381932611793105118548074462379962749567351885752724891227938\
   1830119491298336733624406566430860213949463952247371907021798\
   6094370277053921717629317675238467481846766940513200056812714\
   5263560827785771342757789609173637178721468440901224953430146\
   5495853710507922796892589235420199561121290219608640344181598\
   136297747713099605187072113499999984

On remarque que les chiffres 763 à 768 sont six 9.

Exercice 7

On trouve dans l'aide en utilisant le mot «physical» (comme physical constants) un package appelé PhysicalConstants. Pour le charger, il existe en fait au moins trois solutions:

Get["Miscellaneous`PhysicalConstants`"]

<< Miscellaneous`PhysicalConstants`

Needs["Miscellaneous`PhysicalConstants`"]

Les deux premières sont strictement équivalentes (la deuxième est une abréviation de la première). Dans ces deux cas, Mathematica tente de charger le package, même s'il l'avait déjà été dans la même session. Avec la fonction Needs, le package ne sera chargé que s'il ne l'était pas déjà. Cette solution est la meilleure, pour des raisons de performance et de sécurité.

Pour finir l'exercice, on trouve avec un peu d'astuce

AccelerationDueToGravity

ou bien on calcule à l'aide de la loi de la gravitation universelle :

g =  (GravitationalConstant * EarthMass)/EarthRadius2

Clear[g]

Exercice 8

l = Range[20, 2, -2]

{20, 18, 16, 14, 12, 10, 8, 6, 4, 2}

(l[[3]] + l[[5]] + l[[7]])/l[[1]]

9
-
5

N[%]

1.8

Clear[l]

Exercice 9

Table[Prime[k], {k, 10}]

{2, 3, 5, 7, 11, 13, 17, 19, 23, 29}

Chapitre deuxième: utilisation de Mathematica

2.1. Formatage de l'input et de l'output

Exercice 10

Il suffit de commencer par la structure extérieure (ici, la racine carrée). La solution avec palette est évidente. Voici la solution avec les raccourcis-clavier. Le symbole désigne un espace.

2 / 3Sin[x] ^ 2 +2Sin[x]-4 Cos[x] ^ 2 +2

Exercice 11

La solution avec la commande Create Table/Matrix/Palette est dans ce cas la plus rapide, puisqu'il est possible de spécifier l'élément de la diagonale (Fill diagonal). Avec la palette, c'est encore évident. La solution avec le clavier est donnée ci-dessous.

( , , 1 2 ... 1 )

Exercice 12

La solution est la même que pour l'exercice 10, à part le caractère qui se tape j.

2 / 3Sin[j] ^ 2 +2Sin[j]-4 Cos[j] ^ 2 +2

2.2. Variables, précision des nombres

Exercice 13

La lettre s'obtient par scl (pour «script l»). La fonction Table permet de construire la liste voulue, à l'aide de la fonction Fibonacci.

 = Table[Fibonacci[i], {i, 10}]

{1, 1, 2, 3, 5, 8, 13, 21, 34, 55}

3

{1, 1, 8, 27, 125, 512, 2197, 9261, 39304, 166375}

Clear[]

2.3. Calcul numérique

Exercice 14

Rationalize[, 10-2]

22
--
7

Rationalize[, 10-3]

355
---
113

Rationalize[, 10-7]

104348
------
33215

Rationalize[, 10-10]

312689
------
99532

N[312689/99532] - 

2.91434*^-11

Exercice 15

21971/3

13

10!

3628800

La fonction factorielle peut s'écrire aussi Factorial:

Factorial[10]

3628800

Log[10.]

2.30259

Log[10, 1025.]

3.01072

Exp[5.]

148.413

On peut aussi écrire pour l'exponentielle

E5.

148.413

{Sin[/3], Cos[/3], Tan[/3]}

 Sqrt[3]  1
{-------, -, Sqrt[3]}
    2     2

{Sin[3 /4], Cos[3 /4], Tan[3 /4]}

    1          1
{-------, - -------, -1}
 Sqrt[2]    Sqrt[2]

Exercice 16

Le caractère ° s'obtient soit directement au clavier, soit par le raccourci deg. Il est interprété directement comme valant /180.

{Sin[30°], Cos[30°], Tan[30°]}

 1  Sqrt[3]     1
{-, -------, -------}
 2     2     Sqrt[3]

{Sin[45°], Cos[45°], Tan[45°]}

    1        1
{-------, -------, 1}
 Sqrt[2]  Sqrt[2]

Exercice 17

Pour obtenir l'unité imaginaire, on peut saisir soit I, soit le caractère spécial par le raccourci ii.

(2 + 4 I) (5 - 3 I)

22 + 14 I

(2 + 4 I)/(5 - 3 I)

  1    13 I
- -- + ----
  17    17

{Arg[%], Conjugate[%]}

                   1    13 I
{ - ArcTan[13], - -- - ----}
                   17    17

Exercice 18

Cet exercice peut être effectué en une ligne, à l'aide de deux commandes Table imbriquées:

Table[Table[Random[Real, {0, 10}], {3}], {5}]

{{1.95643, 5.50709, 7.50504}, {2.06129, 7.6552, 8.25729},
 {5.33075, 8.22366, 2.78354}, {3.41984, 5.03797, 0.0535112},
 {5.66278,8.47644,6.76731}}

Exercice 19

On commence par définir deux vecteurs quelconques u et v.

u = {a, b, c};
v = {d, e, f};

On calcule ensuite le produit vectoriel w = u v.

w = u  v

{-c e + b f, c d - a f, -b d + a e}

Reste à vérifier à l'aide du produit scalaire que w est perpendiculaire à u et à v.

Simplify[{u . w, v . w}]

{0, 0}

Clear[u, v, w]

Exercice 20

m = {{1, 2, 3}, {2, 3, 4}, {3, 4, 5}};

La définition du polynôme caractéristique d'une matrice n x n est , où est la matrice unité d'ordre n. Dans notre exercice, cela donne:

Det[ m - x IdentityMatrix[3] ]

6 x + 9 x2 - x3

Les valeurs propres de m sont:

Solve[% == 0]

                 1                         1
{{x -> 0}, {x -> - (9 - Sqrt[105])}, {x -> - (9 + Sqrt[105])}}
                 2                         2

Clear[m]

2.4. Calcul symbolique

Exercice 21

Expand[(x - 2) (x - 1) x (x + 1) (x + 2)]

4 x - 5 x3 + x5

Factor[24 - 50 x + 35 x2 - 10 x3 + x4]

(-4 + x) (-3 + x) (-2 + x) (-1 + x)

Exercice 22

PolynomialDivision[x10 - 210, x - 2, x]

{512 + 256 x + 128 x2 + 64 x3 + 32 x4 + 16 x5 + 8 x6 + 4 x7 + 2 x8 + x9, 0}

Together[a + b - (2 a b)/(a + b)]

a2 + b2
------
a + b

Simplify[(Sqrt[a] - Sqrt[b]) (Sqrt[a] + Sqrt[b])]

a - b

La fonction FullSimplify est nécessaire pour simplifier la dernière expression:

FullSimplify[ArcCos[Sqrt[1 - x]]]

ArcSin[Sqrt[x]]

Exercice 23

a = TrigExpand[(Cos[x] + I Sin[x])2]

      2                             2
Cos[x]  + 2 I Cos[x] Sin[x] - Sin[x]

b = TrigReduce[(Cos[x] + I Sin[x])2]

Cos[2 x] + I Sin[2 x]

La comparaison des parties réelles et imaginaires donne les égalités cherchées (la fonction ComplexExpand est nécessaire: elle suppose que la variable x est réelle).

ComplexExpand[Re[a] == Re[b]]

Cos[x]2 - Sin[x]2 == Cos[2 x]

ComplexExpand[Im[a] == Im[b]]

2 Cos[x] Sin[x] == Sin[2 x]

Clear[a, b]

2.5. Analyse mathématique

Exercice 24

Solve[y3 - 2 y + 1 == 0, y]

                 1                        1
{{y -> 1}, {y -> - (-1 - Sqrt[5])}, {y -> - (-1 + Sqrt[5])}}
                 2                        2

N[%]

{{y -> 1.}, {y -> -1.61803}, {y -> 0.61803}}

Solve[{x2 + y2 == 8, (x - 7)2 + (y + 1)2 == 4}, {x, y}]

       1                            1
{{x -> -- (189 - I Sqrt[329]), y -> -- (-27 - 7 I Sqrt[329])},
       50                           50

       1                            1
 {x -> -- (189 + I Sqrt[329]), y -> -- (-27 + 7 I Sqrt[329])}}
       50                           50

Exercice 25

Méthode de Newton (deux essais):

FindRoot[Cos[x] - (3 Sqrt[2])/5, {x, 0}]

FindRoot :: jsing :  Encountered a singular Jacobian at the point
  x = 0.`. Try perturbing the initial point(s).

                  3 Sqrt[2]
FindRoot[Cos[x] - ---------, {x, 0}]
                      5

FindRoot[Cos[x] - (3 Sqrt[2])/5, {x, 1}]

{x -> 0.557599}

Méthode de la sécante:

FindRoot[Cos[x] - (3 Sqrt[2])/5, {x, {0, 1}}]

{x -> 0.557599}

Exercice 26

Simplify[D[A/(Ea(t - t1) + 1), {t, 2}]]

a2 A Ea(t - t1) (-1 + Ea(t - t1))
---------------------------
      (1 + Ea(t - t1))3

% /. t -> t1

0

D[f[x] g[x], x]

g[x] f'[x] + f[x] g'[x]

Together[D[f[x]/g[x], x]]

g[x] f'[x] - f[x] g'[x]
-----------------------
         g[x]2

Exercice 27

Les deux solutions suivantes sont possibles, mais la deuxième est préférable, pour des raisons pédagogiques et esthétiques.

Integrate[(x2 + 1)/E2x, x] // Together

  1
- - E-2 x(3 + 2 x + 2 x2)
  4

  1
- - E-2 x(3 + 2 x + 2 x2)
  4

Exercice 28

a3 b    a b3
---- + ----
 3      3

a4
--
3

Exercice 29

Normal[Series[Sin[x], {x, 0, 10}]]

    x3   x5     x7      x9x - - + --- - ---- + ------
    6   120   5040   362880

Factor[%]

x (362880 - 60480 x2 + 3024 x4 - 72 x6 + x8)
-------------------------------------------
                  362880

2.6. Fonctions, éléments de programmation

Exercice 30

f[x_, y_] := x + y

g[x_, x_] := x + x

f[2, 3]

5

f[2, 2]

4

g[2, 3]

g[2, 3]

g[2, 2]

4

Clear[f, g]

Exercice 31

delta[a_, b_, c_] := b2 - 4 a c

solutions[3, 1, -1]

 1                  1
{- (-1 + Sqrt[13]), - (-1 - Sqrt[13])}
 2                  2

Clear[delta, solutions]

2.7. Graphiques

Exercice 32

Plot[Tan[x], {x, -, }]

- Graphics -

Plot3D[Sin[x y], {x, -, }, {y, -, }]

- SurfaceGraphics -

Exercice 33

Plot[Tan[x], {x, -, }, AxesLabel -> {t, Tan[t]},
 DefaultFont -> {"Times", 10} , FormatType -> TraditionalForm,
 Frame -> True]

- Graphics -

Exercice 34

ParametricPlot[{Cos[t] Cos[3 t], Sin[t] Cos[3 t]}, {t, 0, 2 },
 AspectRatio -> Automatic, DefaultFont -> {"Times", 10},
 FormatType -> TraditionalForm, PlotLabel -> "Trèfle"]

- Graphics -

Exercice 35

Plot[Floor[x], {x, -3, 3}, AspectRatio -> Automatic]

- Graphics -

En sélectionnant le graphique et en maintenant la touche enfoncée, on obtient par exemple:

La commande Paste du menu Edit colle la liste suivante:

l ={{-2.34006, 0.784684}, {-2.29612, 0.806656}, 
{-2.16428, 0.828629}, {-2.05442, 0.828629}, 
{-1.92259, 0.828629}, {-1.79075, 0.828629}, 
{-1.70286, 0.806656}, {-1.61497, 0.806656}, 
{-1.52708, 0.762711}, {-1.41722, 0.696794}, 
{-1.28539, 0.630877}, {-1.15355, 0.521015}, 
{-1.04369, 0.411153}, {-0.933828, 0.257346}, 
{-0.823966, 0.125512}, {-0.692131, -0.0502674}, 
{-0.538324, -0.248019}, {-0.362545, -0.423798}, 
{-0.208738, -0.62155}, {-0.0329592, -0.797329}, 
{0.14282, -0.929163}, {0.340572, -1.08297}, 
{0.538323, -1.2148}, {0.69213, -1.32467}, 
{0.867909, -1.39058}, {1.04369, -1.47847}, 
{1.24144, -1.58834}, {1.50511, -1.65425}, 
{1.70286, -1.6982}, {1.85667, -1.72017}, 
{1.9885, -1.74214}, {2.07639, -1.76411}, 
{2.12034, -1.76411}, {2.14231, -1.78609}};

On peut ensuite dessiner cette liste de points avec la fonction ListPlot.

ListPlot[l, PlotJoined -> True,
 Epilog -> {PointSize[.012], Point /@ l}]

- Graphics -

Clear[l]

Exercice 36

Après avoir chargé le package adéquat,

Needs["Graphics`Animation`"]

on évalue la cellule suivante:

MoviePlot[a x2, {x, -3, 3}, {a, 0, 2, .25},
 PlotRange -> {0, 10}, PlotLabel -> StyleForm[
   SequenceForm["Paramètre = ", a], FontFamily -> "Times"]]

Chapitre troisième: aspects avancés

3.1. Expressions

Exercice 37

La principale difficulté pour résoudre cet exercice consiste à voir que la division est toujours interprétée comme une multiplication par l'inverse. La forme complète de l'expression y/x est par exemple:

FullForm[y/x]

Times[Power[x, -1], y]

De façon analogue, la soustraction est l'addition de l'opposé:

FullForm[y - x]

Plus[Times[-1, x], y]

Voici la solution exacte:

FullForm[(x3 + 2 x2 - 3 x - 3)/(x2 - 1)]

Times[Power[Plus[-1, Power[x, 2]], -1],
 Plus[-3, Times[-3, x], Times[2, Power[x, 2]], Power[x, 3]]]

Exercice 38

Une fois la structure de l'expression connue, on voit que -3 x correspond en fait à Times[-3,x] (voir ci-dessus). Il s'agit du deuxième élément du Plus[...], qui est lui-même le deuxième élément du Times[...]:

(x3 + 2 x2 - 3 x - 3)/(x2 - 1)[[2, 2]]

-3 x

Exercice 39

La définition de la fonction somme est faite en respectant la règle des minuscules. On produit d'abord la liste de n premiers nombres entiers avec Range[n], puis on change le head de l'expression trouvée (List) par Plus avec la fonction Apply.

somme[n_] := Apply[Plus, Range[n]]

somme[9999]

49995000

Clear[somme]

Exercice 40

On se souvient de la fonction Apart (chapitre 2) qui décompose une expression en somme de fractions partielles.

Apart[(x3 + 2 x2 - 3 x - 3)/(x2 - 1)]

        3                1
2 - ---------- + x - ---------
    2 (-1 + x)       2 (1 + x)

On change le head de cette expression en List:

Apply[List, %]

          3                1
{2, - ----------, x, - ---------}
      2 (-1 + x)       2 (1 + x)

puis on applique à chacun des éléments de cette liste la fonction Numerator, avec Map:

Map[Numerator, %]

{2, -3, x, -1}

En fait, la fonction Numerator possède automatiquement la propriété de se «distribuer» sur les éléments d'une expression. La donnée suivante aurait donc suffi:

Numerator[%%]

{2, -3, x, -1}

Ces opérations successives peuvent être rassemblées en une seule fonction:

partialDenominators[q_] := Numerator[Apply[List, Apart[q]]]

partialDenominators[(x3 + 2 x2 - 3 x - 3)/(x2 - 1)]

{2, -3, x, -1}

Exercice 41

Il suffit d'appliquer à l'aide de Map la fonction pure suivante:

Function[Round[#/0.1] 0.1]

      #1
Round[---] 0.1&
      0.1

ou bien celle-ci (forme abrégée):

Round[#/0.1] 0.1&

      #1
Round[---] 0.1&
      0.1

à chaque élément de la liste de nombre.

arrondiDixieme[liste_] := Map[Round[#/0.1] 0.1&, liste]

arrondiDixieme[{1.25, 1.33, 1.56, 1.83}]

{1.2, 1.3, 1.6, 1.8}

Pour la généralisation, on doit simplement remplacer dans la fonction pure le nombre 0.1 par l'arrondi désiré. Cet arrondi est le deuxième paramètre de la fonction arrondi.

arrondi[liste_, n_] := Map[Round[#/n] n&, liste]

Voici quelques exemples d'utilisation:

arrondi[{1.25, 1.33, 1.56, 1.83}, .1]

{1.2, 1.3, 1.6, 1.8}

arrondi[{1.25, 1.33, 1.56, 1.83}, 1/2]

    3  3
{1, -, -, 2}
    2  2

arrondi[{1.25, 1.33, 1.56, 1.83}, .5]

{1., 1.5, 1.5, 2.}

arrondi[{1.25, 1.33, 1.56, 1.83}, .05]

{1.25, 1.35, 1.55, 1.85}

arrondi[{1.25, 1.33, 1.56, 1.83}, 1]

{1, 1, 2, 2}

Clear[arrondiDixieme, arrondi]

3.2. Graphiques (suite)

Exercice 42

On observe que la liste demandée est «entourée» dans l'ordre de la fonction Line, puis de deux List et enfin du head Graphics. Il faut donc écrire:

Plot[Floor[x], {x, -1, 2}, DisplayFunction -> Identity]
  [[1, 1, 1, 1]]

{{-1., -1.}, {-0.878299, -1.}, {-0.745574, -1.}, {-0.620922, -1.},
{-0.501045, -1.}, {-0.373442, -1.}, {-0.250614, -1.},
{-0.188013, -1.}, {-0.120061, -1.}, {-0.0883151, -1.},
{-0.054661, -1.}, {-0.025929, -1.}, {-0.0180571, -1.},
{-0.00958929, -1.}, {-0.00549122, -1.}, {-0.00159563, -1.},
{0.00190111, 0.}, {0.00571797, 0.}, {0.133751, 0.}, {0.25701, 0.},
{0.387993, 0.}, {0.514203, 0.}, {0.635638, 0.}, {0.764798, 0.},
{0.829127, 0.}, {0.889183, 0.}, {0.946911, 0.}, {0.963533, 0.},
{0.97928, 0.}, {0.986135, 0.}, {0.993417, 0.}, {0.997214, 0.},
{0.999375, 0.}, {1.0014, 1.}, {1.00496, 1.}, {1.00879, 1.},
{1.13839, 1.}, {1.2632, 1.}, {1.38324, 1.}, {1.51101, 1.},
{1.634, 1.}, {1.76472, 1.}, {1.89066, 1.}, {2., 1.}}

L'option DisplayFunction -> Identity permet d'éviter le dessin du graphique.

Exercice 43

L'expression suivante calcule les coordonnées d'un pentagone régulier:

pentagone = Table[{Cos[2/5 k ], Sin[2/5 k ]}, {k, 0, 5}] // N

{{1., 0}, {0.309017, 0.951057}, {-0.809017, 0.587785},
{-0.809017, -0.587785}, {0.309017, -0.951057}, {1., 0}}

Avec la fonction Line, on obtient une figure vide. Pour fermer le polygone, il est nécessaire de répéter le premier élément de la liste à la fin. Pour cette raison, la liste pentagone produite ci-dessus comporte en fait 6 éléments.

Show[Graphics[{Line[pentagone]}], AspectRatio -> Automatic]

- Graphics -

La fonction Polygon appliquée à la même liste donne une figure pleine (surface).

Show[Graphics[{Polygon[pentagone]}],
 AspectRatio -> Automatic]

- Graphics -

Dans le cas de Polygon, il n'est pas obligatoire de répéter le premier point en fin de liste.

Clear[pentagone]

Pour la deuxième partie de l'exercice, il est judicieux de construire une fonction accessoire qui calcule les coordonnées des sommets du polygone à n côtés:

sommets[n_] :=
 N[Table[{Cos[(2 k )/n], Sin[(2 k )/n]}, {k, 0, n}]]

On recopie ce que l'on a fait plus haut en introduisant la fonction sommets au bon endroit. voici la solution avec Line:

polygone[n_] :=
 Show[Graphics[{Line[sommets[n]]}], AspectRatio -> Automatic]

et celle avec Polygon:

polygone[n_] :=
 Show[Graphics[{Polygon[sommets[n]]}], AspectRatio -> Automatic]

polygone[11]

- Graphics -

Clear[sommets, polygone]

Exercice 44

Voici une solution. On change la couleur en bleu, on trace ensuite le polygone, on change à nouveau la couleur (orange) et l'épaisseur du trait, et pour terminer, on dessine le contour du polygone, sans oublier de répéter le premier point à la fin de la liste.

Show[Graphics[{RGBColor[0, 0, 1],
 Polygon[{{-0., 0.15}, {0.3, 0}, {-0.1, -0.7}, {-0., -0.3}}],
 RGBColor[1, .5, 0], Thickness[.012],
 Line[{{-0., 0.15}, {0.3, 0}, {-0.1, -0.7},
  {-0., -0.3}, {-0., 0.15}}]}]]

- Graphics -

Exercice 45

Nous définissons d'abord le cube.

cube = Cuboid[{-.75, -.75, -.75}, {.75, .75, .75}];

Voici maintenant les axes, avec la même épaisseur de trait et le même traitillé. Les axes perpendiculaires aux faces sont dessinés en bleu ciel. Les axes correspondant aux diagonales sont dessinés en orange.

axes = {Dashing[{.03, .02}], Thickness[.01],
 RGBColor[0, .5, 1], Line[{{0, -Sqrt[2], 0}, {0, Sqrt[2], 0}}],
 Line[{{0, 0, -Sqrt[2]}, {0, 0, Sqrt[2]}}],
 Line[{{-Sqrt[2], 0, 0}, {Sqrt[2], 0, 0}}],
 RGBColor[1, .5, 0], Line[{{1, 1, 1}, {-1, -1, -1}}],
 Line[{{-1, 1, 1}, {1, -1, -1}}],
 Line[{{1, -1, 1}, {-1, 1, -1}}],
 Line[{{1, 1, -1}, {-1, -1, 1}}]};

Pour terminer, on représente le tout:

Show[Graphics3D[{cube, axes}], Boxed -> False,
 ViewPoint -> {1.2, -3, 0.7}]

- Graphics3D -

Clear[cube, axes]

3.3. Programmation avec Mathematica

Exercice 46

Cette façon de programmer la fonction factorielle n'est pas la plus intuitive. Elle nécessite deux variables temporaires i et result. Cette dernière stocke le résultat intermédiaire, alors que i multiplie ce résultat en augmentant de 1 à chaque itération.

factorielle[n_] :=
 Block[{result = 1}, Do[result = result x i, {i, n}]; result]

factorielle[0]

1

factorielle[10]

3628800

Clear[factorielle]

Exercice 47

L'algorithme d'Euclide ne fait que remplacer les deux nombres initiaux {a, b} par {b, Mod[a, b]}, où la fonction Mod[x, y] donne le reste de la division de x par y. Le processus se termine quand le premier terme de la liste est nul. Le pgcd de a et b est alors le deuxième élément de cette dernière liste. Cet algorithme fonctionne aussi pour les nombres négatifs, d'où l'initialisation des variables avec la valeur absolue Abs.

pgcd[a_, b_] := Block[{x = Abs[a], y = Abs[b]},
  While[y > 0, {x, y} = {y, Mod[x, y]}]; x]

pgcd[1517, 3589]

37

Clear[pgcd]

Exercice 48

Si a est le nombre dont on veut la racine et x₀ l'estimation initiale, on a en 10 itérations:

racine[a_, x0_] := Nest[1/2 (# + a/#)&, x0, 10]

racine[5, N[1, 500]]

2.23606797749978969640917366873127623544061835961152572427089724\
   5410520925637804899414414408378782274969508176150773783504253\
   2677244470738635863601215334527088667781731918791658112766453\
   2263985658053576135041753378500342339241406444208643253909725\
   2592627228876299517402440681611775908909498492371390729728898\
   4820886415426898940991316935770197486788844250897541329561831\
   7692149997742480153043411503595766833251249881517813940800060\
   6458873369240614325762909733273659324040105236834548324368335\
   7637447055

Il est nécessaire d'utiliser une approximation comme estimation initiale, sans quoi le résultat sera un nombre fractionnaire exact. On peut vérifier la bonne qualité de l'algorithme en utilisant la fonction prédéfinie:

Sqrt[5] - %

-4.4038018125698378769656603390453425230708122302874801972097134\
    4219950913 * 10-428

Clear[racine]

Exercice 49

Voici l'implémentation de la méthode de Newton à l'aide d'une fonction pure:

newton[f_, x0_] := FixedPoint[# - f[#]/f'[#]&, x0]

Pour obtenir une approximation de , il suffit de se souvenir que /2 est un zéro de la fonction Cos.

2 newton[Cos, N[1, 40]]

3.1415926535897932384626433832795028842

Precision[%]

39

N[, 40]

3.141592653589793238462643383279502884197

Precision[%]

40

On remarque que pour avoir 40 décimales exactes, il est nécessaire de partir avec une estimation plus précise.

2 newton[Cos, N[1, 45]]

3.141592653589793238462643383279502884197169

Precision[%]

44

Clear[newton]

Exercice 50

La fonction de deux variables à trouver doit multiplier son premier argument par 10 et ajouter le deuxième: :

Function[{x, y}, 10 x + y][12, 7]

127

Voici sa forme abrégée:

10 #1 + #2& [12, 7]

127

Avec la fonction FoldList, et en prenant 0 comme deuxième argument, on a le résultat suivant:

FoldList[10 #1 + #2&, 0, {1, 9, 2, 8, 3, 7, 4, 6}]

{0, 1, 19, 192, 1928, 19283, 192837, 1928374, 19283746}

Nous n'avons besoin que du dernier élément de la liste, nous employons donc Fold. Cela donne la fonction

nombre[l_List] := Fold[10 #1 + #2&, 0, l]

nombre[Range[7]]

1234567

Clear[nombre]

Exercice 51

La première partie de l'exercice utilise un simple If avec la fonction Mod, que nous avons déjà vue plus haut.

divise[m_, n_] := If[Mod[n, m] == 0, True, False]

divise[37, 49247]

True

divise[2, 3]

False

Clear[divise]

La fonction signum s'écrit quasiment de la même façon en Mathematica qu'en mathématiques classiques.

signum[x_] := -1 /; x < 0
signum[x_] := 0 /; x = 0
signum[x_] := 1 /; x > 0

Plot[signum[x], {x, -2, 2}]

- Graphics -

Clear[signum]

Exercice 52

Nous voulons une liste d'entiers comme argument, c'est pourquoi nous écrivons:

mult = Compile[{{liste, _Integer, 1}}, Apply[Times, liste]];

La fonction elle-même est simple: elle consiste à chager le head de la liste par Times. Voici un petit test:

mult[{1, 3, 5, 7, 9}] == 1 * 3 * 5 * 7 * 9

True

Clear[mult]

Exercice 53

Voici deux solutions à cet exercice:

factorielle[n_Integer] := Apply[Times, Range[n]]

factorielle[n_Integer] := Fold[Times, 1, Range[n]]

factorielle[12]

479001600

Clear[factorielle]

Chapitre quatrième: appendices

4.1. Quelques problèmes intéressants

4.1.1. Graduations «sur mesure»

L'option Ticks permet d'obtenir le résultat désiré. Elle prend comme argument une liste de deux listes de nombres, représentant les abscisses et les ordonnées des graduations sur les axes. Dans notre cas, la première liste de nombres (pour les abscisses) est fabriquée à l'aide de Table. La deuxième liste est remplacée par Automatic, ce qui signifie que Mathematica va choisir les graduations au mieux.

Plot[Sin[x], {x, -, },
 Ticks -> {Table[(n )/3, {n, -3, 3}], Automatic}];

4.1.2. Pgcd

Nous définissons d'abord la règle pgcd (a, 0) = a, ce qui donne la condition de terminaison de l'algorithme.

pgcd[a_Integer, 0] := a

Il suffit ensuite d'écrire la règle générale, d'après la définition mathématique:

pgcd[a_Integer, b_Integer] := pgcd[b, Mod[a, b]]

On remarque que notre programme fonctionne aussi avec les entiers négatifs.

pgcd[-1027 - 35, 1035 - 10]

45

Clear[pgcd]

4.1.3. «Racine numérique»

La fonction IntegerDigits donne la liste des chiffres d'un nombre.

{1, 7, 9, 7, 6, 9, 3, 1, 3, 4, 8, 6, 2, 3, 1, 5, 9, 0, 7, 7, 2, 9,
   3, 0, 5, 1, 9, 0, 7, 8, 9, 0, 2, 4, 7, 3, 3, 6, 1, 7, 9, 7,
   6, 9, 7, 8, 9, 4, 2, 3, 0, 6, 5, 7, 2, 7, 3, 4, 3, 0, 0, 8,
   1, 1, 5, 7, 7, 3, 2, 6, 7, 5, 8, 0, 5, 5, 0, 0, 9, 6, 3, 1,
   3, 2, 7, 0, 8, 4, 7, 7, 3, 2, 2, 4, 0, 7, 5, 3, 6, 0, 2, 1,
   1, 2, 0, 1, 1, 3, 8, 7, 9, 8, 7, 1, 3, 9, 3, 3, 5, 7, 6, 5,
   8, 7, 8, 9, 7, 6, 8, 8, 1, 4, 4, 1, 6, 6, 2, 2, 4, 9, 2, 8,
   4, 7, 4, 3, 0, 6, 3, 9, 4, 7, 4, 1, 2, 4, 3, 7, 7, 7, 6, 7,
   8, 9, 3, 4, 2, 4, 8, 6, 5, 4, 8, 5, 2, 7, 6, 3, 0, 2, 2, 1,
   9, 6, 0, 1, 2, 4, 6, 0, 9, 4, 1, 1, 9, 4, 5, 3, 0, 8, 2, 9,
   5, 2, 0, 8, 5, 0, 0, 5, 7, 6, 8, 8, 3, 8, 1, 5, 0, 6, 8, 2,
   3, 4, 2, 4, 6, 2, 8, 8, 1, 4, 7, 3, 9, 1, 3, 1, 1, 0, 5, 4,
   0, 8, 2, 7, 2, 3, 7, 1, 6, 3, 3, 5, 0, 5, 1, 0, 6, 8, 4, 5,
   8, 6, 2, 9, 8, 2, 3, 9, 9, 4, 7, 2, 4, 5, 9, 3, 8, 4, 7, 9,
   7, 1, 6, 3, 0, 4, 8, 3, 5, 3, 5, 6, 3, 2, 9, 6, 2, 4, 2, 2,
   4, 1, 3, 7, 2, 1, 6}

En remplaçant le head de cette liste par Plus, on obtient la somme des chiffres:

1375

À l'aide de la fonction FixedPoint, on applique ce procédé jusqu'à ce que le résultat ne change plus. La fonction digitalRoot est définie en combinant ces étapes.

digitalRoot[n_Integer] :=
 FixedPoint[Apply[Plus, IntegerDigits[#]]&, n]

digitalRoot[2^2^10]

7

Clear[digitalRoot]

4.1.4. Écart-type

On définit d'abord une fonction annexe moyenne qui calcule la moyenne d'une liste de nombres:

moyenne[l_List] := Apply[Plus, l]/Length[l]

data = {4, 7, 8, 5, 5, 3};

moyenne[data] // N

5.33333

Pour l'écart-type, on construit d'abord la liste des écarts à la moyenne. Pour ce faire, on soustrait la moyenne à chaque nombre de l'échantillon.

data - moyenne[data]

   4  5  8    1    1    7
{- -, -, -, - -, - -, - -}
   3  3  3    3    3    3

L'écart-type est la racine de la moyenne arithmétique du carré de cette liste:

Sqrt[moyenne[(data - moyenne[data])2]] // N

1.69967

La fonction ecartType rassemble tout ceci en une ligne.

ecartType[l_List] := Sqrt[moyenne[(l - moyenne[l])2]]

ecartType[data] // N

1.69967

Clear[moyenne, ecartType]

4.1.5. Nombres palindromes

Nous utilisons la fonction IntegerDigits pour obtenir la liste des chiffres de l'input et la fonction Reverse, qui inverse l'ordre d'une liste.

Reverse[IntegerDigits[123456]]

{6, 5, 4, 3, 2, 1}

Il suffit alors de reconstruire le nombre avec Fold et une fonction pure bien choisie (sujet d'un exercice précédent).

Fold[10 #1 + #2&, 0, Reverse[IntegerDigits[123456]]]

654321

renverse[n_Integer] :=
 Fold[10 #1 + #2&, 0, Reverse[IntegerDigits[n]]]

renverse[123456789]

987654321

La fonction qui teste si le nombre est palindrome calcule simplement si l'input est égale au nombre renversé:

palindromeQ[n_Integer] := n == renverse[n]

palindromeQ[123575321]

True

Clear[renverse, palindromeQ]

4.1.6. Pgcd généralisé

L'exercice plus haut nous permet de calculer le pgcd de deux nombres entiers. Nous allons profiter de ces deux instructions pour généraliser notre programme.

pgcd[a_Integer, 0] := a

pgcd[a_Integer, b_Integer] := pgcd[b, Mod[a, b]]

Nous savons de la théorie algébrique que pgcd (a, b, c) = pgcd (pgcd (a, b), c). Il nous suffit donc de transcrire directement cette règle en Mathematica.

pgcd[a_Integer, b_Integer, c__Integer] := pgcd[pgcd[a, b], c]

On remarque que dans cette définition, le dernier argument est suivi non pas d'un Blank, mais de deux soulignés successifs, forme appelée BlankSequence. Cela signifie simplement que ce paramètre pourra être remplacé par une ou plusieurs expressions.

pgcd[-1027 - 35, 1035 - 10, 1031 + 20]

15

pgcd[129, 51, -12, 33]

3

Clear[pgcd]

4.1.7. Tangente

Notre but est de dessiner une droite en même temps que la fonction donnée. Nous allons donc calculer l'équation de cette droite, et utiliser la commande prédéfinie Plot pour faire la représentation graphique.

L'équation de la droite tangente à f(x) passant par le point (a, f(a)) est:

     y = m(x - a) + f(a),

où m = f'(a). Pour calculer la dérivée de la fonction, il est nécessaire de la tranformer en fonction pure. C'est le but de l'instruction f = Function[x,func], où x doit être la variable de la fonction. Nous retrouvons cette variable dans l'itérateur rng, ce qui nous permet de l'utiliser directement.

tangentePlot[func_, a_, rng : {x_, __}, opts___Rule] :=
 Module[{m, tg, f = Function[x, func]},
   m = f'[a]; 
   tg = m (x - a) + f[a];
   Plot[{func, tg}, rng, opts]
 ]

Pour pouvoir passer à la commande Plot les options éventuelles, un argument supplémentaire optionnel opts est donné.

tangentePlot[x3 - x, -1/2, {x, -2, 2}];

Clear[tangentePlot]

4.1.8. Loterie

Nous devons nous assurer qu'aucun nombre n'apparaît deux fois dans la liste, puisqu'il s'agit d'un tirage sans remise. En fait, il s'agit de choisir un sous-ensemble aléatoire à n éléments de l'ensemble des m premiers nombres.

Nous commençons par tirer aléatoirement un indice i entre 1 et m, et nous conservons le i-ième élément de la liste comme premier élément tiré. Pour nous assurer ensuite de ne pas tirer de nouveau cet élément, nous échangeons dans la liste le i-ième et le m-ième élément.

Voici un exemple pour m = 10 et n = 4.

{m, n} = {10, 4};

s = Range[m]

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

Nous commençons par le premier pas.

i = Random[Integer, {1, m}]

1

{s[[m]], s[[i]]} = {s[[i]], s[[m]]}

{1, 10}

s

{10, 2, 3, 4, 5, 6, 7, 8, 9, 1}

Nous répétons ensuite ce processus pour m - 1, m - 2, ..., m - n + 1. Pour ce faire, nous introduisons une variable d'itération k, allant de m à m - n + 1. Notre tirage est alors constitué.

Voici la suite de l'exemple. Nous montrons le fonctionnement de l'algorithme avec une boucle Do et une instruction Print, permettant de voir les valeurs de k, s et i à chaque itération.

s = Range[m];

Do[i = Random[Integer, {1, k}];
   {s[[k]], s[[i]]} = {s[[i]], s[[k]]};
   Print[k, "   ", s, "   ", i], {k, m, m - n + 1, -1}
]

10     {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}     10

9     {9, 2, 3, 4, 5, 6, 7, 8, 1, 10}     1

8     {9, 2, 3, 4, 5, 8, 7, 6, 1, 10}     6

7     {9, 2, 7, 4, 5, 8, 3, 6, 1, 10}     3

L'implémentation de l'algorithme se fait à l'aide de la fonction Table, ce qui permet de retenir à chaque pas le i-ième élément.

s = Range[m];

Table[i = Random[Integer, {1, k}];
   {s[[k]], s[[i]]} = {s[[i]], s[[k]]}; s[[k]],
   {k, m, m - n + 1, -1}
]

{1, 10, 4, 3}

Notre programme est terminé. Reste à localiser les variables dans un Module. Nous ajoutons une commande Sort pour trier la liste des nombres obtenus et une condition nous assurant que n <= m.

tirage[m_Integer, n_Integer] :=
  Module[{s = Range[m], k, i},
    Sort[Table[i = Random[Integer, {1, k}];
      {s[[k]], s[[i]]} = {s[[i]], s[[k]]};
      s[[k]], {k, m, m - n + 1, -1}]]] /; n <= m

tirage[45, 6]

{15, 22, 24, 34, 40, 44}

Clear[tirage, m, n, i, s]

4.1.9. Convergence de la méthode de Newton

La résolution de cet exercice est donnée sans commentaire. Il est cependant conseillé de l'étudier à tête reposée, car elle utilise des mécanismes pouvant être fort utile au programmeur, notamment pour la conception de packages.

NewtonGraph :: usage = "NewtonGraph[f,x0,{x,xmin,xmax},
  opts] dessine la convergence de la méthode de Newton.";

NewtonGraph :: deriv0 = "Dérivée nulle à l'abscisse `1`.";

NewtonGraph[f_, x0_, {x_, xmin_, xmax_}, opts___Rule] :=
 Module[{ls, pl, fun, err, min, max},
   fun = Function[x, f];
   err = 10.-10;
   ls = FixedPointList[If[Abs[fun'[#]] > err, # - fun[#]/fun'[#],
     Message[NewtonGraph :: deriv0, #]; #]&, x0,
     SameTest -> (Abs[#1 - #2] < err&)];
   {min, max} = {Min[{Min[ls], xmin}], Max[{Max[ls], xmax}]};
   pl = Plot[f, {x, min, max}, PlotStyle -> {{Dashing[{.02, .02}]}},
     DisplayFunction -> Identity];
   Print[Last[ls]];
   Show[Graphics[Line[Flatten[({{#, 0}, {#, fun[#]}}&) /@ ls, 1]]],
     pl, PlotRange -> All, Axes -> Automatic,
     DisplayFunction -> $DisplayFunction, opts
   ]
 ]

f[x_] := x3 - x

NewtonGraph[f[t], 0.447213595499957, {t, -1.2, 1.2}]

0.

- Graphics -

NewtonGraph[f[t], 0.4472215, {t, -1.2, 1.2}]

1.

- Graphics -

NewtonGraph[f[t], Sqrt[3]/3, {t, -1.2, 1.2}]

                                                       1
NewtonGraph :: deriv0 :  Dérivée nulle à l'abscisse -------.
                                                    Sqrt[3]

   1
-------
Sqrt[3]

- Graphics -

NewtonGraph[f[t], 0.4656006214336775837, {t, -1.2, 1.2}]

NewtonGraph :: deriv0 :  Dérivée nulle à l'abscisse 
    -0.57735026918962576.

-0.57735026918962576

- Graphics -

Clear[NewtonGraph]

© 1992-1998 Nicolas Martignoni, nicolas.martignoni@mcnet.ch