[stdlib_linalg] Add zeros, ones function.

doc/specs/stdlib_linalg.md

@@ -206,3 +206,107 @@ program demo_outer_product
     !A = reshape([3., 6., 9., 4., 8., 12.], [3,2])
 end program demo_outer_product
 ```
+
+## `zeros/ones` - creates an vector or matrix of `integer` type, given shape and `0/1` value.
+
+### Status
+
+Experimental
+
+### Class
+
+Pure function.
+
+### Description
+
+`zeros/ones` creates an vector or matrix of `integer` type, given shape and `0/1` value.
+
+### Syntax
+
+For vector:
+`result = [[stdlib_linalg(module):zeros(interface)]](dim)`  
+`result = [[stdlib_linalg(module):ones(interface)]](dim)`
+
+For matrix:
+`result = [[stdlib_linalg(module):zeros(interface)]](dim1, dim2)`  
+`result = [[stdlib_linalg(module):ones(interface)]](dim1, dim2)`
+
+
+### Arguments
+
+`dim/dim1`: Shall be an `integer` type.
+
+`dim2`: Shall be an `integer` type.
+
+### Return value
+
+Returns an vector or matrix of `integer` type, given shape and `0/1` value.
+
+### Example
+
+```fortran
+program demo
+    use stdlib_linalg, only: zeros, ones
+    implicit none
+    real, allocatable :: A(:,:)
+
+    A = zeros(2,2)          !! 0 0 0 0
+    A = ones(4,4)           !! 1 1 1 1; 1 1 1 1; 1 1 1 1; 1 1 1 1
+    A = 2.0*ones(2,2)       !! 2.00000000       2.00000000       2.00000000       2.00000000
+
+end program demo
+```
+
+## `ex` - creates an vector or matrix of `integer/logical/real/complex/string_type` type, given shape and `value` value.
+
+### Status
+
+Experimental
+
+### Class
+
+Pure function.
+
+### Description
+
+`ex` creates an vector or matrix of `integer/logical/real/complex/string_type` type, given shape and `value` value.
+
+### Syntax
+
+For vector:
+`result = [[stdlib_linalg(module):ex(interface)]](value, dim)`  
+
+For matrix:
+`result = [[stdlib_linalg(module):ex(interface)]](value, dim1, dim2)`  
+
+
+### Arguments
+
+`value`: Shall be an `integer/logical/real/complex/string_type` scalar. 
+This is an `intent(in)` argument.
+
+`dim/dim1`: Shall be an `integer` scalar. 
+This is an `intent(in)` argument.
+
+`dim2`: Shall be an `integer` scalar. 
+This is an `intent(in)` argument.
+
+### Return value
+
+Returns an vector or matrix of `integer/logical/real/complex/string_type` type, given shape and `value` value.
+
+### Example
+
+```fortran
+program demo_linalg_ex
+    use stdlib_linalg, only: zeros, ones
+    implicit none
+    real, allocatable :: A(:,:)
+
+    A = ex(0,2,2)           !! Same as zeros(2,2)
+    A = ex(1,4,4)           !! Same as ones(4,4)
+    A = 2.0*ex(1, 2,2)      !! 2.00000000       2.00000000       2.00000000       2.00000000
+    A = ex(1.0, 2)          !! 1.00000000       1.00000000
+
+end program demo_linalg_ex
+```

src/CMakeLists.txt

@@ -9,6 +9,7 @@ set(fppFiles
     stdlib_io.fypp
     stdlib_linalg.fypp
     stdlib_linalg_diag.fypp
+    stdlib_linalg_exs.fypp
     stdlib_linalg_outer_product.fypp
     stdlib_optval.fypp
     stdlib_sorting.fypp

src/Makefile.manual

@@ -6,6 +6,7 @@ SRCFYPP =\
         stdlib_io.fypp \
         stdlib_linalg.fypp \
         stdlib_linalg_diag.fypp \
+        stdlib_linalg_exs.fypp \
         stdlib_linalg_outer_product.fypp \
         stdlib_optval.fypp \
         stdlib_quadrature.fypp \
@@ -81,10 +82,15 @@ stdlib_io.o: \
 	stdlib_optval.o \
 	stdlib_kinds.o
 stdlib_linalg.o: \
-	stdlib_kinds.o
+	stdlib_kinds.o \
+    stdlib_string_type.o
 stdlib_linalg_diag.o: \
 	stdlib_linalg.o \
 	stdlib_kinds.o
+stdlib_linalg_exs.o: \
+	stdlib_linalg.o \
+	stdlib_kinds.o \
+    stdlib_string_type.o
 stdlib_logger.o: stdlib_ascii.o stdlib_optval.o
 stdlib_optval.o: stdlib_kinds.o
 stdlib_quadrature.o: stdlib_kinds.o

src/stdlib_linalg.fypp

@@ -4,14 +4,16 @@ module stdlib_linalg
   !!Provides a support for various linear algebra procedures
   !! ([Specification](../page/specs/stdlib_linalg.html))
   use stdlib_kinds, only: sp, dp, qp, &
-    int8, int16, int32, int64
+    int8, int16, int32, int64, lk, c_bool
+  use stdlib_string_type, only: string_type
   implicit none
   private
 
   public :: diag
   public :: eye
   public :: trace
   public :: outer_product
+  public :: zeros, ones, ex
 
   interface diag
     !! version: experimental
@@ -80,6 +82,57 @@ module stdlib_linalg
     #:endfor
   end interface outer_product
 
+    !> Version: experimental
+    !>
+    !> `ones` creates an vector or matrix of `integer` type and given shape, 
+    !>  with a `1` value. 
+    interface ones
+        pure module function ones_1_default(dim) result(result)
+            integer, intent(in) :: dim
+            integer :: result(dim)
+        end function ones_1_default
+        pure module function ones_2_default(dim1, dim2) result(result)
+            integer, intent(in) :: dim1, dim2
+            integer :: result(dim1, dim2)
+        end function ones_2_default
+    end interface ones
+
+    !> Version: experimental
+    !>
+    !> `zeros` creates an vector or matrix of `integer` type and given shape, 
+    !>  with a `0` value.  
+    interface zeros
+        pure module function zeros_1_default(dim) result(result)
+            integer, intent(in) :: dim
+            integer :: result(dim)
+        end function zeros_1_default
+        pure module function zeros_2_default(dim1, dim2) result(result)
+            integer, intent(in) :: dim1, dim2
+            integer :: result(dim1, dim2)
+        end function zeros_2_default
+    end interface zeros
+
+    !> Version: experimental
+    !>
+    !> `ex` creates an vector or matrix of `integer/logical/real/complex/string_type` type and given shape, 
+    !>  with an `value` value.  
+    interface ex
+        #:set ALL_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES &
+            & + LOG_KINDS_TYPES + STRING_KINDS_TYPES
+        #:for k1, t1 in ALL_KINDS_TYPES
+        pure module function ex_1_${t1[0]}$_${k1}$(value, dim) result(result)
+            ${t1}$, intent(in) :: value
+            integer, intent(in) :: dim
+            ${t1}$ :: result(dim)
+        end function ex_1_${t1[0]}$_${k1}$
+        pure module function ex_2_${t1[0]}$_${k1}$(value, dim1, dim2) result(result)
+            ${t1}$, intent(in) :: value
+            integer, intent(in) :: dim1, dim2
+            ${t1}$ :: result(dim1, dim2)
+        end function ex_2_${t1[0]}$_${k1}$
+        #:endfor
+    end interface ex
+
 contains
 
     function eye(n) result(res)

src/stdlib_linalg_exs.fypp

@@ -0,0 +1,76 @@
+#:include "common.fypp"
+#:set ALL_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES &
+    & + LOG_KINDS_TYPES + STRING_KINDS_TYPES
+submodule(stdlib_linalg) stdlib_linalg_exs
+
+    implicit none
+
+contains
+
+    !> `ones` creates an vector of `integer` type and `1` value.
+    pure module function ones_1_default(dim) result(result)
+        implicit none
+        integer, intent(in) :: dim
+        integer :: result(dim)
+
+        result = 1
+
+    end function ones_1_default
+
+    !> `ones` creates a matrix of `integer` type and `1` value.
+    pure module function ones_2_default(dim1, dim2) result(result)
+        implicit none
+        integer, intent(in) :: dim1, dim2
+        integer :: result(dim1, dim2)
+
+        result = 1
+
+    end function ones_2_default
+
+    !> `zeros` creates an vector of `integer` type and `0` value.
+    pure module function zeros_1_default(dim) result(result)
+        implicit none
+        integer, intent(in) :: dim
+        integer :: result(dim)
+
+        result = 0
+
+    end function zeros_1_default
+
+    !> `zeros` creates a matrix of `integer` type and `0` value.
+    pure module function zeros_2_default(dim1, dim2) result(result)
+        implicit none
+        integer, intent(in) :: dim1, dim2
+        integer :: result(dim1, dim2)
+
+        result = 0
+
+    end function zeros_2_default
+
+    #:for k1, t1 in ALL_KINDS_TYPES
+    !> `ex` creates an vector of `${t1}$` type and `value` value.
+    pure module function ex_1_${t1[0]}$_${k1}$(value, dim) result(result)
+
+        implicit none
+        ${t1}$, intent(in) :: value
+        integer, intent(in) :: dim
+        ${t1}$ :: result(dim)
+
+        result = value
+
+    end function ex_1_${t1[0]}$_${k1}$
+
+    !> `ex` creates a matrix of `${t1}$` type and `value` value.
+    pure module function ex_2_${t1[0]}$_${k1}$(value, dim1, dim2) result(result)
+
+        implicit none
+        ${t1}$, intent(in) :: value
+        integer, intent(in) :: dim1, dim2
+        ${t1}$ :: result(dim1, dim2)
+
+        result = value
+
+    end function ex_2_${t1[0]}$_${k1}$
+    #:endfor
+
+end submodule stdlib_linalg_exs

src/tests/Makefile.manual

@@ -11,3 +11,4 @@ all test clean:
 	$(MAKE) -f Makefile.manual --directory=stats $@
 	$(MAKE) -f Makefile.manual --directory=string $@
 	$(MAKE) -f Makefile.manual --directory=math $@
+	$(MAKE) -f Makefile.manual --directory=linalg $@

src/tests/linalg/CMakeLists.txt

@@ -1,2 +1,3 @@
 ADDTEST(linalg)
+ADDTEST(linalg_exs)
 

src/tests/linalg/Makefile.manual

@@ -0,0 +1,4 @@
+PROGS_SRC = test_linalg_exs.f90
+
+
+include ../Makefile.manual.test.mk

src/tests/linalg/test_linalg_exs.f90

@@ -0,0 +1,81 @@
+!> SPDX-Identifier: MIT
+module test_linalg_exs
+
+    use stdlib_linalg, only: zeros, ones, ex
+    use stdlib_error, only: check
+    use stdlib_string_type
+    implicit none
+
+    logical, parameter :: warn = .false.
+
+contains
+
+    subroutine test_linalg_zeros
+        call check(all(zeros(2) == [0, 0]), msg="all(zeros(2)==[0, 0] failed", warn=warn)
+        call check(all(zeros(2, 2) == reshape([0, 0, 0, 0], [2, 2])), &
+                   msg="all(zeros(2,2)==reshape([0, 0, 0, 0],[2,2]) failed", warn=warn)
+    end subroutine test_linalg_zeros
+
+    subroutine test_linalg_ones
+        call check(all(ones(2) == [1, 1]), msg="all(ones(2)==[1, 1] failed", warn=warn)
+        call check(all(ones(2, 2) == reshape([1, 1, 1, 1], [2, 2])), &
+                   msg="all(ones(2,2)==reshape([1, 1, 1, 1],[2,2]) failed", warn=warn)
+    end subroutine test_linalg_ones
+
+    subroutine test_linalg_ex_integer
+        call check(all(ex(1, 2) == ones(2)), msg="all(ex(1, 2) == ones(2)) failed", warn=warn)
+        call check(all(ex(1, 2, 2) == ones(2, 2)), &
+                   msg="all(ex(1, 2, 2) == ones(2,2)) failed", warn=warn)
+    end subroutine test_linalg_ex_integer
+
+    subroutine test_linalg_ex_real
+        call check(all(ex(1.0, 2) == 1.0*ones(2)), msg="all(ex(1.0, 2) == 1.0*ones(2)) failed", warn=warn)
+        call check(all(ex(1.0, 2, 2) == 1.0*ones(2, 2)), &
+                   msg="all(ex(1.0, 2, 2) == 1.0*ones(2,2)) failed", warn=warn)
+    end subroutine test_linalg_ex_real
+
+    subroutine test_linalg_ex_complex
+        call check(all(ex((1.0, 1.0), 2) == (1.0, 1.0)*ones(2)), &
+                   msg="all(ex((1.0,1.0), 2) == (1.0,1.0)*ones(2)) failed", warn=warn)
+        call check(all(ex((1.0, 1.0), 2, 2) == (1.0, 1.0)*ones(2, 2)), &
+                   msg="all(ex((1.0,1.0), 2, 2) == (1.0,1.0)*ones(2,2)) failed", warn=warn)
+    end subroutine test_linalg_ex_complex
+
+    subroutine test_linalg_ex_logical
+        call check(all(ex(.true., 2) .eqv. [.true., .true.]), &
+                   msg="all(ex(.true., 2) .eqv. [.true., .true.]) failed", warn=warn)
+        call check(all(ex(.true., 1, 2) .eqv. reshape([.true., .true.], [1, 2])), &
+                   msg="all(ex(.true., 1, 2) .eqv. reshape([.true., .true.],[1,2])) failed", warn=warn)
+    end subroutine test_linalg_ex_logical
+
+    subroutine test_linalg_ex_string_type
+
+        type(string_type) :: string_list(1,2)
+        string_list = string_type("A")
+
+        call check(all(ex(string_type("A"), 2) == [string_type("A"), string_type("A")]), &
+                   msg='all(ex(string_type("A"), 2) == [string_type("A"), &
+                   &string_type("A")]) failed', warn=warn)
+        call check(all(ex(string_type("A"), 1, 2) == string_list), &
+                   msg='all(ex(string_type("A"), 1, 2) == reshape([string_type("A"), &
+                   &string_type("A")],[1,2])) failed', warn=warn)
+
+    end subroutine test_linalg_ex_string_type
+
+end module test_linalg_exs
+
+program tester
+
+    use test_linalg_exs
+
+    call test_linalg_zeros
+    call test_linalg_ones
+    call test_linalg_ex_integer
+    call test_linalg_ex_real
+    call test_linalg_ex_complex
+    call test_linalg_ex_logical
+    call test_linalg_ex_string_type
+
+    print *, "All tests in `test_linalg_exs` passed"
+
+end program tester