Внедрение нейронной сети в Haskell

Я пытаюсь реализовать архитектуру нейронной сети в Haskell и использовать ее в MNIST.

Я использую пакет hmatrix для линейной алгебры. Моя учебная среда построена с использованием пакета pipes.

Мой код компилируется и не падает. Но проблема в том, что определенные комбинации размера слоя (скажем, 1000), размера мини-пакета и скорости обучения приводят к значениям NaN в вычислениях. После некоторой проверки я вижу, что чрезвычайно малые значения (порядка 1e-100) в конечном итоге появляются в активациях. Но даже когда этого не происходит, обучение все равно не работает. Там нет улучшения по сравнению с его потерей или точностью.

Я проверил и перепроверил свой код, и я не знаю, в чем причина проблемы.

Вот тренировка обратного распространения, которая вычисляет дельты для каждого слоя:

backward lf n (out,tar) das = do
    let δout = tr (derivate lf (tar, out)) -- dE/dy
        deltas = scanr (\(l, a') δ -> let w = weights l in (tr a') * (w <> δ)) δout (zip (tail $ toList n) das)
    return (deltas)

if - это функция потерь, n - сеть (матрица weight и вектор bias для каждого уровня), out и tar - фактический выход сети, а target ] (желаемый) вывод, а das - производные активации каждого слоя. В пакетном режиме out, tar являются матрицами (строки являются выходными векторами), а das является списком матриц.

Вот фактическое вычисление градиента:

  grad lf (n, (i,t)) = do
    -- forward propagation: compute layers outputs and activation derivatives
    let (as, as') = unzip $ runLayers n i
        (out) = last as
    (ds) <- backward lf n (out, t) (init as') -- compute deltas with backpropagation
    let r  = fromIntegral $ rows i -- size of minibatch
    let gs = zipWith (\δ a -> tr (δ <> a)) ds (i:init as) --gradients for weights
    return $ GradBatch ((recip r .*) <$> gs, (recip r .*) <$> squeeze <$> ds)

Здесь lf и n такие же, как указано выше, i - это вход, а t - целевой выход (как в пакетном виде, так и в виде матриц).

squeeze преобразует матрицу в вектор путем суммирования по каждой строке. Таким образом, ds представляет собой список матриц дельт, где каждый столбец соответствует дельтам для строки мини-пакета. Таким образом, градиенты для смещений являются средними значениями дельт для всей мини-партии. То же самое для gs, который соответствует градиентам для весов.

Здесь актуальный код обновления:

move lr (n, (i,t)) (GradBatch (gs, ds)) = do
    -- update function
    let update = (\(FC w b af) g δ -> FC (w + (lr).*g) (b + (lr).*δ) af)
        n' = Network.fromList $ zipWith3 update (Network.toList n) gs ds 
    return (n', (i,t))

lr - скорость обучения. FC является конструктором слоя, а af является функцией активации для этого слоя.

Алгоритм градиентного спуска гарантирует передачу отрицательного значения для скорости обучения. Фактический код градиентного спуска - это просто цикл вокруг композиции grad и move с параметризованным условием остановки.

Наконец, вот код для функции потери среднеквадратичной ошибки:

mse :: (Floating a) => LossFunction a a
mse = let f (y,y') = let gamma = y'-y in gamma**2 / 2
          f' (y,y') = (y'-y)
      in  Evaluator f f'

Evaluator просто связывает функцию потерь и ее производную (для вычисления дельты выходного слоя).

Остальная часть кода находится на GitHub: NeuralNetwork

Так что, если у кого-то есть понимание проблемы или просто проверка работоспособности, что я правильно реализую алгоритм, я был бы благодарен.

Ответы