CREATE OR REPLACE PACKAGE forward_propagation
IS
/* 
Package de mise en oeuvre de la forward-propagation d'un réseau de neurones.

--

R. Tiran - Octobre 2017 - 1.0
*/


    PROCEDURE score (p_dataset      VARCHAR2,
                     p_layers       VARCHAR2,
                     p_extracol     VARCHAR2,
                     p_orderby      VARCHAR2,
                     p_view_name    VARCHAR2 DEFAULT 'V_TEST_SET$$',
                     p_out_tname    VARCHAR2 DEFAULT 'ANN_OUT$');
END;
/


CREATE OR REPLACE PACKAGE BODY forward_propagation
IS
    g_colnames        CLOB;
    g_features#       NUMBER;
    g_echantillons#   NUMBER;
    g_iter#           NUMBER;

    TYPE t_layer_tables IS TABLE OF VARCHAR2 (30)
        INDEX BY BINARY_INTEGER;

    g_layer_tables    t_layer_tables;
    g_outneurons#     NUMBER;

    FUNCTION tab2vec (p_tname       VARCHAR2,
                      p_nrows   OUT NUMBER,
                      p_ncols   OUT NUMBER)
        RETURN utl_nla_array_dbl
    -- Cette fonction reçoit une table en entrée et en "applatit" les données
    -- sous forme d'un vecteur (dans un varray de type utl_nla_array_dbl).
    -- L'applatissement est réalisé avec l'opérateur UNPIVOT. L'ordre SQL est
    -- généré dynamiquement en fonction des champs de la table d'entrée (vue
    -- fenétrée du dataset ou table de poids synaptiques).
    --
    -- Outre le varray, la fonction retourne (variable OUT) le nombre de lignes
    -- et de colonnes de la matrice applatie.
    IS
        l_nCols      NUMBER;
        l_biais      NUMBER := 0;
        l_Colnames   VARCHAR2 (32767);
        l_stmt       CLOB
            :=    '  SELECT val
    FROM (SELECT r1$$, ROWNUM r2$$, VALUE val FROM '
               || p_tname
               || ' UNPIVOT (VALUE FOR val IN
                        (';
        l_vec        utl_nla_array_dbl;
    BEGIN
        SELECT LISTAGG (column_name, ',') WITHIN GROUP (ORDER BY column_id),
               COUNT (*)
          INTO l_Colnames, l_nCols
          FROM user_tab_columns
         WHERE table_name = p_tname AND column_name != 'R1$$';

        l_stmt := l_stmt || l_Colnames || '))) ORDER BY R1$$, R2$$';

        EXECUTE IMMEDIATE l_stmt BULK COLLECT INTO l_vec;

        p_ncols := l_nCols;
        p_nrows := l_vec.COUNT () / p_ncols;
        RETURN l_vec;
    END;

    FUNCTION sigmoid_activation (p_mat            utl_nla_array_dbl,
                                 p_nrows          NUMBER,
                                 p_ajout_biais    NUMBER)
        RETURN utl_nla_array_dbl
    AS
        -- La fonction applique la fonction d'activation 1/(1+e^-x) aux valeurs
        -- du varray passé en entrée.
        -- C'est aussi l'occasion d'insérer une valeur de biais (1) à chaque
        -- ligne de la matrice (modulo de p_nrows).
        l_matRes   utl_nla_array_dbl := utl_nla_array_dbl ();
        l_biais    NUMBER := 0;
    BEGIN
        -- p_ajout_biais devrait toujours être valorisé à 1 sauf pour la couche
        -- de sortie.
        IF p_ajout_biais != 0
        THEN
            l_biais := 1;
        END IF;

        FOR i IN 1 .. p_mat.COUNT
        LOOP
            IF MOD (i - 1, p_nrows) = 0 AND l_biais = 1
            THEN
                -- Ajout d'une valeur de biais toutes les p_nrows lignes du
                -- varray d'entrée (c'est à dire ajout d'un biais à chaque ligne
                -- de la matrice applatie)
                l_matRes.EXTEND ();
                l_matRes (l_matRes.COUNT) := 1;
            END IF;

            l_matRes.EXTEND ();
            l_matRes (l_matRes.COUNT) := 1 / (1 + EXP (-1 * p_mat (i)));
        END LOOP;

        RETURN l_matRes;
    END;

    FUNCTION multip_matrix (p_matA      utl_nla_array_dbl,
                            p_matB      utl_nla_array_dbl,
                            p_nrowsA    NUMBER,
                            p_ncolsA    NUMBER,
                            p_ncolsB    NUMBER)
        RETURN utl_nla_array_dbl
    AS
        -- La fonction réalise l'appel à UTL_NLA_blas_gemm pour assurer le
        -- produit matriciel du résultat d'une couche avec les poids synaptiques
        -- associés.
        --
        -- A: m x k
        -- B: k x n
        -- C: m x n
        l_matRes   utl_nla_array_dbl := utl_nla_array_dbl ();
    BEGIN
        UTL_NLA.blas_gemm (transa   => 'N',
                           transb   => 'N',
                           m        => p_nrowsA,
                           n        => p_ncolsB,
                           k        => p_ncolsA,
                           alpha    => 1,
                           a        => p_matA,
                           lda      => p_nrowsA,
                           b        => p_matB,
                           ldb      => p_ncolsA,
                           beta     => 0,
                           c        => l_matRes,
                           ldc      => p_nrowsA,
                           pack     => 'R');
        RETURN l_matRes;
    END;

    PROCEDURE list_layers (p_layers VARCHAR2)
    IS
        l_final_layer   VARCHAR2 (30);
    BEGIN
        -- La liste fournie en entrée correspond aux tables contenant les poids
        -- synaptiques. On découpe cette liste via une expression régulière.
        -- La liste des tables est ensuite stockée dans une table PLSQL
        SELECT TRIM (tname)
          BULK COLLECT INTO g_layer_tables
          FROM (    SELECT REGEXP_SUBSTR (p_layers,
                                          '[^,]+',
                                          1,
                                          LEVEL)
                               tname
                      FROM DUAL
                CONNECT BY LEVEL < 30)
         WHERE tname IS NOT NULL;

        -- Pour la dernière table de la liste, on compte le nombre de colonnes
        -- pour déterminer le nombre de neurones de l'output layer.
        l_final_layer := g_layer_tables (g_layer_tables.COUNT);

        SELECT COUNT (*)
          INTO g_outneurons#
          FROM user_tab_columns
         WHERE table_name = l_final_layer AND column_name != 'R1$$';
    END;

    PROCEDURE forward_prop (p_dataset VARCHAR2, p_out_tname VARCHAR2)
    IS
        -- Cette procédure réalise :
        -- la multiplication matricielle des valeurs de la couche courante avec
        -- les poids synaptiques de la couche suivante

        --    p_dataset        VARCHAR2 (30) := 'T1';
        --    p_layers         VARCHAR2 (30) := 'L1,L2,L3';
        l_matA          utl_nla_array_dbl;
        l_matB          utl_nla_array_dbl;
        l_matC          utl_nla_array_dbl;

        l_nRA           NUMBER;
        l_nCA           NUMBER;
        l_nRB           NUMBER;
        l_nCB           NUMBER;
        l_nRC           NUMBER;
        l_nCC           NUMBER;
        l_ajout_biais   NUMBER;
    BEGIN
        -- La variable l_matA est peuplée avec les données (fenétrées)
        -- du dataset d'entrée. La fonction tab2vec est utilisée pour "applatir"
        -- le dataset sous forme de varray
        l_matA := tab2vec (p_dataset, p_nrows => l_nRA, p_ncols => l_nCA);

        -- Pour chaque couche, on va procéder à la propagation.
        FOR i IN 1 .. g_layer_tables.COUNT
        LOOP
            -- On teste si on arrive a l'output layer ou pas, si ce n'est
            -- pas le cas une valeur de biais doit être ajoutée au résultat
            -- intermédiaire.
            IF i = g_layer_tables.COUNT
            THEN
                l_ajout_biais := 0;
            ELSE
                l_ajout_biais := 1;
            END IF;

            -- La variable l_matB contient les poids synaptiques à appliquer.
            l_matB :=
                tab2vec (g_layer_tables (i),
                         p_nrows   => l_nRB,
                         p_ncols   => l_nCB);

            -- La variable l_matC contient le résultat du produit matriciel de
            -- l_matA x l_matB
            l_matC :=
                multip_matrix (p_matA     => l_matA,
                               p_matB     => l_matB,
                               p_nrowsA   => l_nRA,
                               p_ncolsA   => l_nCA,
                               p_ncolsB   => l_nCB);

            -- On applique la fonction d'activation au résultat de l'étape
            -- précédente (l_matC) et on remplace le contenu de l_matA par
            -- le résultat obtenu.
            l_matA :=
                sigmoid_activation (p_mat           => l_matC,
                                    p_nrows         => l_nCB,
                                    p_ajout_biais   => l_ajout_biais);


            l_nCA := l_nCB + 1;
        -- On reprend alors la boucle avec la couche suivante...
        END LOOP;

        -- Une fois la forward-prop appliquée à toutes données de la fenètre
        -- courante, on stocke les résultats dans la table de sortie.

        FORALL i IN 1 .. l_matA.COUNT
            EXECUTE IMMEDIATE
                   'INSERT INTO '
                || p_out_tname
                || ' VALUES (S_'
                || p_out_tname
                || '.nextval, :2)'
                USING l_matA (i);

        COMMIT;
    END;

    PROCEDURE build_output_table (p_out_tname VARCHAR2 DEFAULT 'ANN_OUT$')
    IS
        -- Construction de la table de stockage des valeurs de l'output layer
        -- de l'ANN. Il s'agit d'une table heap que l'on pivotera in-fine
        -- pour obtenir une représentation matricielle. On créé aussi une
        -- séquence pour ordonner les insertions dans la table.
        table_exists   EXCEPTION;
        PRAGMA EXCEPTION_INIT (table_exists, -955);
    BEGIN
        EXECUTE IMMEDIATE
               'CREATE TABLE '
            || p_out_tname
            || '(outid  NUMBER primary key, neuronval NUMBER)';

        EXECUTE IMMEDIATE 'CREATE SEQUENCE S_' || p_out_tname;
    EXCEPTION
        WHEN table_exists
        THEN
            raise_application_error (
                -20000,
                   'La table '
                || p_out_tname
                || ' et/ou la sequence S_'
                || p_out_tname
                || ' existe deja!');
        WHEN OTHERS
        THEN
            raise_application_error (
                -20001,
                   'Problème lors de la création de la table '
                || p_out_tname
                || ' et/ou de la sequence S_'
                || p_out_tname
                || ': '
                || SQLCODE);
            RAISE;
    END;

    PROCEDURE build_output_view (p_out_tname VARCHAR2)
    IS
        l_pivotfields   VARCHAR2 (32767);
    -- Cette procédure construit une vue sur la table de stockage
    -- des résultats de manière a restituer l'ensemble sous une forme
    -- matricielle.
    -- Si la couche de sortie contient K neurones et le dataset d'entrée N
    -- échantillons, la vue devrait restituer N lignes x K colonnes.
    --
    -- L'opération est réalisée via l'opérateur UNPIVOT et l'ordre SQL
    -- associé est construit dynamiquement à partir des colonnes de la table
    -- du layer de sortie.
    -- Un modulo sur le champ outid de la table de stockage des résultats
    -- permet de déterminer les enregistrements associés à un même
    -- échantillon.
    BEGIN
        WITH
            outneurons
            AS
                (    SELECT '''O' || (LEVEL - 1) || ''' as O' || (LEVEL - 1) expr
                       FROM DUAL
                 CONNECT BY LEVEL < g_outneurons# + 1)
        SELECT LISTAGG (expr, ',') WITHIN GROUP (ORDER BY NULL)
          INTO l_pivotfields
          FROM outneurons;

        EXECUTE IMMEDIATE
               'CREATE OR REPLACE VIEW V_'
            || p_out_tname
            || q'#
AS
      SELECT *
        FROM (SELECT 'O' || MOD (outid - 1, #'
            || g_outneurons#
            || q'#) neuron,
                     FLOOR ((outid - 1) / #'
            || g_outneurons#
            || q'#) + 1 recid,
                     neuronval
                FROM ann_out$)
             PIVOT
                 (MAX (neuronval)
                 FOR neuron
                 IN (#'
            || l_pivotfields
            || q'#))
    ORDER BY 1#';
    END;

    PROCEDURE set_dataset_view (
        p_dataset      VARCHAR2,
        p_orderby      VARCHAR2,
        p_iter         VARCHAR2,
        p_view_name    VARCHAR2 DEFAULT 'V_TEST_SET$$')
    IS
    -- Cette procédure assure, à l'aide d'une vue, un fenétrage sur le dataset
    -- d'entrée. L'idée étant que la matrice produite à un instant t à partir
    -- du dataset n'excède pas 1e6 éléments.
    --
    -- A chaque appel, on décale alors la fenètre sur la zone suivante
    -- du dataset. La variable p_orderby est utilisée pour s'assurer
    -- d'un fenétrage déterministe.
    -- A noter aussi au passage l'ajout d'une valeur de biais (1) au sein
    -- de la vue pour chaque image.
    -- Cela permet ensuite de convertir le contenu de la vue en une matrice
    -- exploitable par UTL_NLA.
    BEGIN
        EXECUTE IMMEDIATE
               'CREATE OR REPLACE VIEW '
            || p_view_name
            || '
AS
    SELECT *
      FROM (SELECT ROWNUM R1$$, t.*
              FROM (  SELECT 1 BIAIS,'
            || g_colnames
            || '
                        FROM '
            || p_dataset
            || '
                    ORDER BY '
            || p_orderby
            || ') t)
     WHERE R1$$ BETWEEN '
            || TO_CHAR ((p_iter - 1) * g_echantillons# + 1)
            || ' AND '
            || TO_CHAR (p_iter * g_echantillons#);
    END;

    PROCEDURE check_dataset_size (p_dataset VARCHAR2, p_extracol VARCHAR2)
    IS
    BEGIN
        -- Comptage dans g_features# des colonnes du dataset après exclusion
        -- des colonnes supperflues (p_extracol).
        -- La liste des colonnes d'intérêt est aussi stockée dans g_colnames.
        SELECT LISTAGG (column_name, ',') WITHIN GROUP (ORDER BY column_id),
               COUNT (*)
          INTO g_colnames, g_features#
          FROM user_tab_columns
         WHERE     table_name = p_dataset
               AND column_name NOT IN
                       (SELECT TRIM (col_name)
                          FROM (    SELECT REGEXP_SUBSTR (p_extracol,
                                                          '[^,]+',
                                                          1,
                                                          LEVEL)
                                               col_name
                                      FROM DUAL
                                CONNECT BY LEVEL < 30)
                         WHERE col_name IS NOT NULL);

        -- On stocke dans g_iter# le nombre de passages à réaliser
        -- sur le dataset d'entrée en limitant chaque passage a 1e6 éléments.
        g_echantillons# := FLOOR ((1e6 / g_features#) / 100) * 100;

        EXECUTE IMMEDIATE
            'SELECT CEIL (COUNT (*) / :nechantillons)  FROM ' || p_dataset
            INTO g_iter#
            USING g_echantillons#;
    END;


    PROCEDURE score (p_dataset      VARCHAR2,
                     p_layers       VARCHAR2,
                     p_extracol     VARCHAR2,
                     p_orderby      VARCHAR2,
                     p_view_name    VARCHAR2 DEFAULT 'V_TEST_SET$$',
                     p_out_tname    VARCHAR2 DEFAULT 'ANN_OUT$')
    IS
    /*
    Procédure principale qui pilote l'exécution des autres routines.
    */
    BEGIN
        -- Le dataset d'entrée conduit-il a une matrice de plus d'1e6 éléments?
        -- La variable g_iter# est valorisée par check_dataset_size au nombre
        -- de passages à réaliser sur le dataset pour se limiter
        -- à des matrices de 1e6 éléments max.
        check_dataset_size (UPPER (p_dataset), UPPER (p_extracol));

        -- Construction de la table qui contiendra le résultat de la forward-prop
        build_output_table (UPPER (p_out_tname));

        -- Découpage de la liste des tables fournie via le paramètre p_layers
        list_layers (UPPER (p_layers));

        FOR j IN 1 .. g_iter#
        LOOP
            -- On crée dynamiquement une vue fenétrée sur le dataset d'entrée
            -- de manière a limiter son contenu a 1e6 éléments max.
            -- A chaque itération, la fenètre "avance" pour traiter le lot suivant.
            set_dataset_view (UPPER (p_dataset),
                              UPPER (p_orderby),
                              j,
                              UPPER (p_view_name));
            -- On réalise la forward-prop sur le lot courant.
            forward_prop (UPPER (p_view_name), UPPER (p_out_tname));
        END LOOP;

        -- Construction d'une vue sur la table stockant les résultats de manière
        -- à présenter les résultats de l'output layer.
        build_output_view (UPPER (p_out_tname));
    END;
END;
/