!*************************************************************************
!*                                                                       *
!*     Computation of the value of the NN regression problem and the     *
!*     the corresbonding subgradients. Called from the subroutine lmbm.  *
!*     (last modified 30.09.2020).                                       *
!*                                                                       *
!*     This file is specially modified to solve NNR problems.            *
!*                                                                       *
!*************************************************************************
!*
!*     Modules included:
!*
!*     obj_fun         !
!*

MODULE objfun  ! Computation of the value and the subgradient of the 
               ! objective function.

    USE r_precision, ONLY : prec  ! Precision for reals.
    IMPLICIT NONE

    PUBLIC :: &
        myf,    &   ! Computation of the value of the objective.
        myg         ! Computation of the subgradient of the objective.

CONTAINS
    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myf *                                               *
    !*                                                                      *
    !*     Computation of the value of the NNR-objective at x.              *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myf(n,x,f,iterm)

        USE param, ONLY : zero,large            ! Parameters.
        USE initnn, ONLY : & 
            mX, &                   ! Input matrix.
            mY, &                   ! Output vector.
            nft, &                  ! Number of input features.
            ntrain, &               ! Size of the training set.
            nH, &                   ! Current number of hidden nodes.
            rho                     ! Penalization parameter.
            
        
        IMPLICIT NONE

        ! Array Arguments
        REAL(KIND=prec), DIMENSION(n), INTENT(IN) :: &
            x  ! Vector of variables.
               !     w_1BP   <--->  x(1)
               !     w_0kj   <--->  x(1+(j-1)*(nft+2)+k)
               !     w_0Bj   <--->  x(1+(j-1)*(nft+2)+nft+1)    
               !     w_1jP   <--->  x(1+j*(nft+2))            (i.e.  x(1+(j-1)*(nft+2)+nft+2) )

        ! Scalar Arguments
        REAL(KIND=prec), INTENT(OUT) :: f  ! Value of the function.
        INTEGER, INTENT(IN) :: n           ! Number of variables = nH*(nft+2)+1.
        INTEGER, INTENT(OUT) :: iterm      ! Cause of termination:
                                           !   0  - Everything is ok.
                                           !  -3  - Failure in function calculations.
        ! Local scalars
        REAL(KIND=prec) :: s_ij, p_i, dev, f_pen                                   
        INTEGER :: i_w1jP, i_w0Bj, i_w0kj  ! Indices for weights.
        INTEGER :: i,j,k

                        
        iterm = 0
                             
        !************************************************************
        !             The Problem with L1-norm
        !************************************************************
                
        f = zero
                
        DO i = 1, ntrain                             ! Each data point in the training set is looked through
                   
            p_i = x(1)                               ! w_1BP is initialized as the value of p_i
                   
            DO j = 1, nH                             ! Each hidden node is looked through
                   
                i_w1jP = 1 + j*(nft+2)               ! Index for w_1jP
                i_w0Bj = 1 + j*(nft+2) - 1           ! Index for w_0Bj
                s_ij = x(i_w0Bj)                     ! w_0Bj
                i_w0kj = 1 + (j-1)*(nft+2)           ! Initialization of index for w_0kj           
                DO k = 1, nft                        ! Inputs of data point i are looked through
                    i_w0kj =  i_w0kj + 1             ! Index for w_0kj
                    s_ij = s_ij + x(i_w0kj)*mX(k,i)  ! Update of s_ij 
                                                     ! tarkista miten päin tämä matriisi on ja miten päin sitä kannattaa lukea
                END DO                               ! Ensimmäisen indeksi tulee muuttua nopeimmin, eli tämä olisi oikein näin. 
                                                     ! nyt kuitenkin se vastaisi a(nft,nrecord), saatko fiksusti luettua sen näin päin?   
                       
                IF (s_ij >= zero) THEN 
                    p_i = p_i + x(i_w1jP)*s_ij
                END IF
                   
            END DO
                   
            dev = mY(i)-p_i
                   
            IF (dev >= zero) THEN
                f = f + dev
            ELSE
                f = f - dev
            END IF
                
        END DO
                 
        ! L1 penalization, we want all weights as small as possible?
        f_pen = zero
        DO i = 1, n
            f_pen = f_pen + ABS(x(i))
        END DO                      
                          
        f = f + rho*f_pen

        ! Error checking.
        IF (f > large) iterm = -3  !
        IF (f < -large) iterm = -3 !

                
        RETURN
                    
    END SUBROUTINE myf

    !************************************************************************
    !*                                                                      *
    !*     * SUBROUTINE myg *                                               *
    !*                                                                      *
    !*     Computation of the subgradient of the NNR function.              *
    !*                                                                      *
    !************************************************************************
     
    SUBROUTINE myg(n,x,g,iterm)

        USE param, ONLY : zero,one,large            ! Parameters.
        USE initnn, ONLY : & 
            mX, &                   ! Input matrix.
            mY, &                   ! Output vector.
            nft, &                  ! Number of input features.
            !ns, &                  ! Switch for auxiliary and real clustering problem.
            ntrain, &               ! Size of the training set.
            nH, &                   ! Current number of hidden nodes.
            rho                     ! Penalization parameter. Default = 1.0.
        
        IMPLICIT NONE

        ! Array Arguments
        REAL(KIND=prec), DIMENSION(n), INTENT(IN) :: &
            x  ! Vector of variables.
               !     w_1BP   <--->  x(1)
               !     w_0kj   <--->  x(1+(j-1)*(nft+2)+k)
               !     w_0Bj   <--->  x(1+(j-1)*(nft+2)+nft+1)    
               !     w_1jP   <--->  x(1+j*(nft+2))            (i.e.  x(1+(j-1)*(nft+2)+nft+2) )
        REAL(KIND=prec), DIMENSION(n), INTENT(OUT) :: &
            g  ! Subgradient.

        ! Scalar Arguments
        INTEGER, INTENT(IN) :: n                        ! Number of variables.
        INTEGER, INTENT(OUT) :: iterm                   ! Cause of termination:
                                                        !   0  - Everything is ok.
                                                        !  -3  - Failure in subgradient calculations.
        
        ! Local       
        REAL(KIND=prec), DIMENSION(n) :: g_i                                   
        REAL(KIND=prec) :: s_ij, p_i, dev                                     
        INTEGER :: i_w1jP, i_w0Bj, i_w0kj  ! Indices for weights.
        INTEGER :: i,j,k
                
        iterm = 0

        ! Gradient evaluation.
                
        g = zero
                 
        DO i = 1, ntrain                  ! Each data point in the training set is looked through
                   
            g_i = zero
            p_i = x(1)                                ! w_1BP is initialized as the value of p_i
            DO j = 1, nH                              ! Each hidden node is looked through
                i_w1jP = 1 + j*(nft+2)                ! Index for w_1jP
                i_w0Bj = 1 + j*(nft+2) - 1            ! Index for w_0Bj
                s_ij = x(i_w0Bj)                      ! w_0Bj
                i_w0kj = 1 + (j-1)*(nft+2)                     
                DO k = 1, nft                         ! Inputs of data point i are looked through
                    i_w0kj =  i_w0kj + 1               ! Index for w_0kj
                    s_ij = s_ij + x(i_w0kj)*mX(k,i)    ! Update of s_ij
                END DO
                       
                IF (s_ij >= zero) THEN 
                    p_i = p_i + x(i_w1jP)*s_ij            ! Update of p_i
                         
                    i_w0kj = 1 + (j-1)*(nft+2)                     
                    DO k = 1,nft
                        i_w0kj =  i_w0kj + 1  
                        g_i(i_w0kj) = g_i(i_w0kj) + mX(k,i)*x(i_w1jP)
                    END DO
                    i_w0kj =  i_w0kj + 1  
                    g_i(i_w0kj) = g_i(i_w0kj) + x(i_w1jP)
                         
                    g_i(i_w1jP) = g_i(i_w1jP) + s_ij
                         
                END IF
                   
            END DO
            g_i(1) = g_i(1) + one
                   
            dev = mY(i)-p_i
                   
            IF (dev >= zero) THEN
                g_i = (-one) * g_i
            END IF
                   
            g = g + g_i
        END DO    
 
        g_i=zero
        DO i = 1, n
            IF (x(i)>=zero) THEN
                g_i(i) = g_i(i) + one
            ELSE
                g_i(i) = g_i(i) - one
            END IF                  
            
        END DO
                         
        g = g + rho * g_i
                 
                        
        RETURN

    END SUBROUTINE myg

END MODULE objfun
