Conversion d'algorithme non triviale de l'impératif sur fonctionnel

Question

Pour appliquer mes compétences de programmation fonctionnelle (faibles), j'étudie le livre de Nurbs par PIEGL et TILLER Conversion de tous les algorithmes en haskell. C'est un processus très gentil et instructif, mais je suis resté coincé sur l'algorithme 2.2, voici (une version de C-like Chante-moi de) le pseudo-code:

double[] BasisFuns( int i, double u, int p, double U[]) {
  double N[p+1];
  double left[p+1];
  double ritght[p+1];
  N[0]=1.0;
  for (j=1; j<=p; j++) {
    left[j]  = u - U[i+1-j];
    right[j] = U[i+j] - u;
    double saved = 0.0;
    for (r=O; r<j; r++) {
      double temp= N[r]/(right[r+1]+left[j-r]);
      N[r] = saved+right[r+1]*temp;
      saved = left[j-r]*temp;
    }
    N[j] = saved;
  }
  return N;
}

La boucle externe semble facile, mais l'intérieure, avec toutes les modifications obligatoires nécessairement - les éléments de N me donnent mal à la tête.

J'ai commencé à le mettre comme ça:

baseFunc :: RealFrac a => Int -> Int -> a -> [a] -> [a]
baseFunc i p u knots
  [ ??? | j <- [1..p], r <- [0..j] ]
  where
  left = [ u - knots !! (i+1-j) | j <- [ 1 .. p ]
  right= [ knots !! (i+j) - u   | j <- [ 1 .. p ]

mais je sens que je peux être complètement hors route.

J'ai déjà écrit une version complètement différente et inefficace de cette fonction basée sur EQ. 2.5 Dans le livre, je cherche donc à maintenir les performances de la version impérative.

Answer 1

Je ne suis pas sûr que cela fonctionnera, mais ...:

baseFunc :: RealFrac a => Int -> Int -> a -> [a] -> [a]
baseFunc i p u knots =
    foldl' helper [1.0] [1..p]

    where
    left = [ u - knots !! (i+1-j) | j <- [ 1 .. p ] ]
    right= [ knots !! (i+j) - u   | j <- [ 1 .. p ] ]

    helper  N  j = outer_loop j N left right

    inner_loop :: RealFrac a => Int -> Int -> [a] -> [a] -> [a] -> a -> (a, a)
    inner_loop  r  j  N  left  right  saved =
        let temp = N !! r / (right !! (r+1) + left !! (j-r))
        in  (saved + right !! (r+1) * temp, left !! (j-r) * temp)

    outer_loop :: RealFrac a => Int -> [a] -> [a] -> [a] -> [a]
    outer_loop  j  N  left  right =
        let (new_N, saved) = foldl' helper (N, 0.0) [0..j-1]
            helper  (prev_N, saved)  r = 
                let (N_r, new_saved) = inner_loop r j prev_N left right saved
                in  (insertAt r N_r prev_N, new_saved)
        in  new_N ++ [saved]