1+ !> Inspired by original code (MIT license) written in 2016 by Keurfon Luu (keurfonluu@outlook.com)
2+ !> https://github.com/keurfonluu/Forlab
3+
4+ #:include "common.fypp"
5+ #:set RI_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES
6+ submodule (stdlib_math) stdlib_math_diff
7+
8+ implicit none
9+
10+ contains
11+
12+ !> `diff` computes differences of adjacent elements of an array.
13+
14+ #:for k1, t1 in RI_KINDS_TYPES
15+ pure module function diff_1_${k1}$(x, n, prepend, append) result(y)
16+ ${t1}$, intent(in) :: x(:)
17+ integer, intent(in), optional :: n
18+ ${t1}$, intent(in), optional :: prepend(:), append(:)
19+ ${t1}$, allocatable :: y(:)
20+ integer :: size_prepend, size_append, size_x, size_work
21+ integer :: n_, i
22+
23+ n_ = optval(n, 1)
24+ if (n_ <= 0) then
25+ y = x
26+ return
27+ end if
28+
29+ size_prepend = 0
30+ size_append = 0
31+ if (present(prepend)) size_prepend = size(prepend)
32+ if (present(append)) size_append = size(append)
33+ size_x = size(x)
34+ size_work = size_x + size_prepend + size_append
35+
36+ if (size_work <= n_) then
37+ allocate(y(0))
38+ return
39+ end if
40+
41+ !> Use a quick exit for the common case, to avoid memory allocation.
42+ if (size_prepend == 0 .and. size_append == 0 .and. n_ == 1) then
43+ y = x(2:) - x(1:size_x-1)
44+ return
45+ end if
46+
47+ block
48+ ${t1}$ :: work(size_work)
49+ if (size_prepend > 0) work(:size_prepend) = prepend
50+ work(size_prepend+1:size_prepend+size_x) = x
51+ if (size_append > 0) work(size_prepend+size_x+1:) = append
52+
53+ do i = 1, n_
54+ work(1:size_work-i) = work(2:size_work-i+1) - work(1:size_work-i)
55+ end do
56+
57+ y = work(1:size_work-n_)
58+ end block
59+
60+ end function diff_1_${k1}$
61+
62+ pure module function diff_2_${k1}$(x, n, dim, prepend, append) result(y)
63+ ${t1}$, intent(in) :: x(:, :)
64+ integer, intent(in), optional :: n, dim
65+ ${t1}$, intent(in), optional :: prepend(:, :), append(:, :)
66+ ${t1}$, allocatable :: y(:, :)
67+ integer :: size_prepend, size_append, size_x, size_work
68+ integer :: n_, dim_, i
69+
70+ n_ = optval(n, 1)
71+ if (n_ <= 0) then
72+ y = x
73+ return
74+ end if
75+
76+ size_prepend = 0
77+ size_append = 0
78+ if (present(dim)) then
79+ if (dim == 1 .or. dim == 2) then
80+ dim_ = dim
81+ else
82+ dim_ = 1
83+ end if
84+ else
85+ dim_ = 1
86+ end if
87+
88+ if (present(prepend)) size_prepend = size(prepend, dim_)
89+ if (present(append)) size_append = size(append, dim_)
90+ size_x = size(x, dim_)
91+ size_work = size_x + size_prepend + size_append
92+
93+ if (size_work <= n_) then
94+ allocate(y(0, 0))
95+ return
96+ end if
97+
98+ !> Use a quick exit for the common case, to avoid memory allocation.
99+ if (size_prepend == 0 .and. size_append == 0 .and. n_ == 1) then
100+ if (dim_ == 1) then
101+ y = x(2:, :) - x(1:size_x-1, :)
102+ elseif (dim_ == 2) then
103+ y = x(:, 2:) - x(:, 1:size_x-1)
104+ end if
105+ return
106+ end if
107+
108+ if (dim_ == 1) then
109+ block
110+ ${t1}$ :: work(size_work, size(x, 2))
111+ if (size_prepend > 0) work(1:size_prepend, :) = prepend
112+ work(size_prepend+1:size_x+size_prepend, :) = x
113+ if (size_append > 0) work(size_x+size_prepend+1:, :) = append
114+ do i = 1, n_
115+ work(1:size_work-i, :) = work(2:size_work-i+1, :) - work(1:size_work-i, :)
116+ end do
117+
118+ y = work(1:size_work-n_, :)
119+ end block
120+
121+ elseif (dim_ == 2) then
122+ block
123+ ${t1}$ :: work(size(x, 1), size_work)
124+ if (size_prepend > 0) work(:, 1:size_prepend) = prepend
125+ work(:, size_prepend+1:size_x+size_prepend) = x
126+ if (size_append > 0) work(:, size_x+size_prepend+1:) = append
127+ do i = 1, n_
128+ work(:, 1:size_work-i) = work(:, 2:size_work-i+1) - work(:, 1:size_work-i)
129+ end do
130+
131+ y = work(:, 1:size_work-n_)
132+ end block
133+
134+ end if
135+
136+ end function diff_2_${k1}$
137+ #:endfor
138+
139+ end submodule stdlib_math_diff
0 commit comments