Add data_table functionallity

src/collections.f90

@@ -410,7 +410,7 @@ module collections
  !! the bounds of the table.
  !! - FCORE_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory.
  procedure, public :: set => dt_set
- !> @brief Inserts a series of rows into the data table.
+ !> @brief Inserts a series of rows into the data_table.
  !!
  !! @par Syntax
  !! @code{.f90}
@@ -435,6 +435,31 @@ module collections
  !! number of columns as the data_table.
  !! - FCORE_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory.
  procedure, public :: insert_rows => dt_insert_rows
+ !> @brief Inserts a single row into the data_table.
+ !!
+ !! @par Syntax
+ !! @code{.f90}
+ !! subroutine insert_row(class(data_table) this, integer(int32) i, class(*) x(:), class(errors) err)
+ !! @endcode
+ !!
+ !! @param[in,out] this The data_table object.
+ !! @param[in] i The row index where @p x should be inserted into the table.
+ !! @param[in] x The N-element array where N is equal to the number of
+ !! columns in this data_table. A copy of each item is made, and the 
+ !! data_table takes care of management of the memory occupied by each 
+ !! copy.
+ !! @param[in,out] err An optional errors-based object that if provided 
+ !! can be used to retrieve information relating to any errors 
+ !! encountered during execution. If not provided, a default 
+ !! implementation of the errors class is used internally to provide 
+ !! error handling. Possible errors and warning messages that may be 
+ !! encountered are as follows.
+ !! - FCORE_INDEX_OUT_OF_RANGE_ERROR: Occurs if @p i is outside 
+ !! the bounds of the table.
+ !! - FCORE_ARRAY_SIZE_ERROR: Occurs if @p x does not have the same
+ !! number of items as the data_table has columns.
+ !! - FCORE_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory.
+ procedure, public :: insert_row => dt_insert_row
  end type
 
 ! ******************************************************************************
@@ -769,6 +794,13 @@ module subroutine dt_insert_rows(this, rstart, x, err)
  class(*), intent(in), dimension(:,:) :: x
  class(errors), intent(inout), optional, target :: err
  end subroutine
+
+ module subroutine dt_insert_row(this, i, x, err)
+ class(data_table), intent(inout) :: this
+ integer(int32), intent(in) :: i
+ class(*), intent(in), dimension(:) :: x
+ class(errors), intent(inout), optional, target :: err
+ end subroutine
  end interface
 
 ! ------------------------------------------------------------------------------

src/collections_data.f90

@@ -287,18 +287,18 @@ module subroutine dt_insert_rows(this, rstart, x, err)
  ! Copy back the contents into m_table
  do j = 1, n
  do i = 1, rstart - 1
- this%m_table(i,j) = copy(i,j)
+ this%m_table(i, j) = copy(i, j)
  end do
 
  k = rstart
  do i = 1, size(x, 1)
- call this%set(k, j, x(i,j), err = errmgr)
+ call this%set(k, j, x(i, j), err = errmgr)
  if (errmgr%has_error_occurred()) return
  k = k + 1
  end do
 
  do i = rstart, m
- this%m_table(k,j) = copy(i,j)
+ this%m_table(k, j) = copy(i, j)
  k = k + 1
  end do
  end do
@@ -312,8 +312,150 @@ module subroutine dt_insert_rows(this, rstart, x, err)
  end subroutine
 
 ! ------------------------------------------------------------------------------
+ module subroutine dt_insert_row(this, i, x, err)
+ ! Arguments
+ class(data_table), intent(inout) :: this
+ integer(int32), intent(in) :: i
+ class(*), intent(in), dimension(:) :: x
+ class(errors), intent(inout), optional, target :: err
+
+ ! Local Variables
+ class(errors), pointer :: errmgr
+ type(errors), target :: deferr
+ character(len = 256) :: errmsg
+
+ ! Set up error handling
+ if (present(err)) then
+ errmgr => err
+ else
+ errmgr => deferr
+ end if
+
+ ! Check the length of x
+ if (associated(this%m_table) .and. &
+ size(x) /= this%get_column_count()) &
+ then
+ write(errmsg, '(AI0AI0A)') "The number of items in the array " // &
+ "to insert ,", size(x), ", must match the number of " // &
+ "columns in the table ", this%get_column_count(), "."
+ call errmgr%report_error("dt_insert_row", trim(errmsg), &
+ FCORE_ARRAY_SIZE_ERROR)
+ return
+ end if
+
+ ! Insert the array
+ call this%insert_rows(i, reshape(x, [1, size(x)]), err = errmgr)
+ end subroutine
 
 ! ------------------------------------------------------------------------------
