From 2ff70292d62b85684739849a2bd7728462e4bdf7 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Tue, 13 Aug 2024 21:42:42 +0200 Subject: [PATCH 01/13] start working on activations module --- src/stdlib_math_activations.fypp | 386 +++++++++++++++++++++++++++++++ 1 file changed, 386 insertions(+) create mode 100644 src/stdlib_math_activations.fypp diff --git a/src/stdlib_math_activations.fypp b/src/stdlib_math_activations.fypp new file mode 100644 index 000000000..4a2dcf70b --- /dev/null +++ b/src/stdlib_math_activations.fypp @@ -0,0 +1,386 @@ +#:include "common.fypp" +module stdlib_math_activations + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp + implicit none + private + + interface gaussian + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: gaussian_${rk}$ + #:endfor + end interface + public :: gaussian + + interface gaussian_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: gaussian_grad_${rk}$ + #:endfor + end interface + public :: gaussian_grad + + interface elu + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: elu_${rk}$ + #:endfor + end interface + public :: elu + + interface elu_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: elu_grad_${rk}$ + #:endfor + end interface + public :: elu_grad + + interface relu + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: relu_${rk}$ + #:endfor + end interface + public :: relu + + interface relu_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: relu_grad_${rk}$ + #:endfor + end interface + public :: relu_grad + + interface gelu + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: gelu_${rk}$ + #:endfor + end interface + public :: gelu + + interface gelu_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: gelu_grad_${rk}$ + #:endfor + end interface + public :: gelu_grad + + interface gelu_approx + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: gelu_approx_${rk}$ + #:endfor + end interface + public :: gelu_approx + + interface gelu_approx_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: gelu_approx_grad_${rk}$ + #:endfor + end interface + public :: gelu_approx_grad + + interface sigmoid + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: sigmoid_${rk}$ + #:endfor + end interface + public :: sigmoid + + interface sigmoid_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: sigmoid_grad_${rk}$ + #:endfor + end interface + public :: sigmoid_grad + + interface step + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: step_${rk}$ + #:endfor + end interface + public :: step + + interface step_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: step_grad_${rk}$ + #:endfor + end interface + public :: step_grad + + interface Softmax + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: softmax_${rk}$ + #:endfor + end interface + public :: softmax + + interface Softmax_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: Softmax_grad_${rk}$ + #:endfor + end interface + public :: Softmax_grad + + interface Softplus + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: Softplus_${rk}$ + #:endfor + end interface + public :: Softplus + + interface Softplus_grad + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: Softplus_grad_${rk}$ + #:endfor + end interface + public :: Softplus_grad + + interface ftanh !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: ftanh_${rk}$ + #:endfor + end interface + public :: ftanh + + interface ferf !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 + #:for rk, rt in REAL_KINDS_TYPES + module procedure :: ferf_${rk}$ + #:endfor + end interface + public :: ferf + + #:for rk, rt in REAL_KINDS_TYPES + ${rt}$, parameter :: isqrt2_${rk}$ = 1_${rk}$ / sqrt(2._${rk}$) + #:endfor + +contains + +!================================================== +! Gaussian +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function gaussian_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = exp(-x**2) +end function + +elemental ${rt}$ function gaussian_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = -2_${rk}$ * x * exp(-x**2) +end function + +#:endfor + +!================================================== +! Exponential Linear Unit +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function elu_${rk}$( x , a ) result ( y ) + ${rt}$, intent(in) :: x + ${rt}$, intent(in) :: a + + if(x >= 0_${rk}$)then + y = x + else + y = a * (exp(x) - 1_${rk}$) + end if +end function + +elemental ${rt}$ function elu_grad_${rk}$( x , a ) result ( y ) + ${rt}$, intent(in) :: x + ${rt}$, intent(in) :: a + + if(x >= 0_${rk}$)then + y = 1_${rk}$ + else + y = a * exp(x) + end if +end function + +#:endfor + +!================================================== +! Rectified Linear Unit +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function relu_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = max(0_${rk}$, x) +end function + +elemental ${rt}$ function relu_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + if(x > 0_${rk}$)then + y = 1_${rk}$ + else + y = 0_${rk}$ + end if +end function + +#:endfor + +!================================================== +! GELU: Gaussian Error Linear Units function +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function gelu_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = 0.5_${rk}$ * x * (1 + ferf(x * isqrt2_${rk}$)) +end function + +elemental ${rt}$ function gelu_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = 0.5_${rk}$ * (1 + ferf(x * isqrt2_${rk}$) ) + y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 ) +end function + +#:endfor + +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function gelu_approx_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = 0.5_${rk}$ * x * (1 + ferf(x * isqrt2_${rk}$)) +end function + +elemental ${rt}$ function gelu_approx_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = 0.5_${rk}$ * (1 + ferf(x * isqrt2_${rk}$) ) + y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 ) +end function + +#:endfor + +!================================================== +! Sigmoid +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function sigmoid_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = 1_${rk}$ / (1_${rk}$ + exp(-x)) +end function + +elemental ${rt}$ function sigmoid_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = exp(x) / (1_${rk}$ + exp(x))**2 +end function + +#:endfor + +!================================================== +! Step +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function Step_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + if(x > 0_${rk}$)then + y = 1_${rk}$ + else + y = 0_${rk}$ + end if +end function + +elemental ${rt}$ function Step_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = 0_${rk}$ +end function + +#:endfor + +!================================================== +! tanh +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function tanh_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = ftanh(x) +end function + +elemental ${rt}$ function tanh_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = 1_${rk}$ - ftanh(x)**2 +end function + +#:endfor + +!================================================== +! Softmax +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +pure function Softmax_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x(:) + ${rt}$ :: y(size(x)) + + y(:) = exp(x(:) - maxval(x(:)) ) + y(:) = y(:) / sum(y(:)) +end function + +pure function Softmax_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x(:) + ${rt}$ :: y(size(x)) + + y = softmax_${rk}$(x) + y = y * (1_${rk}$ - y) +end function + +#:endfor + +!================================================== +! Softplus +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function Softplus_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = log(exp(x) + 1_${rk}$) +end function + +elemental ${rt}$ function Softplus_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + + y = exp(x) / (exp(x) + 1_${rk}$) +end function + +#:endfor + +!================================================== +! Fast intrinsics for accelerated activations +!================================================== + +#:for rk, rt in REAL_KINDS_TYPES +elemental ${rt}$ function ftanh_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: x2, a, b + + if (x > 5_${rk}$) then + y = 1_${rk}$ + elseif (x < -5_${rk}$) then + y = -1_${rk}$ + else + x2 = x*x + a = x * (135135.0_${rk}$ + x2 * (17325.0_${rk}$ + x2 * (378.0_${rk}$ + x2))) + b = 135135.0_${rk}$ + x2 * (62370.0_${rk}$ + x2 * (3150.0_${rk}$ + x2 * 28.0_${rk}$)) + y = a / b + end if +end function + +elemental ${rt}$ function ferf_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: abs_x + + abs_x = abs(x) + y = 1_${rk}$ - 1_${rk}$ / (1+ 0.278393_${rk}$*abs_x + 0.230389_${rk}$*abs_x**2 + 0.000972_${rk}$*abs_x**3 + 0.078108_${rk}$*abs_x**4)**4 + y = y * sign(1.0_${rk}$,x) +end function + +#:endfor + +end module \ No newline at end of file From 7d1c6ad4330b9fda4626bd00246634926b3a77e5 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Thu, 15 Aug 2024 11:24:44 +0200 Subject: [PATCH 02/13] softmax for ranks from 1 to 4 --- src/stdlib_math_activations.fypp | 119 +++++++++++++++++++++++++++++-- 1 file changed, 112 insertions(+), 7 deletions(-) diff --git a/src/stdlib_math_activations.fypp b/src/stdlib_math_activations.fypp index 4a2dcf70b..3085c4699 100644 --- a/src/stdlib_math_activations.fypp +++ b/src/stdlib_math_activations.fypp @@ -104,14 +104,20 @@ module stdlib_math_activations interface Softmax #:for rk, rt in REAL_KINDS_TYPES - module procedure :: softmax_${rk}$ + module procedure :: Softmax_r1_${rk}$ + module procedure :: Softmax_r2_${rk}$ + module procedure :: Softmax_r3_${rk}$ + module procedure :: Softmax_r4_${rk}$ #:endfor end interface public :: softmax interface Softmax_grad #:for rk, rt in REAL_KINDS_TYPES - module procedure :: Softmax_grad_${rk}$ + module procedure :: Softmax_grad_r1_${rk}$ + module procedure :: Softmax_grad_r2_${rk}$ + module procedure :: Softmax_grad_r3_${rk}$ + module procedure :: Softmax_grad_r4_${rk}$ #:endfor end interface public :: Softmax_grad @@ -315,19 +321,118 @@ end function ! Softmax !================================================== #:for rk, rt in REAL_KINDS_TYPES -pure function Softmax_${rk}$( x ) result( y ) +pure function Softmax_r1_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x(:) ${rt}$ :: y(size(x)) - y(:) = exp(x(:) - maxval(x(:)) ) - y(:) = y(:) / sum(y(:)) + y = exp(x - maxval(x)) + y = y / sum(y) end function -pure function Softmax_grad_${rk}$( x ) result( y ) +pure function Softmax_r2_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) + + integer, intent(in), optional :: dim + integer :: dim_, j + + dim_ = 1; if(present(dim)) dim_ = dim + + if(dim_==1)then + do j = 1, size(x,dim=2) + y(:,j) = Softmax( x(:,j) ) + end do + else + do j = 1, size(x,dim=1) + y(j,:) = Softmax( x(j,:) ) + end do + end if +end function + +pure function Softmax_r3_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) + + integer, intent(in), optional :: dim + integer :: dim_, j + + dim_ = 1; if(present(dim)) dim_ = dim + + if(dim_<=2)then + do j = 1, size(x,dim=3) + y(:,:,j) = Softmax( x(:,:,j) , dim = dim_ ) + end do + else + do j = 1, size(x,dim=1) + y(j,:,:) = Softmax( x(j,:,:) , dim = 2 ) + end do + end if +end function + +pure function Softmax_r4_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) + + integer, intent(in), optional :: dim + integer :: dim_, j + + dim_ = 1; if(present(dim)) dim_ = dim + + if(dim_<=3)then + do j = 1, size(x,dim=4) + y(:,:,:,j) = Softmax( x(:,:,:,j) , dim = dim_ ) + end do + else + do j = 1, size(x,dim=1) + y(j,:,:,:) = Softmax( x(j,:,:,:) , dim = 3 ) + end do + end if +end function + +pure function Softmax_grad_r1_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x(:) ${rt}$ :: y(size(x)) - y = softmax_${rk}$(x) + y = Softmax(x) + y = y * (1_${rk}$ - y) +end function + +pure function Softmax_grad_r2_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) + + integer, intent(in), optional :: dim + integer :: dim_ + + dim_ = 1; if(present(dim)) dim_ = dim + + y = Softmax(x,dim_) + y = y * (1_${rk}$ - y) +end function + +pure function Softmax_grad_r3_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) + + integer, intent(in), optional :: dim + integer :: dim_ + + dim_ = 1; if(present(dim)) dim_ = dim + + y = Softmax(x,dim_) + y = y * (1_${rk}$ - y) +end function + +pure function Softmax_grad_r4_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) + + integer, intent(in), optional :: dim + integer :: dim_ + + dim_ = 1; if(present(dim)) dim_ = dim + + y = Softmax(x,dim_) y = y * (1_${rk}$ - y) end function From c1303e72b9a8d4a7e2a7da480fc8ee95ca8af968 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sat, 17 Aug 2024 12:17:34 +0200 Subject: [PATCH 03/13] move activations to specialfunctions, add specs --- .../stdlib_specialfunctions_activations.md | 525 ++++++++++++++++++ src/stdlib_specialfunctions.f90 | 34 -- src/stdlib_specialfunctions.fypp | 309 +++++++++++ ... stdlib_specialfunctions_activations.fypp} | 214 ++----- 4 files changed, 867 insertions(+), 215 deletions(-) create mode 100644 doc/specs/stdlib_specialfunctions_activations.md delete mode 100644 src/stdlib_specialfunctions.f90 create mode 100644 src/stdlib_specialfunctions.fypp rename src/{stdlib_math_activations.fypp => stdlib_specialfunctions_activations.fypp} (56%) diff --git a/doc/specs/stdlib_specialfunctions_activations.md b/doc/specs/stdlib_specialfunctions_activations.md new file mode 100644 index 000000000..187c54f50 --- /dev/null +++ b/doc/specs/stdlib_specialfunctions_activations.md @@ -0,0 +1,525 @@ +--- +title: specialfunctions +--- + +# Special functions - Neural Networks activations and their gradients + +[TOC] + +## `Gaussian` - Gaussian function + +### Status + +Experimental + +### Description + +Computes the gaussian function: +$$f(x)=\exp(-x^2)$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):gaussian(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Gaussian_grad` - Gradient of the Gaussian function + +### Status + +Experimental + +### Description + +Computes the gradient of the gaussian function: +$$f(x)=-2 * x * \exp( - x ^ 2)$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):gaussian_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Elu` - Exponential Linear Unit function + +### Status + +Experimental + +### Description + +Computes the gaussian function: +$$ +\text{f}(x) = +\begin{cases} +x, & \text{if } x \geq 0 \\ +a * (\exp(x) - 1), & \text{otherwise} +\end{cases} +$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):elu(interface)]] ` (x,a)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. +`a`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Elu_grad` - Gradient of the Exponential Linear Unit function + +### Status + +Experimental + +### Description + +Computes the gradient of the gaussian function: +$$ +\text{f}(x) = +\begin{cases} +1, & \text{if } x \geq 0 \\ +a * \exp(x), & \text{otherwise} +\end{cases} +$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):elu_grad(interface)]] ` (x,a)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. +`a`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Relu` - Rectified Linear Unit function + +### Status + +Experimental + +### Description + +Computes the Rectified Linear Unit function: +$$f(x) = \text{max}(0,x)$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):relu(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Relu_grad` - Gradient of the Rectified Linear Unit function + +### Status + +Experimental + +### Description + +Computes the gradient of the gaussian function: +$$ +f(x) = +\begin{cases} +1, & \text{if } x \geq 0 \\ +0, & \text{otherwise} +\end{cases} +$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):relu_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Gelu` - Gaussian Error Linear Unit function + +### Status + +Experimental + +### Description + +Computes the Gaussian Error Linear Unit function: +$$f(x) = \frac{1}{2} x ( 1 + \text{erf}(\frac{x}{\sqrt{2}}) ) $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):gelu(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Gelu_grad` - Gradient of the Gaussian Error Linear Unit function + +### Status + +Experimental + +### Description + +Computes the gradient of the gaussian error linear unit function: +$$ +f(x) = \frac{1}{2} ( 1 + \text{erf}(x \sqrt{2}) ) + x \sqrt{2} \exp( -\frac{1}{2} x^2) +$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):gelu_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Gelu_approx` - Approximation of the Gaussian Error Linear Unit function + +### Status + +Experimental + +### Description + +Computes a fast approximation of the Gaussian Error Linear Unit function using a fast $\text{erf}$ approximation: +$$f(x) = \frac{1}{2} x ( 1 + \text{ferf}(\frac{x}{\sqrt{2}}) ) $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):gelu_approx(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Gelu_approx_grad` - Gradient of the Approximated Gaussian Error Linear Unit function + +### Status + +Experimental + +### Description + +Computes the gradient of the gaussian error linear unit function using a fast $\text{erf}$ approximation: +$$ +f(x) = \frac{1}{2} ( 1 + \text{ferf}(x \sqrt{2}) ) + x \sqrt{2} \exp( -\frac{1}{2} x^2) +$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):gelu_approx_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Sigmoid` - Sigmoid function + +### Status + +Experimental + +### Description + +Computes the sigmoid function: +$$f(x) = \frac{1}{1+\exp(-x)} $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Sigmoid(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Sigmoid_grad` - Gradient of the Sigmoid function + +### Status + +Experimental + +### Description + +Computes the gradient of the Sigmoid function: +$$f(x) = \frac{\exp(x)}{(1+\exp(x))^2} $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Sigmoid_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Step` - Step function + +### Status + +Experimental + +### Description + +Computes the step function: +$$ +f(x) = +\begin{cases} +1, & \text{if } x > 0 \\ +0, & \text{otherwise} +\end{cases} +$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Step(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Step_grad` - Gradient of the Step function + +### Status + +Experimental + +### Description + +Computes the gradient of the Sigmoid function: +$$f(x) = 0 $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Step_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Softmax` - Softmax function + +### Status + +Experimental + +### Description + +Computes the Softmax function: +$$f(x) = \frac{\exp(x)-\text{max}(x_j)}{\sum_j{\exp(x)-\text{max}(x_j)}}$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Softmax(interface)]] ` (x,dim)` + +### Class + +Pure function for ranks 1 to 4. + +### Arguments + +`x`: Shall be an array of rank 1 to 4 of any `real` kind. +`dim`: integer scalar indicating upon which dimension to apply the normalization. + +### Return value + +The function returns an array with the same rank and kind as the input argument `x`. + +## `Softplus_grad` - Gradient of the Softplus function + +### Status + +Experimental + +### Description + +Computes the gradient of the Softmax function: +$$f(x,dim) = \text{Softmax}(x,dim)*(1-\text{Softmax}(x,dim)) $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Softmax_grad(interface)]] ` (x,dim)` + +### Class + +Pure function for ranks 1 to 4. + +### Arguments + +`x`: Shall be an array of rank 1 to 4 of any `real` kind. +`dim`: integer scalar indicating upon which dimension to apply the normalization. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Softplus` - Softplus function + +### Status + +Experimental + +### Description + +Computes the Softplus function: +$$f(x) = \log(\exp(x)+1)$$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Softplus(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Softplus_grad` - Gradient of the Softplus function + +### Status + +Experimental + +### Description + +Computes the gradient of the Softplus function: +$$f(x) = \frac{\exp(x)}{\exp(x)+1} $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):Softplus_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. \ No newline at end of file diff --git a/src/stdlib_specialfunctions.f90 b/src/stdlib_specialfunctions.f90 deleted file mode 100644 index a8f37bfac..000000000 --- a/src/stdlib_specialfunctions.f90 +++ /dev/null @@ -1,34 +0,0 @@ -module stdlib_specialfunctions - use stdlib_kinds, only: sp, dp, xdp, qp - - implicit none - - private - - public :: legendre - public :: dlegendre - - - interface legendre - !! version: experimental - !! - !! Legendre polynomial - pure elemental module function legendre_fp64(n,x) result(leg) - integer, intent(in) :: n - real(dp), intent(in) :: x - real(dp) :: leg - end function - end interface - - interface dlegendre - !! version: experimental - !! - !! First derivative Legendre polynomial - pure elemental module function dlegendre_fp64(n,x) result(dleg) - integer, intent(in) :: n - real(dp), intent(in) :: x - real(dp) :: dleg - end function - end interface - -end module stdlib_specialfunctions diff --git a/src/stdlib_specialfunctions.fypp b/src/stdlib_specialfunctions.fypp new file mode 100644 index 000000000..fda166239 --- /dev/null +++ b/src/stdlib_specialfunctions.fypp @@ -0,0 +1,309 @@ +#:include "common.fypp" +module stdlib_specialfunctions + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp + + implicit none + + private + + interface legendre + !! version: experimental + !! + !! Legendre polynomial + pure elemental module function legendre_fp64(n,x) result(leg) + integer, intent(in) :: n + real(dp), intent(in) :: x + real(dp) :: leg + end function + end interface + public :: legendre + + interface dlegendre + !! version: experimental + !! + !! First derivative Legendre polynomial + pure elemental module function dlegendre_fp64(n,x) result(dleg) + integer, intent(in) :: n + real(dp), intent(in) :: x + real(dp) :: dleg + end function + end interface + public :: dlegendre + + interface gaussian + !! Version: experimental + !! + !! gaussian function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function gaussian_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: gaussian + + interface gaussian_grad + !! Version: experimental + !! + !! gradient of the gaussian function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function gaussian_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: gaussian_grad + + interface elu + !! Version: experimental + !! + !! exponential linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function elu_${rk}$( x , a ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$, intent(in) :: a + end function + #:endfor + end interface + public :: elu + + interface elu_grad + !! Version: experimental + !! + !! gradient of the exponential linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function elu_grad_${rk}$( x , a ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$, intent(in) :: a + end function + #:endfor + end interface + public :: elu_grad + + interface relu + !! Version: experimental + !! + !! Rectified linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function relu_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: relu + + interface relu_grad + !! Version: experimental + !! + !! Gradient rectified linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function relu_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: relu_grad + + interface gelu + !! Version: experimental + !! + !! Gaussian error linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function gelu_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: gelu + + interface gelu_grad + !! Version: experimental + !! + !! Gradient of the gaussian error linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function gelu_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: gelu_grad + + interface gelu_approx + !! Version: experimental + !! + !! Approximated gaussian error linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function gelu_approx_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: gelu_approx + + interface gelu_approx_grad + !! Version: experimental + !! + !! Gradient of the approximated gaussian error linear unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function gelu_approx_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: gelu_approx_grad + + interface sigmoid + !! Version: experimental + !! + !! Sigmoid function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function sigmoid_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: sigmoid + + interface sigmoid_grad + !! Version: experimental + !! + !! Gradient of the sigmoid function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function sigmoid_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: sigmoid_grad + + interface step + !! Version: experimental + !! + !! Step function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function step_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: step + + interface step_grad + !! Version: experimental + !! + !! Gradient of the step function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function step_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: step_grad + + interface Softmax + !! Version: experimental + !! + !! Softmax function. Available for ranks 1 to 4 + #:for rk, rt in REAL_KINDS_TYPES + pure module function Softmax_r1_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x(:) + ${rt}$ :: y(size(x)) + end function + pure module function Softmax_r2_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) + integer, intent(in), optional :: dim + end function + pure module function Softmax_r3_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) + integer, intent(in), optional :: dim + end function + pure module function Softmax_r4_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) + integer, intent(in), optional :: dim + end function + #:endfor + end interface + public :: softmax + + interface Softmax_grad + !! Version: experimental + !! + !! Gradient of the softmax function. Available for ranks 1 to 4 + #:for rk, rt in REAL_KINDS_TYPES + pure module function Softmax_grad_r1_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x(:) + ${rt}$ :: y(size(x)) + end function + pure module function Softmax_grad_r2_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) + integer, intent(in), optional :: dim + end function + pure module function Softmax_grad_r3_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) + integer, intent(in), optional :: dim + end function + pure module function Softmax_grad_r4_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x(:,:,:,:) + ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) + integer, intent(in), optional :: dim + end function + #:endfor + end interface + public :: Softmax_grad + + interface Softplus + !! Version: experimental + !! + !! Softplus function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function Softplus_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: Softplus + + interface Softplus_grad + !! Version: experimental + !! + !! Gradient of the softplus function + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function Softplus_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: Softplus_grad + + interface ftanh + !! Version: experimental + !! + !! Fast approximation of the tanh function + !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function ftanh_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: ftanh + + interface ferf + !! Version: experimental + !! + !! Fast approximation of the erf function + !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 + #:for rk, rt in REAL_KINDS_TYPES + elemental ${rt}$ module function ferf_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + end function + #:endfor + end interface + public :: ferf + +end module stdlib_specialfunctions diff --git a/src/stdlib_math_activations.fypp b/src/stdlib_specialfunctions_activations.fypp similarity index 56% rename from src/stdlib_math_activations.fypp rename to src/stdlib_specialfunctions_activations.fypp index 3085c4699..f3f2ae359 100644 --- a/src/stdlib_math_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -1,154 +1,6 @@ #:include "common.fypp" -module stdlib_math_activations - use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp +submodule(stdlib_specialfunctions) stdlib_specialfunctions_activations implicit none - private - - interface gaussian - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: gaussian_${rk}$ - #:endfor - end interface - public :: gaussian - - interface gaussian_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: gaussian_grad_${rk}$ - #:endfor - end interface - public :: gaussian_grad - - interface elu - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: elu_${rk}$ - #:endfor - end interface - public :: elu - - interface elu_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: elu_grad_${rk}$ - #:endfor - end interface - public :: elu_grad - - interface relu - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: relu_${rk}$ - #:endfor - end interface - public :: relu - - interface relu_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: relu_grad_${rk}$ - #:endfor - end interface - public :: relu_grad - - interface gelu - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: gelu_${rk}$ - #:endfor - end interface - public :: gelu - - interface gelu_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: gelu_grad_${rk}$ - #:endfor - end interface - public :: gelu_grad - - interface gelu_approx - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: gelu_approx_${rk}$ - #:endfor - end interface - public :: gelu_approx - - interface gelu_approx_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: gelu_approx_grad_${rk}$ - #:endfor - end interface - public :: gelu_approx_grad - - interface sigmoid - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: sigmoid_${rk}$ - #:endfor - end interface - public :: sigmoid - - interface sigmoid_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: sigmoid_grad_${rk}$ - #:endfor - end interface - public :: sigmoid_grad - - interface step - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: step_${rk}$ - #:endfor - end interface - public :: step - - interface step_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: step_grad_${rk}$ - #:endfor - end interface - public :: step_grad - - interface Softmax - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: Softmax_r1_${rk}$ - module procedure :: Softmax_r2_${rk}$ - module procedure :: Softmax_r3_${rk}$ - module procedure :: Softmax_r4_${rk}$ - #:endfor - end interface - public :: softmax - - interface Softmax_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: Softmax_grad_r1_${rk}$ - module procedure :: Softmax_grad_r2_${rk}$ - module procedure :: Softmax_grad_r3_${rk}$ - module procedure :: Softmax_grad_r4_${rk}$ - #:endfor - end interface - public :: Softmax_grad - - interface Softplus - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: Softplus_${rk}$ - #:endfor - end interface - public :: Softplus - - interface Softplus_grad - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: Softplus_grad_${rk}$ - #:endfor - end interface - public :: Softplus_grad - - interface ftanh !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: ftanh_${rk}$ - #:endfor - end interface - public :: ftanh - - interface ferf !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 - #:for rk, rt in REAL_KINDS_TYPES - module procedure :: ferf_${rk}$ - #:endfor - end interface - public :: ferf #:for rk, rt in REAL_KINDS_TYPES ${rt}$, parameter :: isqrt2_${rk}$ = 1_${rk}$ / sqrt(2._${rk}$) @@ -160,13 +12,13 @@ contains ! Gaussian !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function gaussian_${rk}$( x ) result( y ) +elemental ${rt}$ module function gaussian_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = exp(-x**2) end function -elemental ${rt}$ function gaussian_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function gaussian_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = -2_${rk}$ * x * exp(-x**2) @@ -178,22 +30,22 @@ end function ! Exponential Linear Unit !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function elu_${rk}$( x , a ) result ( y ) +elemental ${rt}$ module function elu_${rk}$( x , a ) result ( y ) ${rt}$, intent(in) :: x ${rt}$, intent(in) :: a - if(x >= 0_${rk}$)then + if(x >= 0._${rk}$)then y = x else y = a * (exp(x) - 1_${rk}$) end if end function -elemental ${rt}$ function elu_grad_${rk}$( x , a ) result ( y ) +elemental ${rt}$ module function elu_grad_${rk}$( x , a ) result ( y ) ${rt}$, intent(in) :: x ${rt}$, intent(in) :: a - if(x >= 0_${rk}$)then + if(x >= 0._${rk}$)then y = 1_${rk}$ else y = a * exp(x) @@ -206,19 +58,19 @@ end function ! Rectified Linear Unit !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function relu_${rk}$( x ) result( y ) +elemental ${rt}$ module function relu_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = max(0_${rk}$, x) + y = max(0._${rk}$, x) end function -elemental ${rt}$ function relu_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function relu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - if(x > 0_${rk}$)then + if(x > 0._${rk}$)then y = 1_${rk}$ else - y = 0_${rk}$ + y = 0._${rk}$ end if end function @@ -228,29 +80,29 @@ end function ! GELU: Gaussian Error Linear Units function !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function gelu_${rk}$( x ) result( y ) +elemental ${rt}$ module function gelu_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 0.5_${rk}$ * x * (1 + ferf(x * isqrt2_${rk}$)) + y = 0.5_${rk}$ * x * (1 + erf(x * isqrt2_${rk}$)) end function -elemental ${rt}$ function gelu_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function gelu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 0.5_${rk}$ * (1 + ferf(x * isqrt2_${rk}$) ) + y = 0.5_${rk}$ * (1 + erf(x * isqrt2_${rk}$) ) y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 ) end function #:endfor #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function gelu_approx_${rk}$( x ) result( y ) +elemental ${rt}$ module function gelu_approx_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = 0.5_${rk}$ * x * (1 + ferf(x * isqrt2_${rk}$)) end function -elemental ${rt}$ function gelu_approx_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function gelu_approx_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = 0.5_${rk}$ * (1 + ferf(x * isqrt2_${rk}$) ) @@ -263,13 +115,13 @@ end function ! Sigmoid !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function sigmoid_${rk}$( x ) result( y ) +elemental ${rt}$ module function sigmoid_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = 1_${rk}$ / (1_${rk}$ + exp(-x)) end function -elemental ${rt}$ function sigmoid_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function sigmoid_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = exp(x) / (1_${rk}$ + exp(x))**2 @@ -281,20 +133,20 @@ end function ! Step !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function Step_${rk}$( x ) result( y ) +elemental ${rt}$ module function Step_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - if(x > 0_${rk}$)then + if(x > 0._${rk}$)then y = 1_${rk}$ else - y = 0_${rk}$ + y = 0._${rk}$ end if end function -elemental ${rt}$ function Step_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function Step_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 0_${rk}$ + y = 0._${rk}$ end function #:endfor @@ -303,13 +155,13 @@ end function ! tanh !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function tanh_${rk}$( x ) result( y ) +elemental ${rt}$ module function tanh_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = ftanh(x) end function -elemental ${rt}$ function tanh_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function tanh_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = 1_${rk}$ - ftanh(x)**2 @@ -424,7 +276,7 @@ pure function Softmax_grad_r3_${rk}$( x , dim ) result( y ) end function pure function Softmax_grad_r4_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:) + ${rt}$, intent(in) :: x(:,:,:,:) ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) integer, intent(in), optional :: dim @@ -442,13 +294,13 @@ end function ! Softplus !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function Softplus_${rk}$( x ) result( y ) +elemental ${rt}$ module function Softplus_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = log(exp(x) + 1_${rk}$) end function -elemental ${rt}$ function Softplus_grad_${rk}$( x ) result( y ) +elemental ${rt}$ module function Softplus_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x y = exp(x) / (exp(x) + 1_${rk}$) @@ -461,7 +313,7 @@ end function !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ function ftanh_${rk}$( x ) result( y ) +elemental ${rt}$ module function ftanh_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x ${rt}$ :: x2, a, b @@ -477,7 +329,7 @@ elemental ${rt}$ function ftanh_${rk}$( x ) result( y ) end if end function -elemental ${rt}$ function ferf_${rk}$( x ) result( y ) +elemental ${rt}$ module function ferf_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x ${rt}$ :: abs_x @@ -488,4 +340,4 @@ end function #:endfor -end module \ No newline at end of file +end submodule \ No newline at end of file From f22756a27b3abc46b5d5cfa6a379751f8ef1b6e1 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sat, 17 Aug 2024 12:25:16 +0200 Subject: [PATCH 04/13] fix float constant definition --- src/stdlib_specialfunctions_activations.fypp | 34 ++++++++++---------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/stdlib_specialfunctions_activations.fypp b/src/stdlib_specialfunctions_activations.fypp index f3f2ae359..2fabb8780 100644 --- a/src/stdlib_specialfunctions_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -3,7 +3,7 @@ submodule(stdlib_specialfunctions) stdlib_specialfunctions_activations implicit none #:for rk, rt in REAL_KINDS_TYPES - ${rt}$, parameter :: isqrt2_${rk}$ = 1_${rk}$ / sqrt(2._${rk}$) + ${rt}$, parameter :: isqrt2_${rk}$ = 1._${rk}$ / sqrt(2._${rk}$) #:endfor contains @@ -37,7 +37,7 @@ elemental ${rt}$ module function elu_${rk}$( x , a ) result ( y ) if(x >= 0._${rk}$)then y = x else - y = a * (exp(x) - 1_${rk}$) + y = a * (exp(x) - 1._${rk}$) end if end function @@ -46,7 +46,7 @@ elemental ${rt}$ module function elu_grad_${rk}$( x , a ) result ( y ) ${rt}$, intent(in) :: a if(x >= 0._${rk}$)then - y = 1_${rk}$ + y = 1._${rk}$ else y = a * exp(x) end if @@ -68,7 +68,7 @@ elemental ${rt}$ module function relu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x if(x > 0._${rk}$)then - y = 1_${rk}$ + y = 1._${rk}$ else y = 0._${rk}$ end if @@ -118,13 +118,13 @@ end function elemental ${rt}$ module function sigmoid_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 1_${rk}$ / (1_${rk}$ + exp(-x)) + y = 1._${rk}$ / (1._${rk}$ + exp(-x)) end function elemental ${rt}$ module function sigmoid_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = exp(x) / (1_${rk}$ + exp(x))**2 + y = exp(x) / (1._${rk}$ + exp(x))**2 end function #:endfor @@ -137,7 +137,7 @@ elemental ${rt}$ module function Step_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x if(x > 0._${rk}$)then - y = 1_${rk}$ + y = 1._${rk}$ else y = 0._${rk}$ end if @@ -164,7 +164,7 @@ end function elemental ${rt}$ module function tanh_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 1_${rk}$ - ftanh(x)**2 + y = 1._${rk}$ - ftanh(x)**2 end function #:endfor @@ -246,7 +246,7 @@ pure function Softmax_grad_r1_${rk}$( x ) result( y ) ${rt}$ :: y(size(x)) y = Softmax(x) - y = y * (1_${rk}$ - y) + y = y * (1._${rk}$ - y) end function pure function Softmax_grad_r2_${rk}$( x , dim ) result( y ) @@ -259,7 +259,7 @@ pure function Softmax_grad_r2_${rk}$( x , dim ) result( y ) dim_ = 1; if(present(dim)) dim_ = dim y = Softmax(x,dim_) - y = y * (1_${rk}$ - y) + y = y * (1._${rk}$ - y) end function pure function Softmax_grad_r3_${rk}$( x , dim ) result( y ) @@ -272,7 +272,7 @@ pure function Softmax_grad_r3_${rk}$( x , dim ) result( y ) dim_ = 1; if(present(dim)) dim_ = dim y = Softmax(x,dim_) - y = y * (1_${rk}$ - y) + y = y * (1._${rk}$ - y) end function pure function Softmax_grad_r4_${rk}$( x , dim ) result( y ) @@ -285,7 +285,7 @@ pure function Softmax_grad_r4_${rk}$( x , dim ) result( y ) dim_ = 1; if(present(dim)) dim_ = dim y = Softmax(x,dim_) - y = y * (1_${rk}$ - y) + y = y * (1._${rk}$ - y) end function #:endfor @@ -297,13 +297,13 @@ end function elemental ${rt}$ module function Softplus_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = log(exp(x) + 1_${rk}$) + y = log(exp(x) + 1._${rk}$) end function elemental ${rt}$ module function Softplus_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = exp(x) / (exp(x) + 1_${rk}$) + y = exp(x) / (exp(x) + 1._${rk}$) end function #:endfor @@ -318,9 +318,9 @@ elemental ${rt}$ module function ftanh_${rk}$( x ) result( y ) ${rt}$ :: x2, a, b if (x > 5_${rk}$) then - y = 1_${rk}$ + y = 1._${rk}$ elseif (x < -5_${rk}$) then - y = -1_${rk}$ + y = -1._${rk}$ else x2 = x*x a = x * (135135.0_${rk}$ + x2 * (17325.0_${rk}$ + x2 * (378.0_${rk}$ + x2))) @@ -334,7 +334,7 @@ elemental ${rt}$ module function ferf_${rk}$( x ) result( y ) ${rt}$ :: abs_x abs_x = abs(x) - y = 1_${rk}$ - 1_${rk}$ / (1+ 0.278393_${rk}$*abs_x + 0.230389_${rk}$*abs_x**2 + 0.000972_${rk}$*abs_x**3 + 0.078108_${rk}$*abs_x**4)**4 + y = 1._${rk}$ - 1._${rk}$ / (1+ 0.278393_${rk}$*abs_x + 0.230389_${rk}$*abs_x**2 + 0.000972_${rk}$*abs_x**3 + 0.078108_${rk}$*abs_x**4)**4 y = y * sign(1.0_${rk}$,x) end function From b1a41809c789d0d194afe1686c452c32f5383d03 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sat, 17 Aug 2024 12:33:22 +0200 Subject: [PATCH 05/13] fix float constant definition --- src/stdlib_specialfunctions_activations.fypp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_specialfunctions_activations.fypp b/src/stdlib_specialfunctions_activations.fypp index 2fabb8780..9b0545d5d 100644 --- a/src/stdlib_specialfunctions_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -21,7 +21,7 @@ end function elemental ${rt}$ module function gaussian_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = -2_${rk}$ * x * exp(-x**2) + y = -2._${rk}$ * x * exp(-x**2) end function #:endfor @@ -99,13 +99,13 @@ end function elemental ${rt}$ module function gelu_approx_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 0.5_${rk}$ * x * (1 + ferf(x * isqrt2_${rk}$)) + y = 0.5_${rk}$ * x * (1._${rk}$ + ferf(x * isqrt2_${rk}$)) end function elemental ${rt}$ module function gelu_approx_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 0.5_${rk}$ * (1 + ferf(x * isqrt2_${rk}$) ) + y = 0.5_${rk}$ * (1._${rk}$ + ferf(x * isqrt2_${rk}$) ) y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 ) end function @@ -334,7 +334,7 @@ elemental ${rt}$ module function ferf_${rk}$( x ) result( y ) ${rt}$ :: abs_x abs_x = abs(x) - y = 1._${rk}$ - 1._${rk}$ / (1+ 0.278393_${rk}$*abs_x + 0.230389_${rk}$*abs_x**2 + 0.000972_${rk}$*abs_x**3 + 0.078108_${rk}$*abs_x**4)**4 + y = 1._${rk}$ - 1._${rk}$ / (1._${rk}$+ 0.278393_${rk}$*abs_x + 0.230389_${rk}$*abs_x**2 + 0.000972_${rk}$*abs_x**3 + 0.078108_${rk}$*abs_x**4)**4 y = y * sign(1.0_${rk}$,x) end function From 90b8de3c5bcf98123a3890304f03329eb44f4681 Mon Sep 17 00:00:00 2001 From: jalvesz Date: Sat, 17 Aug 2024 14:52:14 +0200 Subject: [PATCH 06/13] fix float constant definition --- src/stdlib_specialfunctions_activations.fypp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_specialfunctions_activations.fypp b/src/stdlib_specialfunctions_activations.fypp index 9b0545d5d..7bcd9a5db 100644 --- a/src/stdlib_specialfunctions_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -83,13 +83,13 @@ end function elemental ${rt}$ module function gelu_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 0.5_${rk}$ * x * (1 + erf(x * isqrt2_${rk}$)) + y = 0.5_${rk}$ * x * (1._${rk}$ + erf(x * isqrt2_${rk}$)) end function elemental ${rt}$ module function gelu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - y = 0.5_${rk}$ * (1 + erf(x * isqrt2_${rk}$) ) + y = 0.5_${rk}$ * (1._${rk}$ + erf(x * isqrt2_${rk}$) ) y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 ) end function @@ -317,9 +317,9 @@ elemental ${rt}$ module function ftanh_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x ${rt}$ :: x2, a, b - if (x > 5_${rk}$) then + if (x > 5._${rk}$) then y = 1._${rk}$ - elseif (x < -5_${rk}$) then + elseif (x < -5._${rk}$) then y = -1._${rk}$ else x2 = x*x From 1b3bf4fb2895b1bccaa2a19e778a2b64789ef2b8 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Mon, 19 Aug 2024 13:53:05 +0200 Subject: [PATCH 07/13] update src CMakeLists --- src/CMakeLists.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ef11b642e..4102192ca 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -40,7 +40,9 @@ set(fppFiles stdlib_sorting_ord_sort.fypp stdlib_sorting_sort.fypp stdlib_sorting_sort_index.fypp + stdlib_specialfunctions_activations.fypp stdlib_specialfunctions_gamma.fypp + stdlib_specialfunctions.fypp stdlib_stats.fypp stdlib_stats_corr.fypp stdlib_stats_cov.fypp @@ -112,7 +114,6 @@ set(SRC stdlib_logger.f90 stdlib_sorting_radix_sort.f90 stdlib_system.F90 - stdlib_specialfunctions.f90 stdlib_specialfunctions_legendre.f90 stdlib_quadrature_gauss.f90 stdlib_stringlist_type.f90 From f4ad250ec9952530783371ba77529f681583fdfd Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Mon, 19 Aug 2024 15:11:21 +0200 Subject: [PATCH 08/13] add tests for activations --- test/specialfunctions/CMakeLists.txt | 1 + .../test_specialfunctions_activations.fypp | 127 ++++++++++++++++++ 2 files changed, 128 insertions(+) create mode 100644 test/specialfunctions/test_specialfunctions_activations.fypp diff --git a/test/specialfunctions/CMakeLists.txt b/test/specialfunctions/CMakeLists.txt index caa3a96b5..46ede5f15 100644 --- a/test/specialfunctions/CMakeLists.txt +++ b/test/specialfunctions/CMakeLists.txt @@ -2,6 +2,7 @@ # Create a list of the files to be preprocessed set(fppFiles + test_specialfunctions_activations.fypp test_specialfunctions_gamma.fypp ) diff --git a/test/specialfunctions/test_specialfunctions_activations.fypp b/test/specialfunctions/test_specialfunctions_activations.fypp new file mode 100644 index 000000000..1040a2d59 --- /dev/null +++ b/test/specialfunctions/test_specialfunctions_activations.fypp @@ -0,0 +1,127 @@ +#:include "common.fypp" +#:set R_KINDS_TYPES = [KT for KT in REAL_KINDS_TYPES if KT[0] in ["sp","dp"]] + +module test_specialfunctions_activation + use testdrive, only : new_unittest, unittest_type, error_type, check + use stdlib_kinds + use stdlib_specialfunctions + + implicit none + private + + public :: collect_specialfunctions_activation + + #:for k1, t1 in R_KINDS_TYPES + ${t1}$, parameter :: tol_${k1}$ = 1000 * epsilon(1.0_${k1}$) + #:endfor + +contains + + subroutine collect_specialfunctions_activation(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("softmax", test_softmax) & + ] + end subroutine collect_specialfunctions_activation + + subroutine test_softmax(error) + type(error_type), allocatable, intent(out) :: error + + real(sp) :: x(3,3,3), y(3,3,3), y_ref(3,3,3) + + x = reshape( [ 0.82192878, 0.76998032, 0.98611263,& + 0.8621334 , 0.65358045, 0.26387113,& + 0.12743663, 0.35237132, 0.23801647,& + + 0.69773567, 0.40568874, 0.44789482,& + 0.42930753, 0.49579193, 0.53139985,& + 0.03035799, 0.65293157, 0.47613957,& + + 0.21088634, 0.9356926 , 0.0991312 ,& + 0.46070181, 0.02943479, 0.17557538,& + 0.10541313, 0.33946349, 0.34804323 ] ,[3,3,3] ) + + !> Softmax on dim = 1 + y = Softmax(x,dim=1) + + y_ref = reshape( [ 0.319712639, 0.303528070, 0.376759291,& + 0.423455358, 0.343743294, 0.232801422,& + 0.296809316, 0.371676773, 0.331513911,& + + 0.395936400, 0.295658976, 0.308404684,& + 0.314838648, 0.336482018, 0.348679334,& + 0.225966826, 0.421138495, 0.352894694,& + + 0.252614945, 0.521480858, 0.225904226,& + 0.416388273, 0.270521373, 0.313090324,& + 0.282621205, 0.357150704, 0.360228121 ] ,[3,3,3] ) + + call check(error, norm2(y-y_ref) < tol_sp ) + if (allocated(error)) return + + !> Softmax on dim = 2 + y = Softmax(x,dim=2) + + y_ref = reshape( [ 0.393646270, 0.392350882, 0.510482967,& + 0.409795105, 0.349239051, 0.247922391,& + 0.196558580, 0.258410037, 0.241594598,& + + 0.439052343, 0.296315849, 0.320951223,& + 0.335690796, 0.324254662, 0.348903090,& + 0.225256786, 0.379429489, 0.330145657,& + + 0.314101219, 0.511530280, 0.297435701,& + 0.403239518, 0.206675291, 0.321064562,& + 0.282659233, 0.281794399, 0.381499708 ] ,[3,3,3] ) + + call check(error, norm2(y-y_ref) < tol_sp ) + if (allocated(error)) return + + !> Softmax on dim = 3 + y = Softmax(x,dim=3) + + y_ref = reshape( [ 0.412202179, 0.347835541, 0.501081109,& + 0.431399941, 0.418453932, 0.310344934,& + 0.346536130, 0.299599379, 0.295405835,& + + 0.364060789, 0.241637364, 0.292525023,& + 0.279837668, 0.357372403, 0.405537367,& + 0.314476222, 0.404643506, 0.374830246,& + + 0.223737061, 0.410527140, 0.206393898,& + 0.288762331, 0.224173695, 0.284117699,& + 0.338987619, 0.295757085, 0.329763889 ] ,[3,3,3] ) + + call check(error, norm2(y-y_ref) < tol_sp ) + if (allocated(error)) return + + end subroutine test_softmax + + +end module test_specialfunctions_activation + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_specialfunctions_activation, only : collect_specialfunctions_activation + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [new_testsuite("activation functions", & + collect_specialfunctions_activation)] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program tester \ No newline at end of file From 9d7eb7ca55f02b1640d1c68173665d0c0b639052 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Tue, 20 Aug 2024 21:22:27 +0200 Subject: [PATCH 09/13] add tests for sigmoid and gelu --- .../test_specialfunctions_activations.fypp | 40 ++++++++++++++++++- 1 file changed, 38 insertions(+), 2 deletions(-) diff --git a/test/specialfunctions/test_specialfunctions_activations.fypp b/test/specialfunctions/test_specialfunctions_activations.fypp index 1040a2d59..cc33c7b6a 100644 --- a/test/specialfunctions/test_specialfunctions_activations.fypp +++ b/test/specialfunctions/test_specialfunctions_activations.fypp @@ -5,7 +5,7 @@ module test_specialfunctions_activation use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_kinds use stdlib_specialfunctions - + use stdlib_math, only: linspace implicit none private @@ -21,10 +21,46 @@ contains type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & + new_unittest("sigmoid", test_sigmoid), & + new_unittest("gelu" , test_gelu ), & new_unittest("softmax", test_softmax) & ] end subroutine collect_specialfunctions_activation + subroutine test_sigmoid(error) + type(error_type), allocatable, intent(out) :: error + integer, parameter :: n = 10 + real(sp) :: x(n), y(n), y_ref(n) + + y_ref = [0.119202919304371, 0.174285307526588, 0.247663781046867,& + 0.339243650436401, 0.444671928882599, 0.555328071117401,& + 0.660756349563599, 0.752336204051971, 0.825714707374573,& + 0.880797028541565] + x = linspace(-2._sp, 2._sp, n) + y = sigmoid( x ) + call check(error, norm2(y-y_ref) < n*tol_sp ) + if (allocated(error)) return + end subroutine + + subroutine test_gelu(error) + type(error_type), allocatable, intent(out) :: error + integer, parameter :: n = 10 + real(sp) :: x(n), y(n), y_ref(n) + + y_ref = [-0.0455002784729 , -0.093188509345055, -0.148066952824593,& + -0.168328359723091, -0.0915712043643 , 0.130650997161865,& + 0.498338282108307, 0.963044226169586, 1.462367057800293,& + 1.9544997215271 ] + x = linspace(-2._sp, 2._sp, n) + y = gelu( x ) + call check(error, norm2(y-y_ref) < n*tol_sp ) + if (allocated(error)) return + + y = gelu_approx( x ) + call check(error, norm2(y-y_ref) < n*tol_sp ) + if (allocated(error)) return + end subroutine + subroutine test_softmax(error) type(error_type), allocatable, intent(out) :: error @@ -88,7 +124,7 @@ contains 0.364060789, 0.241637364, 0.292525023,& 0.279837668, 0.357372403, 0.405537367,& 0.314476222, 0.404643506, 0.374830246,& - + 0.223737061, 0.410527140, 0.206393898,& 0.288762331, 0.224173695, 0.284117699,& 0.338987619, 0.295757085, 0.329763889 ] ,[3,3,3] ) From 5727921db172e30ec2f183a19573de5379f77fa6 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Tue, 20 Aug 2024 21:33:31 +0200 Subject: [PATCH 10/13] missing module procedure --- src/stdlib_specialfunctions_activations.fypp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/stdlib_specialfunctions_activations.fypp b/src/stdlib_specialfunctions_activations.fypp index 7bcd9a5db..0638d2e91 100644 --- a/src/stdlib_specialfunctions_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -173,7 +173,7 @@ end function ! Softmax !================================================== #:for rk, rt in REAL_KINDS_TYPES -pure function Softmax_r1_${rk}$( x ) result( y ) +pure module function Softmax_r1_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x(:) ${rt}$ :: y(size(x)) @@ -181,7 +181,7 @@ pure function Softmax_r1_${rk}$( x ) result( y ) y = y / sum(y) end function -pure function Softmax_r2_${rk}$( x , dim ) result( y ) +pure module function Softmax_r2_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:,:) ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) @@ -201,7 +201,7 @@ pure function Softmax_r2_${rk}$( x , dim ) result( y ) end if end function -pure function Softmax_r3_${rk}$( x , dim ) result( y ) +pure module function Softmax_r3_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:,:,:) ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) @@ -221,7 +221,7 @@ pure function Softmax_r3_${rk}$( x , dim ) result( y ) end if end function -pure function Softmax_r4_${rk}$( x , dim ) result( y ) +pure module function Softmax_r4_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:,:,:,:) ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) @@ -241,7 +241,7 @@ pure function Softmax_r4_${rk}$( x , dim ) result( y ) end if end function -pure function Softmax_grad_r1_${rk}$( x ) result( y ) +pure module function Softmax_grad_r1_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x(:) ${rt}$ :: y(size(x)) @@ -249,7 +249,7 @@ pure function Softmax_grad_r1_${rk}$( x ) result( y ) y = y * (1._${rk}$ - y) end function -pure function Softmax_grad_r2_${rk}$( x , dim ) result( y ) +pure module function Softmax_grad_r2_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:,:) ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) @@ -262,7 +262,7 @@ pure function Softmax_grad_r2_${rk}$( x , dim ) result( y ) y = y * (1._${rk}$ - y) end function -pure function Softmax_grad_r3_${rk}$( x , dim ) result( y ) +pure module function Softmax_grad_r3_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:,:,:) ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) @@ -275,7 +275,7 @@ pure function Softmax_grad_r3_${rk}$( x , dim ) result( y ) y = y * (1._${rk}$ - y) end function -pure function Softmax_grad_r4_${rk}$( x , dim ) result( y ) +pure module function Softmax_grad_r4_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:,:,:,:) ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) From 2ed7626f57818144103ed3c6ffde307dc7d753ce Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Tue, 20 Aug 2024 22:16:12 +0200 Subject: [PATCH 11/13] missing interface and change of kind definition for elemental module functions --- src/stdlib_specialfunctions.fypp | 80 +++++++++++++++----- src/stdlib_specialfunctions_activations.fypp | 78 +++++++++---------- 2 files changed, 102 insertions(+), 56 deletions(-) diff --git a/src/stdlib_specialfunctions.fypp b/src/stdlib_specialfunctions.fypp index fda166239..2a7766505 100644 --- a/src/stdlib_specialfunctions.fypp +++ b/src/stdlib_specialfunctions.fypp @@ -35,8 +35,9 @@ module stdlib_specialfunctions !! !! gaussian function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function gaussian_${rk}$( x ) result( y ) + elemental module function gaussian_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -47,8 +48,9 @@ module stdlib_specialfunctions !! !! gradient of the gaussian function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function gaussian_grad_${rk}$( x ) result( y ) + elemental module function gaussian_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -59,9 +61,10 @@ module stdlib_specialfunctions !! !! exponential linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function elu_${rk}$( x , a ) result( y ) + elemental module function elu_${rk}$( x , a ) result( y ) ${rt}$, intent(in) :: x ${rt}$, intent(in) :: a + ${rt}$ :: y end function #:endfor end interface @@ -72,9 +75,10 @@ module stdlib_specialfunctions !! !! gradient of the exponential linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function elu_grad_${rk}$( x , a ) result( y ) + elemental module function elu_grad_${rk}$( x , a ) result( y ) ${rt}$, intent(in) :: x ${rt}$, intent(in) :: a + ${rt}$ :: y end function #:endfor end interface @@ -85,8 +89,9 @@ module stdlib_specialfunctions !! !! Rectified linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function relu_${rk}$( x ) result( y ) + elemental module function relu_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -97,8 +102,9 @@ module stdlib_specialfunctions !! !! Gradient rectified linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function relu_grad_${rk}$( x ) result( y ) + elemental module function relu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -109,8 +115,9 @@ module stdlib_specialfunctions !! !! Gaussian error linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function gelu_${rk}$( x ) result( y ) + elemental module function gelu_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -121,8 +128,9 @@ module stdlib_specialfunctions !! !! Gradient of the gaussian error linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function gelu_grad_${rk}$( x ) result( y ) + elemental module function gelu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -133,8 +141,9 @@ module stdlib_specialfunctions !! !! Approximated gaussian error linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function gelu_approx_${rk}$( x ) result( y ) + elemental module function gelu_approx_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -145,8 +154,9 @@ module stdlib_specialfunctions !! !! Gradient of the approximated gaussian error linear unit function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function gelu_approx_grad_${rk}$( x ) result( y ) + elemental module function gelu_approx_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -157,8 +167,9 @@ module stdlib_specialfunctions !! !! Sigmoid function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function sigmoid_${rk}$( x ) result( y ) + elemental module function sigmoid_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -169,8 +180,9 @@ module stdlib_specialfunctions !! !! Gradient of the sigmoid function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function sigmoid_grad_${rk}$( x ) result( y ) + elemental module function sigmoid_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -181,8 +193,9 @@ module stdlib_specialfunctions !! !! Step function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function step_${rk}$( x ) result( y ) + elemental module function step_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -193,13 +206,40 @@ module stdlib_specialfunctions !! !! Gradient of the step function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function step_grad_${rk}$( x ) result( y ) + elemental module function step_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface public :: step_grad + interface tanh + !! Version: experimental + !! + !! gaussian function + #:for rk, rt in REAL_KINDS_TYPES + elemental module function tanh_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: y + end function + #:endfor + end interface + public :: tanh + + interface tanh_grad + !! Version: experimental + !! + !! gradient of the gaussian function + #:for rk, rt in REAL_KINDS_TYPES + elemental module function tanh_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: y + end function + #:endfor + end interface + public :: tanh_grad + interface Softmax !! Version: experimental !! @@ -261,8 +301,9 @@ module stdlib_specialfunctions !! !! Softplus function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function Softplus_${rk}$( x ) result( y ) + elemental module function Softplus_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -273,8 +314,9 @@ module stdlib_specialfunctions !! !! Gradient of the softplus function #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function Softplus_grad_${rk}$( x ) result( y ) + elemental module function Softplus_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -286,8 +328,9 @@ module stdlib_specialfunctions !! Fast approximation of the tanh function !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function ftanh_${rk}$( x ) result( y ) + elemental module function ftanh_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface @@ -299,8 +342,9 @@ module stdlib_specialfunctions !! Fast approximation of the erf function !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31 #:for rk, rt in REAL_KINDS_TYPES - elemental ${rt}$ module function ferf_${rk}$( x ) result( y ) + elemental module function ferf_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y end function #:endfor end interface diff --git a/src/stdlib_specialfunctions_activations.fypp b/src/stdlib_specialfunctions_activations.fypp index 0638d2e91..990ac1116 100644 --- a/src/stdlib_specialfunctions_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -12,15 +12,15 @@ contains ! Gaussian !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function gaussian_${rk}$( x ) result( y ) +elemental module function gaussian_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = exp(-x**2) end function -elemental ${rt}$ module function gaussian_grad_${rk}$( x ) result( y ) +elemental module function gaussian_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = -2._${rk}$ * x * exp(-x**2) end function @@ -30,10 +30,10 @@ end function ! Exponential Linear Unit !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function elu_${rk}$( x , a ) result ( y ) +elemental module function elu_${rk}$( x , a ) result ( y ) ${rt}$, intent(in) :: x ${rt}$, intent(in) :: a - + ${rt}$ :: y if(x >= 0._${rk}$)then y = x else @@ -41,10 +41,10 @@ elemental ${rt}$ module function elu_${rk}$( x , a ) result ( y ) end if end function -elemental ${rt}$ module function elu_grad_${rk}$( x , a ) result ( y ) +elemental module function elu_grad_${rk}$( x , a ) result ( y ) ${rt}$, intent(in) :: x ${rt}$, intent(in) :: a - + ${rt}$ :: y if(x >= 0._${rk}$)then y = 1._${rk}$ else @@ -58,15 +58,15 @@ end function ! Rectified Linear Unit !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function relu_${rk}$( x ) result( y ) +elemental module function relu_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = max(0._${rk}$, x) end function -elemental ${rt}$ module function relu_grad_${rk}$( x ) result( y ) +elemental module function relu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y if(x > 0._${rk}$)then y = 1._${rk}$ else @@ -80,15 +80,15 @@ end function ! GELU: Gaussian Error Linear Units function !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function gelu_${rk}$( x ) result( y ) +elemental module function gelu_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = 0.5_${rk}$ * x * (1._${rk}$ + erf(x * isqrt2_${rk}$)) end function -elemental ${rt}$ module function gelu_grad_${rk}$( x ) result( y ) +elemental module function gelu_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = 0.5_${rk}$ * (1._${rk}$ + erf(x * isqrt2_${rk}$) ) y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 ) end function @@ -96,15 +96,15 @@ end function #:endfor #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function gelu_approx_${rk}$( x ) result( y ) +elemental module function gelu_approx_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = 0.5_${rk}$ * x * (1._${rk}$ + ferf(x * isqrt2_${rk}$)) end function -elemental ${rt}$ module function gelu_approx_grad_${rk}$( x ) result( y ) +elemental module function gelu_approx_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = 0.5_${rk}$ * (1._${rk}$ + ferf(x * isqrt2_${rk}$) ) y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 ) end function @@ -115,15 +115,15 @@ end function ! Sigmoid !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function sigmoid_${rk}$( x ) result( y ) +elemental module function sigmoid_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = 1._${rk}$ / (1._${rk}$ + exp(-x)) end function -elemental ${rt}$ module function sigmoid_grad_${rk}$( x ) result( y ) +elemental module function sigmoid_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = exp(x) / (1._${rk}$ + exp(x))**2 end function @@ -133,9 +133,9 @@ end function ! Step !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function Step_${rk}$( x ) result( y ) +elemental module function Step_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y if(x > 0._${rk}$)then y = 1._${rk}$ else @@ -143,9 +143,9 @@ elemental ${rt}$ module function Step_${rk}$( x ) result( y ) end if end function -elemental ${rt}$ module function Step_grad_${rk}$( x ) result( y ) +elemental module function Step_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = 0._${rk}$ end function @@ -155,15 +155,15 @@ end function ! tanh !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function tanh_${rk}$( x ) result( y ) +elemental module function tanh_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = ftanh(x) end function -elemental ${rt}$ module function tanh_grad_${rk}$( x ) result( y ) +elemental module function tanh_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = 1._${rk}$ - ftanh(x)**2 end function @@ -294,15 +294,15 @@ end function ! Softplus !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function Softplus_${rk}$( x ) result( y ) +elemental module function Softplus_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = log(exp(x) + 1._${rk}$) end function -elemental ${rt}$ module function Softplus_grad_${rk}$( x ) result( y ) +elemental module function Softplus_grad_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x - + ${rt}$ :: y y = exp(x) / (exp(x) + 1._${rk}$) end function @@ -313,8 +313,9 @@ end function !================================================== #:for rk, rt in REAL_KINDS_TYPES -elemental ${rt}$ module function ftanh_${rk}$( x ) result( y ) +elemental module function ftanh_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y ${rt}$ :: x2, a, b if (x > 5._${rk}$) then @@ -329,8 +330,9 @@ elemental ${rt}$ module function ftanh_${rk}$( x ) result( y ) end if end function -elemental ${rt}$ module function ferf_${rk}$( x ) result( y ) +elemental module function ferf_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x + ${rt}$ :: y ${rt}$ :: abs_x abs_x = abs(x) From f1acf1e5657190fe02a3acf0ba3171135da1c7b5 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Wed, 21 Aug 2024 09:05:20 +0200 Subject: [PATCH 12/13] add SiLU activation --- .../stdlib_specialfunctions_activations.md | 56 ++++++++++++++++++- src/stdlib_specialfunctions.fypp | 26 +++++++++ src/stdlib_specialfunctions_activations.fypp | 19 +++++++ 3 files changed, 100 insertions(+), 1 deletion(-) diff --git a/doc/specs/stdlib_specialfunctions_activations.md b/doc/specs/stdlib_specialfunctions_activations.md index 187c54f50..ecbb91b5b 100644 --- a/doc/specs/stdlib_specialfunctions_activations.md +++ b/doc/specs/stdlib_specialfunctions_activations.md @@ -354,6 +354,60 @@ Elemental function The function returns a value with the same type and kind as input argument. +## `SiLU` - Sigmoid Linear Unit function + +### Status + +Experimental + +### Description + +Computes the Sigmoid Linear Unit function: +$$f(x) = \frac{x}{1+\exp(-x)} $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):silu(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + +## `Silu_grad` - Gradient of the Sigmoid Linear Unit function + +### Status + +Experimental + +### Description + +Computes the gradient of the Sigmoid function: +$$f(x) = \frac{\exp(x)*(x+(1+\exp(x))^2)}{(1+\exp(x))^2} $$ + +### Syntax + +`result = ` [[stdlib_specialfunctions(module):silu_grad(interface)]] ` (x)` + +### Class + +Elemental function + +### Arguments + +`x`: Shall be a scalar or array of any `real` kind. + +### Return value + +The function returns a value with the same type and kind as input argument. + ## `Step` - Step function ### Status @@ -442,7 +496,7 @@ Pure function for ranks 1 to 4. The function returns an array with the same rank and kind as the input argument `x`. -## `Softplus_grad` - Gradient of the Softplus function +## `Softmax_grad` - Gradient of the Softmax function ### Status diff --git a/src/stdlib_specialfunctions.fypp b/src/stdlib_specialfunctions.fypp index 2a7766505..4864459b5 100644 --- a/src/stdlib_specialfunctions.fypp +++ b/src/stdlib_specialfunctions.fypp @@ -187,6 +187,32 @@ module stdlib_specialfunctions #:endfor end interface public :: sigmoid_grad + + interface silu + !! Version: experimental + !! + !! Sigmoid Linear Unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental module function silu_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: y + end function + #:endfor + end interface + public :: silu + + interface silu_grad + !! Version: experimental + !! + !! Gradient of the Sigmoid Linear Unit function + #:for rk, rt in REAL_KINDS_TYPES + elemental module function silu_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: y + end function + #:endfor + end interface + public :: silu_grad interface step !! Version: experimental diff --git a/src/stdlib_specialfunctions_activations.fypp b/src/stdlib_specialfunctions_activations.fypp index 990ac1116..c8a50710b 100644 --- a/src/stdlib_specialfunctions_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -129,6 +129,25 @@ end function #:endfor +!================================================== +! SiLU: Sigmoid Linear Unit +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +elemental module function silu_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: y + y = x / (1._${rk}$ + exp(-x)) +end function + +elemental module function silu_grad_${rk}$( x ) result( y ) + ${rt}$, intent(in) :: x + ${rt}$ :: y + y = (1._${rk}$ + exp(x))**2 + y = exp(x) * ( x + y ) / y +end function + +#:endfor + !================================================== ! Step !================================================== From 5c47bf03209dcdb56f524184f63d7ac2d05ffa00 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Sun, 29 Sep 2024 17:02:59 +0200 Subject: [PATCH 13/13] add any rank support for softmax and logsoftmax --- include/common.fypp | 23 ++++ src/stdlib_specialfunctions.fypp | 53 +++---- src/stdlib_specialfunctions_activations.fypp | 130 ++++++++---------- .../test_specialfunctions_activations.fypp | 71 ++++++++++ 4 files changed, 185 insertions(+), 92 deletions(-) diff --git a/include/common.fypp b/include/common.fypp index 0d861aead..bd71f7394 100644 --- a/include/common.fypp +++ b/include/common.fypp @@ -194,6 +194,29 @@ ${prefix + joinstr.join([line.strip() for line in txt.split("\n")]) + suffix}$ #:endif #:enddef +#! Brace enclosed, comma separated Fortran expressions for a shape. +#! +#! It defines an output variable with the same shape as the input variable. +#! +#! Args: +#! varname (str): Name of the variable to be used as origin +#! origrank (int): Rank of the original variable +#! +#! Returns: +#! Shape expression enclosed in braces, so that it can be used as suffix to +#! define array shapes in declarations. +#! +#:def shape(varname, origrank) + #:assert origrank > 0 + #:if origrank > 1 + #:call join_lines(joinstr=", ", prefix="(", suffix=")") + #:for i in range(1, origrank+1) + size(${varname}$, ${i}$) + #:endfor + #:endcall + #:endif +#:enddef + #! Generates a routine name from a generic name, rank, type and kind #! diff --git a/src/stdlib_specialfunctions.fypp b/src/stdlib_specialfunctions.fypp index 4864459b5..1f431df87 100644 --- a/src/stdlib_specialfunctions.fypp +++ b/src/stdlib_specialfunctions.fypp @@ -1,4 +1,5 @@ #:include "common.fypp" +#:set RANKS = range(2, MAXRANK + 1) module stdlib_specialfunctions use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp @@ -271,26 +272,19 @@ module stdlib_specialfunctions !! !! Softmax function. Available for ranks 1 to 4 #:for rk, rt in REAL_KINDS_TYPES - pure module function Softmax_r1_${rk}$( x ) result( y ) + pure module function Softmax_r1_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:) ${rt}$ :: y(size(x)) - end function - pure module function Softmax_r2_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) - integer, intent(in), optional :: dim - end function - pure module function Softmax_r3_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) integer, intent(in), optional :: dim end function - pure module function Softmax_r4_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) + #:for rank in RANKS + pure module function Softmax_r${rank}$_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x${ranksuffix(rank)}$ + ${rt}$ :: y${shape('x', rank)}$ integer, intent(in), optional :: dim end function #:endfor + #:endfor end interface public :: softmax @@ -303,24 +297,37 @@ module stdlib_specialfunctions ${rt}$, intent(in) :: x(:) ${rt}$ :: y(size(x)) end function - pure module function Softmax_grad_r2_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) + #:for rank in RANKS + pure module function Softmax_grad_r${rank}$_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x${ranksuffix(rank)}$ + ${rt}$ :: y${shape('x', rank)}$ integer, intent(in), optional :: dim end function - pure module function Softmax_grad_r3_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) + #:endfor + #:endfor + end interface + public :: Softmax_grad + + interface LogSoftmax + !! Version: experimental + !! + !! Softmax function. Available for ranks 1 to 4 + #:for rk, rt in REAL_KINDS_TYPES + pure module function LogSoftmax_r1_${rk}$( x, dim ) result( y ) + ${rt}$, intent(in) :: x(:) + ${rt}$ :: y(size(x)) integer, intent(in), optional :: dim end function - pure module function Softmax_grad_r4_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) + #:for rank in RANKS + pure module function LogSoftmax_r${rank}$_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x${ranksuffix(rank)}$ + ${rt}$ :: y${shape('x', rank)}$ integer, intent(in), optional :: dim end function #:endfor + #:endfor end interface - public :: Softmax_grad + public :: LogSoftmax interface Softplus !! Version: experimental diff --git a/src/stdlib_specialfunctions_activations.fypp b/src/stdlib_specialfunctions_activations.fypp index c8a50710b..7ff171fb0 100644 --- a/src/stdlib_specialfunctions_activations.fypp +++ b/src/stdlib_specialfunctions_activations.fypp @@ -1,4 +1,5 @@ #:include "common.fypp" +#:set RANKS = range(2, MAXRANK + 1) submodule(stdlib_specialfunctions) stdlib_specialfunctions_activations implicit none @@ -192,73 +193,44 @@ end function ! Softmax !================================================== #:for rk, rt in REAL_KINDS_TYPES -pure module function Softmax_r1_${rk}$( x ) result( y ) +pure module function Softmax_r1_${rk}$( x , dim ) result( y ) ${rt}$, intent(in) :: x(:) ${rt}$ :: y(size(x)) + integer, intent(in), optional :: dim y = exp(x - maxval(x)) y = y / sum(y) end function -pure module function Softmax_r2_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) +#:for rank in RANKS +pure module function Softmax_r${rank}$_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x${ranksuffix(rank)}$ + ${rt}$ :: y${shape('x', rank)}$ integer, intent(in), optional :: dim integer :: dim_, j dim_ = 1; if(present(dim)) dim_ = dim - if(dim_==1)then - do j = 1, size(x,dim=2) - y(:,j) = Softmax( x(:,j) ) + if(dim_<${rank}$)then + do j = 1, size(x,dim=${rank}$) + #:if rank == 2 + y${select_subarray(rank, [(rank, 'j')])}$ = Softmax( x${select_subarray(rank, [(rank, 'j')])}$ ) + #:else + y${select_subarray(rank, [(rank, 'j')])}$ = Softmax( x${select_subarray(rank, [(rank, 'j')])}$, dim=dim_ ) + #:endif end do else do j = 1, size(x,dim=1) - y(j,:) = Softmax( x(j,:) ) - end do - end if -end function - -pure module function Softmax_r3_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) - - integer, intent(in), optional :: dim - integer :: dim_, j - - dim_ = 1; if(present(dim)) dim_ = dim - - if(dim_<=2)then - do j = 1, size(x,dim=3) - y(:,:,j) = Softmax( x(:,:,j) , dim = dim_ ) - end do - else - do j = 1, size(x,dim=1) - y(j,:,:) = Softmax( x(j,:,:) , dim = 2 ) - end do - end if -end function - -pure module function Softmax_r4_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) - - integer, intent(in), optional :: dim - integer :: dim_, j - - dim_ = 1; if(present(dim)) dim_ = dim - - if(dim_<=3)then - do j = 1, size(x,dim=4) - y(:,:,:,j) = Softmax( x(:,:,:,j) , dim = dim_ ) - end do - else - do j = 1, size(x,dim=1) - y(j,:,:,:) = Softmax( x(j,:,:,:) , dim = 3 ) + #:if rank == 2 + y${select_subarray(rank, [(1, 'j')])}$ = Softmax( x${select_subarray(rank, [(1, 'j')])}$ ) + #:else + y${select_subarray(rank, [(1, 'j')])}$ = Softmax( x${select_subarray(rank, [(1, 'j')])}$, dim=${rank-1}$ ) + #:endif end do end if end function +#:endfor pure module function Softmax_grad_r1_${rk}$( x ) result( y ) ${rt}$, intent(in) :: x(:) @@ -268,9 +240,10 @@ pure module function Softmax_grad_r1_${rk}$( x ) result( y ) y = y * (1._${rk}$ - y) end function -pure module function Softmax_grad_r2_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2)) +#:for rank in RANKS +pure module function Softmax_grad_r${rank}$_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x${ranksuffix(rank)}$ + ${rt}$ :: y${shape('x', rank)}$ integer, intent(in), optional :: dim integer :: dim_ @@ -280,32 +253,51 @@ pure module function Softmax_grad_r2_${rk}$( x , dim ) result( y ) y = Softmax(x,dim_) y = y * (1._${rk}$ - y) end function +#:endfor -pure module function Softmax_grad_r3_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3)) - - integer, intent(in), optional :: dim - integer :: dim_ +#:endfor - dim_ = 1; if(present(dim)) dim_ = dim - - y = Softmax(x,dim_) - y = y * (1._${rk}$ - y) +!================================================== +! LogSoftmax +!================================================== +#:for rk, rt in REAL_KINDS_TYPES +pure module function LogSoftmax_r1_${rk}$( x, dim ) result( y ) + ${rt}$, intent(in) :: x(:) + ${rt}$ :: y(size(x)) + integer, intent(in), optional :: dim + y = x - maxval(x) + y = y - log( sum(exp(y)) ) end function -pure module function Softmax_grad_r4_${rk}$( x , dim ) result( y ) - ${rt}$, intent(in) :: x(:,:,:,:) - ${rt}$ :: y(size(x,dim=1),size(x,dim=2),size(x,dim=3),size(x,dim=4)) - +#:for rank in RANKS +pure module function LogSoftmax_r${rank}$_${rk}$( x , dim ) result( y ) + ${rt}$, intent(in) :: x${ranksuffix(rank)}$ + ${rt}$ :: y${shape('x', rank)}$ + integer, intent(in), optional :: dim - integer :: dim_ + integer :: dim_, j dim_ = 1; if(present(dim)) dim_ = dim - - y = Softmax(x,dim_) - y = y * (1._${rk}$ - y) + + if(dim_<${rank}$)then + do j = 1, size(x,dim=${rank}$) + #:if rank == 2 + y${select_subarray(rank, [(rank, 'j')])}$ = LogSoftmax( x${select_subarray(rank, [(rank, 'j')])}$ ) + #:else + y${select_subarray(rank, [(rank, 'j')])}$ = LogSoftmax( x${select_subarray(rank, [(rank, 'j')])}$, dim=dim_ ) + #:endif + end do + else + do j = 1, size(x,dim=1) + #:if rank == 2 + y${select_subarray(rank, [(1, 'j')])}$ = LogSoftmax( x${select_subarray(rank, [(1, 'j')])}$ ) + #:else + y${select_subarray(rank, [(1, 'j')])}$ = LogSoftmax( x${select_subarray(rank, [(1, 'j')])}$, dim=${rank-1}$ ) + #:endif + end do + end if end function +#:endfor #:endfor diff --git a/test/specialfunctions/test_specialfunctions_activations.fypp b/test/specialfunctions/test_specialfunctions_activations.fypp index cc33c7b6a..7b1d4c268 100644 --- a/test/specialfunctions/test_specialfunctions_activations.fypp +++ b/test/specialfunctions/test_specialfunctions_activations.fypp @@ -22,6 +22,7 @@ contains testsuite = [ & new_unittest("sigmoid", test_sigmoid), & + new_unittest("logsoftmax", test_logsoftmax), & new_unittest("gelu" , test_gelu ), & new_unittest("softmax", test_softmax) & ] @@ -134,6 +135,76 @@ contains end subroutine test_softmax + subroutine test_logsoftmax(error) + type(error_type), allocatable, intent(out) :: error + + real(sp) :: x(3,3,3), y(3,3,3), y_ref(3,3,3) + + x = reshape( [ 0.755308866500854,-0.789980888366699, 0.88806813955307 ,& + -1.210636496543884, 0.746919095516205, 0.177668794989586,& + 0.540819883346558, 0.291532933712006,-0.324642956256866,& + + 1.94184136390686 , 0.951070547103882,-2.303410291671753,& + 0.59752631187439 , 1.189722180366516, 1.401878595352173,& + -0.262732744216919, 0.421907186508179,-0.200457707047462,& + + -0.702468574047089, 0.153426378965378, 0.330110251903534,& + -1.16956090927124 ,-0.845042765140533,-1.364316940307617,& + -1.679381608963013,-1.497506022453308,-1.194215059280396 ] ,[3,3,3] ) + + !> LogSoftmax on dim = 1 + y = LogSoftmax(x,dim=1) + + y_ref = reshape( [ -0.856636286,-2.40192604,-0.723877013,& + -2.49238253,-0.534826934,-1.10407722 ,& + -0.788554132,-1.03784108,-1.65401697 ,& + + -0.326149583,-1.31692040,-4.57140112 ,& + -1.61804128,-1.02584541,-0.813688993 ,& + -1.39805317,-0.713413179,-1.33577800 ,& + + -1.81836534,-0.962470412,-0.785786569,& + -1.16514850,-0.840630412,-1.35990453 ,& + -1.34127355,-1.15939808,-0.856107056 ],[3,3,3] ) + + !> LogSoftmax on dim = 2 + y = LogSoftmax(x,dim=2) + + y_ref = reshape( [ -0.666278005,-2.15167999, -0.581566215,& + -2.63222337 ,-0.614779949,-1.29196548 ,& + -0.880766988,-1.07016611,-1.79427731 ,& + + -0.315551817,-1.05034387,-3.90906072 ,& + -1.65986681 ,-0.811692238,-0.203771874,& + -2.52012587 ,-1.57950723 ,-1.80610812 ,& + + -0.694792688,-0.444887042,-0.337523341,& + -1.16188502 ,-1.44335616 ,-2.03195047 ,& + -1.67170572 ,-2.09581947 ,-1.86184871 ],[3,3,3] ) + + call check(error, norm2(y-y_ref) < tol_sp ) + if (allocated(error)) return + + !> LogSoftmax on dim = 3 + y = LogSoftmax(x,dim=3) + + y_ref = reshape( [ -1.50595474 , -2.22700500 ,-0.478398114,& + -2.09693313 , -1.01544499 ,-1.52940571 ,& + -0.442325860, -0.835677147,-0.936625183,& + + -0.319422185, -0.485953659,-3.66987658 ,& + -0.288770229, -0.572641909,-0.305195898,& + -1.24587846 , -0.705302894,-0.812439919,& + + -2.96373224 , -1.28359783 ,-1.03635597 ,& + -2.05585742 , -2.60740685 ,-3.07139134 ,& + -2.66252732 , -2.62471604 ,-1.80619729 ],[3,3,3] ) + + call check(error, norm2(y-y_ref) < tol_sp ) + if (allocated(error)) return + + end subroutine test_logsoftmax + end module test_specialfunctions_activation