Skip to content

Commit 8561c45

Browse files
zozihazoziha
committed
A poor implement only for review.
1 parent b6f0ab1 commit 8561c45

File tree

4 files changed

+88
-6
lines changed

4 files changed

+88
-6
lines changed

‎CHANGELOG.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ Features available from the latest git source
2222
- new procedures `arg`, `argd` and `argpi`
2323
[#498](https://github.com/fortran-lang/stdlib/pull/498)
2424
- new procedure `diff`
25+
[#605](https://github.com/fortran-lang/stdlib/pull/605)
2526

2627
Changes to existing modules
2728

‎src/stdlib_math.fypp

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -367,15 +367,17 @@ module stdlib_math
367367
interface diff
368368
#:set RI_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES
369369
#:for k1, t1 in RI_KINDS_TYPES
370-
pure module function diff_1_${k1}$(x, n) result(Y)
370+
pure module function diff_1_${k1}$(x, n, prepend, append) result(Y)
371371
${t1}$, intent(in) :: x(:)
372372
integer, intent(in), optional :: n
373+
${t1}$, intent(in), optional :: prepend(:), append(:)
373374
${t1}$, allocatable :: Y(:)
374375
end function diff_1_${k1}$
375-
pure module function diff_2_${k1}$(X, n, dim) result(Y)
376+
pure module function diff_2_${k1}$(X, n, dim, prepend, append) result(Y)
376377
${t1}$, intent(in) :: X(:, :)
377378
integer, intent(in), optional :: n, dim
378-
${t1}$, allocatable :: Y(:,:)
379+
${t1}$, intent(in), optional :: prepend(:, :), append(:, :)
380+
${t1}$, allocatable :: Y(:, :)
379381
end function diff_2_${k1}$
380382
#:endfor
381383
end interface diff

‎src/stdlib_math_diff.fypp

Lines changed: 59 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,27 +12,47 @@ contains
1212
#! `diff` computes differences of arrays of the ${t1}$ type.
1313

1414
#:for k1, t1 in RI_KINDS_TYPES
15-
pure module function diff_1_${k1}$(X, n) result(Y)
15+
pure module function diff_1_${k1}$(X, n, prepend, append) result(Y)
1616
${t1}$, intent(in) :: X(:)
1717
integer, intent(in), optional :: n
18+
${t1}$, intent(in), optional :: prepend(:), append(:)
1819
${t1}$, allocatable :: Y(:)
20+
integer :: size_prepend, size_append
1921
integer :: n_, i
2022

23+
size_prepend = 0
24+
size_append = 0
2125
n_ = optval(n, 1)
26+
if (present(prepend)) size_prepend = size(prepend)
27+
if (present(append)) size_append = size(append)
28+
29+
if (size(X) <= n_) then
30+
allocate(Y(size_prepend+size_append))
31+
if (size_prepend > 0) Y(:size_prepend) = prepend(:)
32+
if (size_append > 0) Y(size_prepend+1:) = append(:)
33+
return
34+
end if
2235

2336
Y = X
2437
do i = 1, n_
2538
Y = Y(2:) - Y(:size(Y) - 1)
2639
end do
40+
41+
if (size_prepend > 0) Y = [prepend(:), Y]
42+
if (size_append > 0) Y = [Y, append(:)]
2743

2844
end function diff_1_${k1}$
2945

30-
pure module function diff_2_${k1}$(X, n, dim) result(Y)
46+
pure module function diff_2_${k1}$(X, n, dim, prepend, append) result(Y)
3147
${t1}$, intent(in) :: X(:, :)
3248
integer, intent(in), optional :: n, dim
49+
${t1}$, intent(in), optional :: prepend(:, :), append(:, :)
3350
${t1}$, allocatable :: Y(:, :)
51+
integer :: size_prepend, size_append
3452
integer :: n_, dim_, i
3553

54+
size_prepend = 0
55+
size_append = 0
3656
n_ = optval(n, 1)
3757
if (present(dim)) then
3858
if (dim == 1 .or. dim == 2) then
@@ -44,15 +64,51 @@ contains
4464
dim_ = 1
4565
end if
4666

67+
if (present(prepend)) size_prepend = size(prepend, dim_)
68+
if (present(append)) size_append = size(append, dim_)
69+
70+
if (size(X, dim_) <= n_) then
71+
if (size_prepend == 0 .and. size_append == 0) then
72+
allocate(Y(0, 0))
73+
else
74+
if (dim_ == 1) then
75+
allocate(Y(size_prepend+size_append, size(X, 2)))
76+
if (size_prepend /= 0) Y(:size_prepend, :) = prepend(:, :)
77+
if (size_prepend /= 0) Y(size_prepend+1:, :) = append(:, :)
78+
else
79+
allocate(Y(size(X, 1), size_prepend+size_append))
80+
if (size_prepend /= 0) Y(:, :size_prepend) = prepend(:, :)
81+
if (size_prepend /= 0) Y(:, size_prepend+1:) = append(:, :)
82+
end if
83+
end if
84+
return
85+
end if
86+
4787
Y = X
4888
if (dim_ == 1) then
4989
do i = 1, n_
5090
Y = Y(2:, :) - Y(:size(Y, 1) - 1, :)
5191
end do
52-
elseif (dim == 2) then
92+
block
93+
${t1}$, allocatable :: tmp(:, :)
94+
allocate(tmp(size(Y, 1)+size_prepend+size_append, size(Y, 2)))
95+
if (size_prepend /= 0) tmp(:size_prepend, :) = prepend(:, :)
96+
tmp(size_prepend+1:size(Y, 1)+size_prepend, :) = Y
97+
if (size_append /= 0) tmp(size(Y, 1)+size_prepend+1:, :) = append(:, :)
98+
Y = tmp
99+
end block
100+
elseif (dim_ == 2) then
53101
do i = 1, n_
54102
Y = Y(:, 2:) - Y(:, :size(Y, 2) - 1)
55103
end do
104+
block
105+
${t1}$, allocatable :: tmp(:, :)
106+
allocate(tmp(size(Y, 1), size(Y, 2)+size_prepend+size_append))
107+
if (size_prepend /= 0) tmp(:, :size_prepend) = prepend(:, :)
108+
tmp(:, size_prepend+1:size(Y, 2)+size_prepend) = Y
109+
if (size_append /= 0) tmp(:, size(Y, 2)+size_prepend+1:) = append(:, :)
110+
Y = tmp
111+
end block
56112
end if
57113

58114
end function diff_2_${k1}$

‎src/tests/math/test_stdlib_math.fypp

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -378,6 +378,7 @@ contains
378378
type(error_type), allocatable, intent(out) :: error
379379
${t1}$ :: x(6) = [${t1}$ :: 0, 5, 15, 30, 50, 75]
380380
${t1}$ :: A(1, 3) = reshape([${t1}$ :: 1, 3, 5], [1, 3])
381+
${t1}$ :: B(2) = [${t1}$ :: 1, 2]
381382

382383
call check(error, all_close(diff(x), [${t1}$ :: 5, 10, 15, 20, 25]), &
383384
"diff(x) in test_diff_real_${k1}$ failed")
@@ -387,10 +388,27 @@ contains
387388
"diff(x, n=2) in test_diff_real_${k1}$ failed")
388389
if (allocated(error)) return
389390

391+
call check(error, all_close(diff(x, prepend=[${t1}$ :: 1]), [${t1}$ :: 1, 5, 10, 15, 20, 25]), &
392+
"diff(x, prepend=[${t1}$ :: 1]) in test_diff_real_${k1}$ failed")
393+
if (allocated(error)) return
394+
call check(error, all_close(diff(x, append=[${t1}$ :: 1]), [${t1}$ :: 5, 10, 15, 20, 25, 1]), &
395+
"diff(x, append=[${t1}$ :: 1]) in test_diff_real_${k1}$ failed")
396+
390397
call check(error, all_close(diff(A, n=1, dim=2), reshape([${t1}$ :: 2, 2], [1, 2])), &
391398
"diff(x, n=1, dim=2) in test_diff_real_${k1}$ failed")
392399
if (allocated(error)) return
393400

401+
call check(error, all_close(diff(A, n=1, dim=2, prepend=reshape([${t1}$ :: 1], [1, 1]), &
402+
append=reshape([${t1}$ :: 2], [1, 1])), reshape([${t1}$ :: 1, 2, 2, 2], [1, 4])), &
403+
"diff(x, n=1, dim=2, prepend=reshape([${t1}$ :: 1], [1, 1]), &
404+
&append=reshape([${t1}$ :: 2], [1, 1])) in test_diff_real_${k1}$ failed")
405+
if (allocated(error)) return
406+
407+
call check(error, size(diff(B, 2)), 0, "size(diff(B, 2)) in test_diff_real_${k1}$ failed")
408+
if (allocated(error)) return
409+
call check(error, size(diff(B, 3)), 0, "size(diff(B, 3)) in test_diff_real_${k1}$ failed")
410+
if (allocated(error)) return
411+
394412
end subroutine test_diff_real_${k1}$
395413
#:endfor
396414

@@ -399,6 +417,7 @@ contains
399417
type(error_type), allocatable, intent(out) :: error
400418
${t1}$ :: x(6) = [${t1}$ :: 0, 5, 15, 30, 50, 75]
401419
${t1}$ :: A(1, 3) = reshape([${t1}$ :: 1, 3, 5], [1, 3])
420+
${t1}$ :: B(2) = [${t1}$ :: 1, 2]
402421

403422
call check(error, all(diff(x) == [${t1}$ :: 5, 10, 15, 20, 25]), &
404423
"diff(x) in test_diff_int_${k1}$ failed")
@@ -412,6 +431,10 @@ contains
412431
"diff(A, n=1, dim=2) in test_diff_int_${k1}$ failed")
413432
if (allocated(error)) return
414433

434+
call check(error, size(diff(B, 2)), 0, "size(diff(B, 2)) in test_diff_real_${k1}$ failed")
435+
if (allocated(error)) return
436+
call check(error, size(diff(B, 3)), 0, "size(diff(B, 3)) in test_diff_real_${k1}$ failed")
437+
415438
end subroutine test_diff_int_${k1}$
416439
#:endfor
417440

0 commit comments

Comments
 (0)