+ module subroutine dt_insert_columns(this, cstart, x, err)
+ ! Arguments
+ class(data_table), intent(inout) :: this
+ integer(int32), intent(in) :: cstart
+ class(*), intent(in), dimension(:,:) :: x
+ class(errors), intent(inout), optional, target :: err
+
+ ! Local Variables
+ integer(int32) :: i, j, k, m, n, nnew, flag
+ type(container), allocatable, dimension(:,:) :: copy
+ class(errors), pointer :: errmgr
+ type(errors), target :: deferr
+ character(len = 256) :: errmsg
+
+ ! Set up error handling
+ if (present(err)) then
+ errmgr => err
+ else
+ errmgr => deferr
+ end if
+
+ ! Initialization
+ m = this%get_row_count()
+ n = this%get_column_count()
+ nnew = n + size(x, 2)
+
+ ! Input Check
+ if (cstart < 1) then
+ call errmgr%report_error("dt_insert_columnss", &
+ "The insertion index must be at least 1.", &
+ FCORE_INDEX_OUT_OF_RANGE_ERROR)
+ return
+ end if
+ if (cstart > 1 + n) then
+ write(errmsg, '(AI0AI0A)') "The insertion index must not be " // &
+ "greater than ", n + 1, ", but was found to be ", cstart, "."
+ call errmgr%report_error("dt_insert_columns", trim(errmsg), &
+ FCORE_INDEX_OUT_OF_RANGE_ERROR)
+ return
+ end if
+ if (associated(this%m_table) .and. size(x, 1) /= m) then
+ write(errmsg, '(AI0AI0A)') "The input data set was expected " // &
+ "to have ", m, " rows, but was found to have ", &
+ size(x, 1), "."
+ call errmgr%report_error("dt_insert_columns", trim(errmsg), &
+ FCORE_ARRAY_SIZE_ERROR)
+ return
+ end if
+
+ ! If the array is not allocated, allocate and store as the input array
+ ! will define the table structure
+ if (.not.associated(this%m_table)) then
+ call this%initialize(size(x, 1), size(x, 2), err = errmgr)
+ if (errmgr%has_error_occurred()) return
+ do j = 1, size(x, 2)
+ do i = 1, size(x, 1)
+ call this%set(i, j, x(i,j), err = errmgr)
+ if (errmgr%has_error_occurred()) return
+ end do
+ end do
+ return
+ end if
+
+ ! If we're here, there was already a properly allocated matrix, and the
+ ! size of X is OK. Start by copying m_table, and then reallocate 
+ ! m_table to allow fitting of the new data
+ allocate(copy(m, n), stat = flag)
+ if (flag /= 0) go to 100
+ copy = this%m_table
+
+ deallocate(this%m_table)
+ allocate(this%m_table(mnew, n), stat = flag)
+ if (flag /= 0) then
+ ! Put copy back to m_table, and then handle the error
+ this%m_table = copy
+ go to 100
+ end if
+
+ ! Copy back the contents into m_table
+ do j = 1, cstart - 1
+ do i = 1, m
+ this%m_table(i, j) = copy(i, j)
+ end do
+ end do
+
+ k = cstart
+ do j = 1, size(x, 2)
+ do i = 1, m
+ call this%set(i, k, x(i, j), err = errmgr)
+ if (errmgr%has_error_occurred()) return
+ end do
+ k = k + 1
+ end do
+
+ do j = cstart, n
+ do i = 1, m
+ this%m_table(i, k) = copy(i, j)
+ end do
+ k = k + 1
+ end do
+
+ return
+ 100 continue
+ ! Deal with memory errors
+ call errmgr%report_error("dt_insert_columns", &
+ "Insufficient memory available.", FCORE_OUT_OF_MEMORY_ERROR)
+ return
+ end subroutine
 
 ! ------------------------------------------------------------------------------