diff --git a/src/collections.f90 b/src/collections.f90 index 81e2025..23050f6 100644 --- a/src/collections.f90 +++ b/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 ! ------------------------------------------------------------------------------ diff --git a/src/collections_data.f90 b/src/collections_data.f90 index b5e20ac..1a80999 100644 --- a/src/collections_data.f90 +++ b/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 ! ------------------------------------------------------------------------------