[stdlib_io] disp(display your data)

doc/specs/stdlib_io.md

@@ -131,3 +131,137 @@ program demo_savetxt
     call savetxt('example.dat', x) 
 end program demo_savetxt
 ```
+
+## `disp` - display your data to the screen (or another output unit)
+
+### Status
+
+Experimental
+
+### Class
+
+Impure subroutine.
+
+### Description
+
+Display a `logical/integer/real/complex/character/string_type` scalar or `logical/integer/real/complex` and rank-1/rank-2 array to the screen or another output `unit`.
+
+#### More details
+
+Make good use of similar to the following usage, can help you understand the data information in the `array`.
+```fortran
+call disp( A(i, j, 2, :, 1:10) [, header, unit, brief] )    !! `i, j, ...` can be determined by `do` loop.
+```
+
+Generally, except for `complex` type, any other type of scalar or single element of the `array` will be printed out with a width of 12 characters and a space separator.  
+For `complex` type, scalar or single element of the `array` will be printed out with a width of 25 characters and a space separator.
+
+In order to prevent users from accidentally passing large-length arrays to `disp`, causing unnecessary io blockage:
+1. If the `brief` argument is not specified, `disp` will print **the brief array content with a length of `10*50` by default**.
+2. Specify `brief=.true.`, `disp` will print **the brief array content with a length of `5*5`**;
+3. Specify `brief=.false.`, `disp` will print **`all` the contents of the array** (please print all the contents of the array as appropriate according to the actual situation to avoid unnecessary IO blockage and affect the reading experience)
+
+### Syntax
+
+`call [[stdlib_io(module):disp(interface)]]([value, header, unit, brief])`  
+
+### Arguments
+
+`value`: Shall be a `logical/integer/real/complex/string_type` scalar or `logical/integer/real/complex` and rank-1/rank-2 array.
+This argument is `intent(in)` and `optional`.
+
+`header`: Shall be a `character(len=*)` scalar. 
+This argument is `intent(in)` and `optional`.  
+Usually used to comment data information.
+
+`unit`: Shall be an `integer` scalar linked to an IO stream.
+This argument is `intent(in)` and `optional`.
+Indicates the output `unit`.
+
+`brief`: Shall be a `logical` scalar.
+This argument is `intent(in)` and `optional`.  
+Controls an abridged version of the `value` object is printed.
+
+### Output
+
+The result is to print `header` and `value` on the screen (or another output `unit`) in this order.  
+If `value` is a rank-1/rank-2 `array` type, the dimension length information of the `array` will also be outputted.
+
+If `disp` is not passed any arguments, a blank line is printed.
+
+If the `value` is present and of `real/complex` type, the data will retain four significant decimal places, like `(g0.4)`.
+
+### Example
+
+```fortran
+program test_io_disp
+    
+    use stdlib_io, only: disp
+    implicit none
+    real(8) :: r(2, 3)
+    complex :: c(2, 3), c_3d(2, 100, 20)
+    integer :: i(2, 3)
+    logical :: l(10, 10)
+
+    r = 1.; c = 1.; c_3d = 2.; i = 1; l = .true.
+    r(1, 1) = -1.e-11
+    r(1, 2) = -1.e10
+    c(2, 2) = (-1.e10,-1.e10)
+    c_3d(1,3,1) = (1000, 0.001)
+    c_3d(1,3,2) = (1.e4, 100.)
+
+    call disp('string', header='disp(string):')
+    call disp('It is a note.')
+    call disp()
+
+    call disp(r, header='disp(r):')
+    call disp(r(1,:), header='disp(r(1,:))')
+    call disp(c, header='disp(c):')
+    call disp(i, header='disp(i):')
+    call disp(l, header='disp(l):', brief=.true.)
+
+    call disp(c_3d(:,:,3), header='disp(c_3d(:,:,3)):', brief=.true.)
+    call disp(c_3d(2,:,:), header='disp(c_3d(2,:,:)):', brief=.true.)
+
+end program test_io_disp
+```
+**Results:**
+```fortran
+ disp(string):
+ string
+ It is a note.
+
+ disp(r):
+ [matrix size: 2×3]
+ -0.1000E-10  -0.1000E+11    1.000
+   1.000        1.000        1.000
+ disp(r(1,:))
+ [vector size: 3]
+ -0.1000E-10  -0.1000E+11    1.000
+ disp(c):
+ [matrix size: 2×3]
+            (1.000,0.000)             (1.000,0.000)             (1.000,0.000)
+            (1.000,0.000) (-0.1000E+11,-0.1000E+11)             (1.000,0.000)
+ disp(i):
+ [matrix size: 2×3]
+           1            1            1
+           1            1            1
+ disp(l):
+ [matrix size: 10×10]
+           T            T            T          ...            T
+           T            T            T          ...            T
+           T            T            T          ...            T
+           :            :            :            :            :
+           T            T            T          ...            T
+ disp(c_3d(:,:,3)):
+ [matrix size: 2×100]
+            (2.000,0.000)             (2.000,0.000)             (2.000,0.000)                       ...             (2.000,0.000)  
+            (2.000,0.000)             (2.000,0.000)             (2.000,0.000)                       ...             (2.000,0.000)  
+ disp(c_3d(2,:,:)):
+ [matrix size: 100×20]
+            (2.000,0.000)             (2.000,0.000)             (2.000,0.000)                       ...             (2.000,0.000)  
+            (2.000,0.000)             (2.000,0.000)             (2.000,0.000)                       ...             (2.000,0.000)  
+            (2.000,0.000)             (2.000,0.000)             (2.000,0.000)                       ...             (2.000,0.000)  
+                        :                         :                         :                         :                         :  
+            (2.000,0.000)             (2.000,0.000)             (2.000,0.000)                       ...             (2.000,0.000) 
+```

src/CMakeLists.txt

@@ -7,6 +7,7 @@ set(fppFiles
     stdlib_bitsets_64.fypp
     stdlib_bitsets_large.fypp
     stdlib_io.fypp
+    stdlib_io_disp.fypp
     stdlib_linalg.fypp
     stdlib_linalg_diag.fypp
     stdlib_linalg_outer_product.fypp

src/Makefile.manual

@@ -27,13 +27,14 @@ SRCFYPP = \
         stdlib_stats_moment_scalar.fypp \
         stdlib_stats_var.fypp \
         stdlib_math.fypp \
-	stdlib_math_linspace.fypp \
-	stdlib_math_logspace.fypp \
+        stdlib_math_linspace.fypp \
+        stdlib_math_logspace.fypp \
         stdlib_stats_distribution_PRNG.fypp \
         stdlib_string_type.fypp \
         stdlib_string_type_constructor.fypp \
         stdlib_strings.fypp \
-        stdlib_strings_to_string.fypp
+        stdlib_strings_to_string.fypp \
+        stdlib_io_disp.fypp
 
 SRC = f18estop.f90 \
       stdlib_error.f90 \
@@ -79,11 +80,11 @@ stdlib_error.o: stdlib_optval.o
 stdlib_specialfunctions.o: stdlib_kinds.o
 stdlib_specialfunctions_legendre.o: stdlib_kinds.o stdlib_specialfunctions.o
 stdlib_io.o: \
-    stdlib_ascii.o \
     stdlib_error.o \
     stdlib_optval.o \
     stdlib_kinds.o \
-    stdlib_ascii.o
+    stdlib_ascii.o \
+    stdlib_string_type.o
 stdlib_linalg.o: \
     stdlib_kinds.o
 stdlib_linalg_diag.o: \
@@ -165,3 +166,7 @@ stdlib_math_logspace.o: \
 stdlib_math_arange.o: \
     stdlib_math.o
 stdlib_linalg_outer_product.o: stdlib_linalg.o
+stdlib_io_disp.o: \
+    stdlib_strings.o \
+    stdlib_string_type.o \
+    stdlib_io.o

src/stdlib_io.fypp

@@ -7,18 +7,51 @@ module stdlib_io
   !! ([Specification](../page/specs/stdlib_io.html))
 
   use stdlib_kinds, only: sp, dp, qp, &
-      int8, int16, int32, int64
+      int8, int16, int32, int64, lk, c_bool
   use stdlib_error, only: error_stop
   use stdlib_optval, only: optval
   use stdlib_ascii, only: is_blank
+  use stdlib_string_type, only: string_type
   implicit none
   private
   ! Public API
-  public :: loadtxt, savetxt, open
+  public :: loadtxt, savetxt, open, disp
 
   ! Private API that is exposed so that we can test it in tests
   public :: parse_mode
 
+  !> version: experimental
+  !>
+  !> Display a scalar, vector or matrix.
+  !> ([Specification](../page/specs/stdlib_io.html#disp-display-your-data-to-the-screen-or-another-output-unit))
+  interface disp
+    #:set DISP_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES &
+        & + CMPLX_KINDS_TYPES + LOG_KINDS_TYPES
+    #:set DISP_RANKS = range(0, 3)
+    #:for k1, t1 in DISP_KINDS_TYPES
+    #:for rank in DISP_RANKS
+    module subroutine disp_${rank}$_${t1[0]}$${k1}$(value, header, unit, brief)
+        ${t1}$, intent(in) :: value${ranksuffix(rank)}$
+        character(len=*), intent(in), optional :: header
+        integer, intent(in), optional :: unit
+        logical, intent(in), optional :: brief
+    end subroutine disp_${rank}$_${t1[0]}$${k1}$
+    #:endfor
+    #:endfor
+    module subroutine disp_character(value, header, unit, brief)
+        character(len=*), intent(in), optional :: value
+        character(len=*), intent(in), optional :: header
+        integer, intent(in), optional :: unit
+        logical, intent(in), optional :: brief
+    end subroutine disp_character
+    module subroutine disp_string_type(value, header, unit, brief)
+        type(string_type), intent(in) :: value
+        character(len=*), intent(in), optional :: header
+        integer, intent(in), optional :: unit
+        logical, intent(in), optional :: brief
+    end subroutine disp_string_type
+  end interface disp
+
   interface loadtxt
     !! version: experimental
     !!

src/stdlib_io_disp.fypp

@@ -0,0 +1,214 @@
+#:include "common.fypp"
+#:set RIL_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES
+
+submodule (stdlib_io) stdlib_io_disp
+
+    use stdlib_strings, only: to_string
+    use stdlib_string_type, only: char
+    use, intrinsic :: iso_fortran_env, only: output_unit
+    implicit none
+
+    character(len=*), parameter :: fmt_r = '(*(g12.4, 1x))'
+    character(len=*), parameter :: fmt_c = '(*(g25.0, 1x))'
+    character(len=*), parameter :: format_ = 'g0.4'
+    integer, parameter :: brief_col = 5
+    integer, parameter :: brief_row = 5
+    integer, parameter :: default_col = 10
+    integer, parameter :: default_row = 50
+
+contains
+
+    #:for k1, t1 in RIL_KINDS_TYPES
+    !> Display a/an ${t1}$ scalar.
+    module procedure disp_0_${t1[0]}$${k1}$
+        integer :: unit_
+
+        unit_ = optval(unit, output_unit)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, fmt_r) value
+
+    end procedure disp_0_${t1[0]}$${k1}$
+
+    !> Display a/an ${t1}$ vector.
+    module procedure disp_1_${t1[0]}$${k1}$
+        integer :: unit_
+        logical :: brief_
+        integer :: m, col
+
+        unit_  = optval(unit, output_unit)
+        brief_ = optval(brief, .true.)
+        col    = merge(brief_col, default_col, present(brief) .and. brief_)
+        m      = size(value, 1)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, *) '[vector size: ' // to_string(m) // ']'
+        if (brief_ .and. m > col) then
+            !> Brief Print.
+            write(unit_, fmt_r) value(1:col-2), '...', value(m)
+        else
+            !> Full Print.
+            write(unit_, fmt_r) value(:)
+        end if
+
+    end procedure disp_1_${t1[0]}$${k1}$
+
+    !> Display a/an ${t1}$ matrix.
+    module procedure disp_2_${t1[0]}$${k1}$
+        integer :: unit_
+        logical :: brief_
+        integer :: i, m, n
+        integer :: col, row
+        character(len=1) :: colon(default_col)
+
+        unit_  = optval(unit, output_unit)
+        brief_ = optval(brief, .true.)
+        col    = merge(brief_col, default_col, present(brief) .and. brief_)
+        row    = merge(brief_row, default_row, present(brief) .and. brief_)
+        m      = size(value, 1)
+        n      = size(value, 2)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, *) '[matrix size: ' // to_string(m) // '×' // to_string(n) // ']'
+        if (brief_ .and. (m > col .or. n > row)) then
+            !> Brief Print.
+            colon = ':'
+            if (m > col .and. n > row) then
+                do i = 1, row-2
+                    write(unit_, fmt_r) value(i,1:col-2), '...', value(i,n)
+                end do
+                write(unit_, fmt_r) colon(1:col)
+                write(unit_, fmt_r) value(m,1:col-2), '...', value(m,n)
+            elseif (m > col .and. n <= row) then
+                do i = 1, 3
+                    write(unit_, fmt_r) value(i,:)
+                end do
+                write(unit_, fmt_r) colon(1:n)
+                write(unit_, fmt_r) value(m,:)
+            elseif (m <= col .and. n > row) then
+                do i = 1, m
+                    write(unit_, fmt_r) value(i,1:col-2), '...', value(i,n)
+                end do
+            end if
+        else
+            !> Full Print.
+            do i = 1, m
+                write(unit_, fmt_r) value(i,:)
+            end do
+        end if
+
+    end procedure disp_2_${t1[0]}$${k1}$
+    #:endfor
+
+    #:for k1, t1 in CMPLX_KINDS_TYPES
+    !> Display a ${t1}$ scalar.
+    module procedure disp_0_${t1[0]}$${k1}$
+        integer :: unit_
+
+        unit_  = optval(unit, output_unit)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, fmt_c) to_string(value, format_)
+
+    end procedure disp_0_${t1[0]}$${k1}$
+
+    !> Display a ${t1}$ vector.
+    module procedure disp_1_${t1[0]}$${k1}$
+        integer :: unit_
+        logical :: brief_
+        integer :: i, m, col
+
+        unit_  = optval(unit, output_unit)
+        brief_ = optval(brief, .true.)
+        col    = merge(brief_col, default_col, present(brief) .and. brief_)
+        m      = size(value, 1)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, *) '[vector size: ' // to_string(m) // ']'
+        if (brief_ .and. m > col) then
+            !> Brief Print.
+            write(unit_, fmt_c) (to_string(value(i), format_), i=1, col-2), &
+                          '...', to_string(value(m), format_)
+        else
+            !> Full Print.
+            write(unit_, fmt_c) (to_string(value(i), format_), i=1, m)
+        end if
+
+    end procedure disp_1_${t1[0]}$${k1}$
+
+    !> Display a ${t1}$ matrix.
+    module procedure disp_2_${t1[0]}$${k1}$
+        integer :: unit_
+        logical :: brief_
+        integer :: i, j, m, n
+        integer :: col, row
+        character(len=1) :: colon(default_col)
+
+        unit_  = optval(unit, output_unit)
+        brief_ = optval(brief, .true.)
+        col    = merge(brief_col, default_col, present(brief) .and. brief_)
+        row    = merge(brief_row, default_row, present(brief) .and. brief_)
+        m      = size(value, 1)
+        n      = size(value, 2)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, *) '[matrix size: ' // to_string(m) // '×' // to_string(n) // ']'
+        if (brief_ .and. (m > col .or. n > row)) then
+            !> Brief Print.
+            colon = ':'
+            if (m > col .and. n > row) then
+                do i = 1, col-2
+                    write(unit_, fmt_c) (to_string(value(i,j), format_), j=1, col-2), &
+                                  '...', to_string(value(i,n), format_)
+                end do
+                write(unit_, fmt_c) colon(1:col)
+                write(unit_, fmt_c) (to_string(value(m,j), format_), j=1, col-2), &
+                              '...', to_string(value(m,n), format_)
+            elseif (m > col .and. n <= row) then
+                do i = 1, col-2
+                    write(unit_, fmt_c) (to_string(value(i,j), format_), j=1, n)
+                end do
+                write(unit_, fmt_c) colon(1:n)
+                write(unit_, fmt_c) (to_string(value(m,j), format_), j=1, n)
+            elseif (m <= col .and. n > row) then
+                do i = 1, m
+                    write(unit_, fmt_c) (to_string(value(m,j), format_), j=1, col-2), &
+                                  '...', to_string(value(m,n), format_)
+                end do
+            end if
+        else
+            !> Full Print.
+            do i = 1, m
+                write(unit_, fmt_c) (to_string(value(i,j), format_), j=1, n)
+            end do
+        end if
+
+    end procedure disp_2_${t1[0]}$${k1}$
+    #:endfor
+
+    !> Display a `character` scalar.
+    module procedure disp_character
+        character(len=:), allocatable :: value_
+        integer :: unit_
+
+        value_ = optval(value, '')
+        unit_  = optval(unit, output_unit)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, *) value_
+
+    end procedure disp_character
+
+    !> Display a `string_type` scalar
+    module procedure disp_string_type
+        integer :: unit_
+
+        unit_ = optval(unit, output_unit)
+
+        if (present(header)) write(unit_, *) header
+        write(unit_, *) char(value)
+            !!\TODO: Need to improve ?
+
+    end procedure disp_string_type
+
+end submodule stdlib_io_disp

src/tests/io/CMakeLists.txt

@@ -8,3 +8,4 @@ set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision)
 
 ADDTEST(open)
 ADDTEST(parse_mode)
+ADDTEST(io_disp)

src/tests/io/Makefile.manual

@@ -3,7 +3,8 @@ PROGS_SRC = test_loadtxt.f90 \
 			test_loadtxt_qp.f90 \
 			test_savetxt_qp.f90 \
 			test_parse_mode.f90 \
-			test_open.f90
+			test_open.f90 \
+            test_io_disp.f90
 
 CLEAN_FILES = tmp.dat tmp_qp.dat io_open.dat io_open.stream