Вот два предложения.Измените их по своему усмотрению.
Код написан для COBOL 85. В зависимости от вашего компилятора и системы могут быть и другие, возможно, лучшие способы сделать то же самое.
Следующий код не будет поддерживать исходный порядок, если только таблица уже не упорядочена по ascending
field1
и field2
.Таблица сжимается путем восстановления только объединенных записей.
main-line.
*> procesing before merging records
perform sort-records
*> procesing after merging records
stop run *> or exit program or goback
.
sort-records.
if max-table-count > 1
sort sort-file ascending field1 field2
duplicates in order
input procedure release-records
output procedure return records
end-if
.
release-records.
perform varying i from 1 by 1
until i > max-table-count
release sort-record from table-entry (i)
end-perform
.
return-records.
move 0 to max-table-count
perform return-next-record
move sort-record to ws-record
perform return-next-record
*> first two records are in place for following loop
perform until end-of-input
if ws-field1 = sort-field1
and ws-field2 = sort-field2
perform merge-records
*> duplicates are dropped after merging
else
perform move-record-to-table
*> merged or unique record is saved
move sort-record to ws-record
end-if
perform return-next-record
end-perform
perform move-record-to-table
*> last record is saved
.
move-record-to-table.
add 1 to max-table-count
move ws-record to table-entry (max-table-count)
.
return-next-record.
return sort-file
at end
set end-of-input to true
end-return
.
merge-records.
*> whatever is needed
Следующее поддерживает исходный порядок и уплотняет таблицу, удаляя объединенные дубликаты.Обратите внимание, в комментариях к коду, что marked
записей должны быть удалены, а unmarked
записей остаются.
main-line.
*> procesing before merging records
perform find-and-remove-duplicates
*> procesing after merging records
stop run *> or exit program or goback
.
find-and-remove-duplicates.
*> find and merge duplicates
perform varying i from 1 by 1
until i > (max-table-count - 1)
if field1 (i) (1:1) not = high-values
*> only compare unmarked records
add 1 to i giving j
perform varying j from j by 1
unitl j > max-table-count
if field1 (i) = field1 (j)
and field2 (i) = field2 (j)
perform merge-records
move high-values to field1 (j) (1:1)
*> mark for deletion
end-if
end-perform
end-if
end-perform
*> remove duplicates
perform varying i from 1 by 1
until i > max-table-count
or field1 (i) (1:1) = high-values
*> find first marked record
continue
end-perform
*> if there are no marked records, control
*> will pass to the end of the paragraph
*> and the table will remain unchanged
if i not > max-table-count
perform varying j from i by 1
until j > max-table-count
or field1 (j) (1:1) not = high-values
continue
end-perform
*> i points to a marked record
*> j points to an unmarked record
*> or is greater than max-table-count
*> which would occur if all marked records
*> are at the end of the table
*> loop to compact the table
perform until j > max-table-count
move table-entry (j) to table-entry (i)
add 1 to i
add i to j
perform varying j from j by 1
until j > max-table-count
or field1 (j) (1:1) not = high-values
*> find next unmarked record
continue
end-perform
end-perform
subtract 1 from i giving max-table-count
*> adjust count for removed records
end-if
.
merge-records.
*> whatever is needed
Если записи расположены в отсортированном порядке, код может быть сделан более эффективным.