<div>
<div>J'ai tranformé mon programme de la manière suivante (voir ci-après).</div>
<div>J'ai spécifié le type de la plupart des fonctions.</div>
<div>Ca marche mieux, mais l'écriture est sérieusement plus lourde!</div>
<div> </div>
<div>J'ai encore un problème:</div>
<div> </div>
<div>courbe = defaultPlotLines {<br> plot_lines_values = [[ (Point a b) | (a,b) <- ps]],<br> plot_lines_style = solidLine lineWidth 0 0 1<br> }</div>
<div> </div>
<div>donne l'erreur:</div>
<div> Couldn't match expected type `Double' against inferred type `Float'<br> In the first argument of `Point', namely `a'<br> In the expression: (Point a b)<br> In the expression: [(Point a b) | (a, b) <- ps]
</div>
<div> </div>
<div>en effet Point prend des doubles. Je n'ai pas trouvé de fonctions de conversion Float vers Double...</div>
<div> </div>
<div>Merci!</div>
<div>Corentin</div>
<div>
<p><br><em>module Lagrange where</em></p>
<p><em>nombre_points :: Integer<br>nombre_points = 7</em></p>
<p><em>-- creation d'une liste exluant i<br>list :: Integer -> [Integer]<br>list i = filter (/=i) [0..nombre_points-1] </em></p>
<p><em>-- un terme du polynôme de Lagrange<br>--un_terme :: Float -> Integer -> Integer -> Float<br>un_terme t j i = (t - i_f)/(j_f - i_f)<br> where i_f = fromInteger i<br> j_f = fromInteger j
</em></p>
<p><br><em>--produit des termes pour obtenir le polynôme d'un point<br>les_termes t j = map (un_terme t j) (list j)<br>poly t j = product (les_termes t j)</em></p>
<p><em> </em></p>
<p><em>--blend (a,t) = a(0) * (poly t 0) + a(1) * (poly t 1) + a(2) * (poly t 2) + a(3) * (poly t 3) +<br>-- a(4) * (poly t 4) + a(5) * (poly t 5) + a(6) * (poly t 6)</em></p>
<p><em>--t est le paramètre du polynôme, a sera la coordonnée (x ou y). <br>blend_un_point :: Float -> (Integer -> Float) -> Integer -> Float<br>blend_un_point t a numero_point = a(numero_point) * (poly t numero_point)
<br>blend_les_points t a = map (blend_un_point t a) [0..6]</em></p>
<p><em>blend :: (Integer -> Float, Float) -> Float<br>blend (a,t) = sum (blend_les_points t a)</em></p>
<p><em>-- Sample points<br>xy = [(-4.0,0.0), (-1.0,1.0), (-3.0,3.0), (0.0,4.0), (3.0,3.0),(1.0,1.0),(4.0,0.0)]</em></p>
<p><br><em>--creation des fonctions x et y<br>x :: Integer -> Float<br>x pos = fst (xy !! pos_Integer)<br> where pos_Integer = fromInteger(pos)<br>y :: Integer -> Float<br>y pos = snd (xy !! pos_Integer)<br> where pos_Integer = fromInteger(pos)
</em></p>
<p><br><em>-- Blend the sample points for some given u:<br>bx :: Float -> Float<br>bx(u) = blend(x,u)</em></p>
<p><em>by :: Float -> Float<br>by(u) = blend(y,u)</em></p>
<p><em>-- Take m+1 values for u, from 0 to nombre_points, equally spaced:<br>us :: Integer -> [Float]<br>us m = map (/mf) [0..6*mf]<br> where mf = fromInteger m</em></p>
<p><em>-- For</em></p>
<p><em>m = 50</em></p>
<p><em>-- we get us(m)=[0.0, 0.125, 0.25, 0.375, 0.5, 0.625, 0.75, 0.875, 1.0].</em></p>
<p><em>-- Now get a list of points for the above values of the parameter:</em></p>
<p><em>xs = map bx (us(m))<br>ys = map by (us(m))</em></p>
<p><br><em>-- Running this, we get, where I've rounded the results to 2 digits:<br>--<br>-- xs = [0.00, 0.38, 0.75, 1.1, 1.5, 1.9, 2.3, 2.6, 3.0]<br>-- ys = [0.00, 0.46, 1.00, 1.7, 2.3, 2.8, 3.1, 3.2, 3.0]</em></p>
<p><em>-- Finally, get a list of pairs (x,y), i.e. a list of points:</em></p>
<p><em>ps = zip xs ys</em></p>
<p><em>-- In this example, running "ps" we get, after rounding, the points:<br>--<br>-- [(0, 0), (0.38, 0.46), (0.75, 1), (1.1, 1.7),<br>-- (1.5, 2.3), (1.9, 2.8), (2.3, 3.1), (2.6, 3.2), (3, 3)]<br>--<br>-- Now plot lines joining these points to get an approximation of the curve
<br></em></p></div></div>