Skip to content

Commit 2ff7029

Browse files
jalveszjalvesz
committed
start working on activations module
1 parent 91dcc50 commit 2ff7029

File tree

1 file changed

+386
-0
lines changed

1 file changed

+386
-0
lines changed

‎src/stdlib_math_activations.fypp

Lines changed: 386 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,386 @@
1+
#:include "common.fypp"
2+
module stdlib_math_activations
3+
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
4+
implicit none
5+
private
6+
7+
interface gaussian
8+
#:for rk, rt in REAL_KINDS_TYPES
9+
module procedure :: gaussian_${rk}$
10+
#:endfor
11+
end interface
12+
public :: gaussian
13+
14+
interface gaussian_grad
15+
#:for rk, rt in REAL_KINDS_TYPES
16+
module procedure :: gaussian_grad_${rk}$
17+
#:endfor
18+
end interface
19+
public :: gaussian_grad
20+
21+
interface elu
22+
#:for rk, rt in REAL_KINDS_TYPES
23+
module procedure :: elu_${rk}$
24+
#:endfor
25+
end interface
26+
public :: elu
27+
28+
interface elu_grad
29+
#:for rk, rt in REAL_KINDS_TYPES
30+
module procedure :: elu_grad_${rk}$
31+
#:endfor
32+
end interface
33+
public :: elu_grad
34+
35+
interface relu
36+
#:for rk, rt in REAL_KINDS_TYPES
37+
module procedure :: relu_${rk}$
38+
#:endfor
39+
end interface
40+
public :: relu
41+
42+
interface relu_grad
43+
#:for rk, rt in REAL_KINDS_TYPES
44+
module procedure :: relu_grad_${rk}$
45+
#:endfor
46+
end interface
47+
public :: relu_grad
48+
49+
interface gelu
50+
#:for rk, rt in REAL_KINDS_TYPES
51+
module procedure :: gelu_${rk}$
52+
#:endfor
53+
end interface
54+
public :: gelu
55+
56+
interface gelu_grad
57+
#:for rk, rt in REAL_KINDS_TYPES
58+
module procedure :: gelu_grad_${rk}$
59+
#:endfor
60+
end interface
61+
public :: gelu_grad
62+
63+
interface gelu_approx
64+
#:for rk, rt in REAL_KINDS_TYPES
65+
module procedure :: gelu_approx_${rk}$
66+
#:endfor
67+
end interface
68+
public :: gelu_approx
69+
70+
interface gelu_approx_grad
71+
#:for rk, rt in REAL_KINDS_TYPES
72+
module procedure :: gelu_approx_grad_${rk}$
73+
#:endfor
74+
end interface
75+
public :: gelu_approx_grad
76+
77+
interface sigmoid
78+
#:for rk, rt in REAL_KINDS_TYPES
79+
module procedure :: sigmoid_${rk}$
80+
#:endfor
81+
end interface
82+
public :: sigmoid
83+
84+
interface sigmoid_grad
85+
#:for rk, rt in REAL_KINDS_TYPES
86+
module procedure :: sigmoid_grad_${rk}$
87+
#:endfor
88+
end interface
89+
public :: sigmoid_grad
90+
91+
interface step
92+
#:for rk, rt in REAL_KINDS_TYPES
93+
module procedure :: step_${rk}$
94+
#:endfor
95+
end interface
96+
public :: step
97+
98+
interface step_grad
99+
#:for rk, rt in REAL_KINDS_TYPES
100+
module procedure :: step_grad_${rk}$
101+
#:endfor
102+
end interface
103+
public :: step_grad
104+
105+
interface Softmax
106+
#:for rk, rt in REAL_KINDS_TYPES
107+
module procedure :: softmax_${rk}$
108+
#:endfor
109+
end interface
110+
public :: softmax
111+
112+
interface Softmax_grad
113+
#:for rk, rt in REAL_KINDS_TYPES
114+
module procedure :: Softmax_grad_${rk}$
115+
#:endfor
116+
end interface
117+
public :: Softmax_grad
118+
119+
interface Softplus
120+
#:for rk, rt in REAL_KINDS_TYPES
121+
module procedure :: Softplus_${rk}$
122+
#:endfor
123+
end interface
124+
public :: Softplus
125+
126+
interface Softplus_grad
127+
#:for rk, rt in REAL_KINDS_TYPES
128+
module procedure :: Softplus_grad_${rk}$
129+
#:endfor
130+
end interface
131+
public :: Softplus_grad
132+
133+
interface ftanh !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31
134+
#:for rk, rt in REAL_KINDS_TYPES
135+
module procedure :: ftanh_${rk}$
136+
#:endfor
137+
end interface
138+
public :: ftanh
139+
140+
interface ferf !! Source: https://fortran-lang.discourse.group/t/fastgpt-faster-than-pytorch-in-300-lines-of-fortran/5385/31
141+
#:for rk, rt in REAL_KINDS_TYPES
142+
module procedure :: ferf_${rk}$
143+
#:endfor
144+
end interface
145+
public :: ferf
146+
147+
#:for rk, rt in REAL_KINDS_TYPES
148+
${rt}$, parameter :: isqrt2_${rk}$ = 1_${rk}$ / sqrt(2._${rk}$)
149+
#:endfor
150+
151+
contains
152+
153+
!==================================================
154+
! Gaussian
155+
!==================================================
156+
#:for rk, rt in REAL_KINDS_TYPES
157+
elemental ${rt}$ function gaussian_${rk}$( x ) result( y )
158+
${rt}$, intent(in) :: x
159+
160+
y = exp(-x**2)
161+
end function
162+
163+
elemental ${rt}$ function gaussian_grad_${rk}$( x ) result( y )
164+
${rt}$, intent(in) :: x
165+
166+
y = -2_${rk}$ * x * exp(-x**2)
167+
end function
168+
169+
#:endfor
170+
171+
!==================================================
172+
! Exponential Linear Unit
173+
!==================================================
174+
#:for rk, rt in REAL_KINDS_TYPES
175+
elemental ${rt}$ function elu_${rk}$( x , a ) result ( y )
176+
${rt}$, intent(in) :: x
177+
${rt}$, intent(in) :: a
178+
179+
if(x >= 0_${rk}$)then
180+
y = x
181+
else
182+
y = a * (exp(x) - 1_${rk}$)
183+
end if
184+
end function
185+
186+
elemental ${rt}$ function elu_grad_${rk}$( x , a ) result ( y )
187+
${rt}$, intent(in) :: x
188+
${rt}$, intent(in) :: a
189+
190+
if(x >= 0_${rk}$)then
191+
y = 1_${rk}$
192+
else
193+
y = a * exp(x)
194+
end if
195+
end function
196+
197+
#:endfor
198+
199+
!==================================================
200+
! Rectified Linear Unit
201+
!==================================================
202+
#:for rk, rt in REAL_KINDS_TYPES
203+
elemental ${rt}$ function relu_${rk}$( x ) result( y )
204+
${rt}$, intent(in) :: x
205+
206+
y = max(0_${rk}$, x)
207+
end function
208+
209+
elemental ${rt}$ function relu_grad_${rk}$( x ) result( y )
210+
${rt}$, intent(in) :: x
211+
212+
if(x > 0_${rk}$)then
213+
y = 1_${rk}$
214+
else
215+
y = 0_${rk}$
216+
end if
217+
end function
218+
219+
#:endfor
220+
221+
!==================================================
222+
! GELU: Gaussian Error Linear Units function
223+
!==================================================
224+
#:for rk, rt in REAL_KINDS_TYPES
225+
elemental ${rt}$ function gelu_${rk}$( x ) result( y )
226+
${rt}$, intent(in) :: x
227+
228+
y = 0.5_${rk}$ * x * (1 + ferf(x * isqrt2_${rk}$))
229+
end function
230+
231+
elemental ${rt}$ function gelu_grad_${rk}$( x ) result( y )
232+
${rt}$, intent(in) :: x
233+
234+
y = 0.5_${rk}$ * (1 + ferf(x * isqrt2_${rk}$) )
235+
y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 )
236+
end function
237+
238+
#:endfor
239+
240+
#:for rk, rt in REAL_KINDS_TYPES
241+
elemental ${rt}$ function gelu_approx_${rk}$( x ) result( y )
242+
${rt}$, intent(in) :: x
243+
244+
y = 0.5_${rk}$ * x * (1 + ferf(x * isqrt2_${rk}$))
245+
end function
246+
247+
elemental ${rt}$ function gelu_approx_grad_${rk}$( x ) result( y )
248+
${rt}$, intent(in) :: x
249+
250+
y = 0.5_${rk}$ * (1 + ferf(x * isqrt2_${rk}$) )
251+
y = y + x * isqrt2_${rk}$ * exp( - 0.5_${rk}$ * x**2 )
252+
end function
253+
254+
#:endfor
255+
256+
!==================================================
257+
! Sigmoid
258+
!==================================================
259+
#:for rk, rt in REAL_KINDS_TYPES
260+
elemental ${rt}$ function sigmoid_${rk}$( x ) result( y )
261+
${rt}$, intent(in) :: x
262+
263+
y = 1_${rk}$ / (1_${rk}$ + exp(-x))
264+
end function
265+
266+
elemental ${rt}$ function sigmoid_grad_${rk}$( x ) result( y )
267+
${rt}$, intent(in) :: x
268+
269+
y = exp(x) / (1_${rk}$ + exp(x))**2
270+
end function
271+
272+
#:endfor
273+
274+
!==================================================
275+
! Step
276+
!==================================================
277+
#:for rk, rt in REAL_KINDS_TYPES
278+
elemental ${rt}$ function Step_${rk}$( x ) result( y )
279+
${rt}$, intent(in) :: x
280+
281+
if(x > 0_${rk}$)then
282+
y = 1_${rk}$
283+
else
284+
y = 0_${rk}$
285+
end if
286+
end function
287+
288+
elemental ${rt}$ function Step_grad_${rk}$( x ) result( y )
289+
${rt}$, intent(in) :: x
290+
291+
y = 0_${rk}$
292+
end function
293+
294+
#:endfor
295+
296+
!==================================================
297+
! tanh
298+
!==================================================
299+
#:for rk, rt in REAL_KINDS_TYPES
300+
elemental ${rt}$ function tanh_${rk}$( x ) result( y )
301+
${rt}$, intent(in) :: x
302+
303+
y = ftanh(x)
304+
end function
305+
306+
elemental ${rt}$ function tanh_grad_${rk}$( x ) result( y )
307+
${rt}$, intent(in) :: x
308+
309+
y = 1_${rk}$ - ftanh(x)**2
310+
end function
311+
312+
#:endfor
313+
314+
!==================================================
315+
! Softmax
316+
!==================================================
317+
#:for rk, rt in REAL_KINDS_TYPES
318+
pure function Softmax_${rk}$( x ) result( y )
319+
${rt}$, intent(in) :: x(:)
320+
${rt}$ :: y(size(x))
321+
322+
y(:) = exp(x(:) - maxval(x(:)) )
323+
y(:) = y(:) / sum(y(:))
324+
end function
325+
326+
pure function Softmax_grad_${rk}$( x ) result( y )
327+
${rt}$, intent(in) :: x(:)
328+
${rt}$ :: y(size(x))
329+
330+
y = softmax_${rk}$(x)
331+
y = y * (1_${rk}$ - y)
332+
end function
333+
334+
#:endfor
335+
336+
!==================================================
337+
! Softplus
338+
!==================================================
339+
#:for rk, rt in REAL_KINDS_TYPES
340+
elemental ${rt}$ function Softplus_${rk}$( x ) result( y )
341+
${rt}$, intent(in) :: x
342+
343+
y = log(exp(x) + 1_${rk}$)
344+
end function
345+
346+
elemental ${rt}$ function Softplus_grad_${rk}$( x ) result( y )
347+
${rt}$, intent(in) :: x
348+
349+
y = exp(x) / (exp(x) + 1_${rk}$)
350+
end function
351+
352+
#:endfor
353+
354+
!==================================================
355+
! Fast intrinsics for accelerated activations
356+
!==================================================
357+
358+
#:for rk, rt in REAL_KINDS_TYPES
359+
elemental ${rt}$ function ftanh_${rk}$( x ) result( y )
360+
${rt}$, intent(in) :: x
361+
${rt}$ :: x2, a, b
362+
363+
if (x > 5_${rk}$) then
364+
y = 1_${rk}$
365+
elseif (x < -5_${rk}$) then
366+
y = -1_${rk}$
367+
else
368+
x2 = x*x
369+
a = x * (135135.0_${rk}$ + x2 * (17325.0_${rk}$ + x2 * (378.0_${rk}$ + x2)))
370+
b = 135135.0_${rk}$ + x2 * (62370.0_${rk}$ + x2 * (3150.0_${rk}$ + x2 * 28.0_${rk}$))
371+
y = a / b
372+
end if
373+
end function
374+
375+
elemental ${rt}$ function ferf_${rk}$( x ) result( y )
376+
${rt}$, intent(in) :: x
377+
${rt}$ :: abs_x
378+
379+
abs_x = abs(x)
380+
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
381+
y = y * sign(1.0_${rk}$,x)
382+
end function
383+
384+
#:endfor
385+
386+
end module

0 commit comments

Comments
 (0)