Skip to content

Commit 9ebec01

Browse files
committed
A poor implement only for review.
1 parent b6f0ab1 commit 9ebec01

File tree

4 files changed

+75
-8
lines changed

4 files changed

+75
-8
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: 46 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -12,27 +12,49 @@ 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) + size_prepend + size_append <= n_) then
30+
allocate(Y(0))
31+
return
32+
end if
2233

23-
Y = X
34+
if (size_prepend > 0) then
35+
Y = [prepend, X]
36+
else
37+
Y = X
38+
end if
39+
if (size_append > 0) Y = [Y, append]
40+
2441
do i = 1, n_
2542
Y = Y(2:) - Y(:size(Y) - 1)
2643
end do
2744

2845
end function diff_1_${k1}$
2946

30-
pure module function diff_2_${k1}$(X, n, dim) result(Y)
47+
pure module function diff_2_${k1}$(X, n, dim, prepend, append) result(Y)
3148
${t1}$, intent(in) :: X(:, :)
3249
integer, intent(in), optional :: n, dim
50+
${t1}$, intent(in), optional :: prepend(:, :), append(:, :)
3351
${t1}$, allocatable :: Y(:, :)
52+
integer :: size_prepend, size_append
3453
integer :: n_, dim_, i
54+
${t1}$, allocatable :: tmp(:, :)
3555

56+
size_prepend = 0
57+
size_append = 0
3658
n_ = optval(n, 1)
3759
if (present(dim)) then
3860
if (dim == 1 .or. dim == 2) then
@@ -44,15 +66,34 @@ contains
4466
dim_ = 1
4567
end if
4668

47-
Y = X
69+
if (present(prepend)) size_prepend = size(prepend, dim_)
70+
if (present(append)) size_append = size(append, dim_)
71+
72+
if (size(X, dim_) + size_prepend + size_append <= n_) then
73+
allocate(Y(0, 0))
74+
return
75+
end if
76+
4877
if (dim_ == 1) then
78+
allocate(tmp(size(X, 1)+size_prepend+size_append, size(X, 2)))
79+
if (size_prepend > 0) tmp(:size_prepend, :) = prepend
80+
tmp(size_prepend+1:size(X, 1)+size_prepend, :) = X
81+
if (size_append > 0) tmp(size(X, 1)+size_prepend+1:, :) = append
82+
Y = tmp
4983
do i = 1, n_
5084
Y = Y(2:, :) - Y(:size(Y, 1) - 1, :)
5185
end do
52-
elseif (dim == 2) then
86+
87+
elseif (dim_ == 2) then
88+
allocate(tmp(size(x, 1), size(X, 2)+size_prepend+size_append))
89+
if (size_prepend > 0) tmp(:, :size_prepend) = prepend
90+
tmp(:, size_prepend+1:size(X, 2)+size_prepend) = X
91+
if (size_append > 0) tmp(:, size(X, 2)+size_prepend+1:) = append
92+
Y = tmp
5393
do i = 1, n_
5494
Y = Y(:, 2:) - Y(:, :size(Y, 2) - 1)
5595
end do
96+
5697
end if
5798

5899
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, -74]), &
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}$ :: 0, 2, 2, -3], [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)