Поиск по наименованию и суммирование (Memo)

[cybernewbie]

Сейчас решил удалять в ещё одном цикле, все строки которые повторяются прям на этапе добавления записи в список. Получилось почти идеально, но не хватает одной группы записей.
Удаляю с конца.

  for i:=0 to memo1.Lines.Count-1 do begin
  new(curr);
   if LeftStr(memo1.Lines.Strings[i], 5)='prod:' then
   begin
   curr^.name1 := memo1.Lines.Strings[i];
   curr^.name2 := memo1.Lines.Strings[i+1];
   curr^.name3 := memo1.Lines.Strings[i+2];
   curr^.name4 := memo1.Lines.Strings[i+3];
   b:=i+4;
    for a:=b to memo1.Lines.Count-1 do begin
     if (memo1.Lines.Strings[a+1]=curr^.name2) and (LeftStr(memo1.Lines.Strings[a+3], 10)=' quantity:') then begin
     curr^.name4:=' quantity: ' + inttostr((strtoint(StringReplace(curr^.name4,' quantity: ','',[rfReplaceAll])) + strtoint(StringReplace(memo1.Lines.Strings[a+3],' quantity: ','',[rfReplaceAll]))));
     end;
    end;
      for c:=0 to memo1.Lines.Count-1 do begin
       if curr^.name2=memo1.Lines.Strings[c] then begin
       Memo1.Lines.Delete(c+2);
       Memo1.Lines.Delete(c+1);
       Memo1.Lines.Delete(c);
       Memo1.Lines.Delete(c-1);
       end;
      end;
   curr^.next := head;
   head := curr;
  end;
  end;

Где я мог ошибиться?

[cybernewbie]

Вот скнимок

[macomics]

Вам не обязательно удалять записи, которые вы не складываете.

TPCount = ^TCount;
TCount = packed record
  next: TPCount; // Следующий элемент списка (этот элемент должен быть первым элементом структуры)
  name, col, quantity: String; // Набор значений prod:
  index: Integer; // Чтобы не искать строку в Memo
end;
...
head := nil;
tail := TPCount(@head);
s := 0; // Счетчик пропущенных строк
for i := Memo1.Lines.Count - 1 downto 0 do
  if Memo1.Lines[i] = 'prod:' then begin
    if s > 2 then begin // Пропущено больше 2-х строк. Если меньше, то запись не корректная
      // Проверяем последующие строки i + 1 .. i + 3
      new(newItem);
      newItem^.index := i; // Элемент prod, который был сохранен
      with newItem^ do for j := i + 1 to i + 3 do begin // Заполнение записи, предполагая, что все строки присутствуют, но могут быть в произвольном порядке
        if LeftString(Memo1.Lines[j], 6) = ' name:' then
          name := Memo1.Lines[j];
        if LeftString(Memo1.Lines[j], 5) = ' col:' then
          col := Memo1.Lines[j];
        if LeftString(Memo1.Lines[j], 10) = ' quantity:' then
          quantity := Memo1.Lines[j];
      end; // for j := i + 1 to i + 3 do begin
      // Проверка списка на совпадение имени и цвета
      item := head;
      while item <> nil do begin
        if (item^.name = newItem^.name) and (item^.col = newItem^.col) then begin // Найдено совпадение, суммируем
          item^.quantity := LeftString(item^.quantity, 11) + inttostr(strtoint(copy(item^.quantity, 11)) + strtoint(copy(newItem^.quantity, 11)));
          j := item^.index;
          item^.index := i; // Обновляем номер элемента
          Memo1.Lines.Delete(j + 3); // Удалить строки из Memo
          Memo1.Lines.Delete(j + 2);
          Memo1.Lines.Delete(j + 1);
          Memo1.Lines.Delete(j);
          Dispose(newItem); // Добавлять в список суммированный элемент уже не нужно
          break;
        end; // if (item^.name = newItem^.name) and (item^.col = newItem^.col) then begin
        item := item^.next;
      end; // while item <> nil do begin
      if item = nil then begin // Элемент списка не найден, добавляем его в список
        tail^.next := newItem;
        newItem^.next := nil;
        tail := newItem;
      end; // if item = nil then begin
    end; // if s > 2 then begin
    s := 0; // Обнулить счетчик пропущенных строк
  end else inc(s); // if Memo1.Lines[i] = 'prod:' then begin
item := head;
head := nil;
tail := nil;
while item <> nil do begin
  with item^ do begin
    newItem := next;
    Memo1.Lines[index + 1] := name; // Обновляем строки в Memo и заодно упорядочиваем
    Memo1.Lines[index + 2] := col;
    Memo1.Lines[index + 3] := quantity;
  end; // with item^ do begin
  Dispose(item); // Освобождаем память занятую списком
  item := newItem;
end; // while item <> nil do begin

Как-то так. Не проверял, набирал в браузере. За очепятки не серчайте.

[cybernewbie]

Попробовал, ошибка:
[dcc32 Error] Unit1.pas(78): E2081 Assignment to FOR-Loop variable 'j'

          item^.quantity := LeftString(item^.quantity, 11) + inttostr(strtoint(copy(item^.quantity, 11)) + strtoint(copy(newItem^.quantity, 11)));
          j := item^.index;
          item^.index := i; // Обновляем номер элемента

Если закомментировать, то запускается, но выскакивает:
Access violation at address 0060292C in module 'Project1.exe'.
Write of address 00000000.

      item := head;
      while item <> nil do begin
        if (item^.name = newItem^.name) and (item^.col = newItem^.col) then begin // Найдено совпадение, суммируем

Можете посмотреть?

[macomics]

end; забыл у for j := i + 1 to i + 3 do begin
перед строкой: // Проверка списка на совпадение имени и цвета

Я исправил в тексте выше. И проверил все конструкции на подобные ошибки.

[macomics]

Код только с массивами без динамических списков

procedure TForm1.Button1Click(Sender: TObject);
var
   ind: array of Integer; // Массив индексов актуальных структур
   del: array of Integer; // Массив индексов суммированных структур (подлежат удалению)
   c, i, j, max, lst: Integer;
   nam, col, qua: String;
begin
   SetLength(ind, Memo1.Lines.Count div 4); // Количество строк разделенное на 4 это максимальное количество структур, которое может поместиться в тексте
   SetLength(del, Memo1.Lines.Count div 4);
   max := Low(ind) - 1; // Начальный индекс в массиве ind
   lst := Low(del) - 1; // Начальный индекс в массиве del
   c := 0; // Количество пропущенных строк (для определения возможности вычленения структуры)
   with Memo1 do for i := Lines.Count - 1 downto 0 do
      if Lines[i] = 'prod:' then begin // Найдено начало структуры
         if c > 2 then begin // Количество пропущенных строк достаточное для получения полей структуры
            for j := i + 1 to i + 3 do begin // Заполнение переменных значениями полей структуры
               if LeftStr(Lines[j],  6) = ' name:'     then nam := Lines[j];
               if LeftStr(Lines[j],  5) = ' col:'      then col := Lines[j];
               if LeftStr(Lines[j], 10) = ' quantity:' then qua := Lines[j];
            end; // for j := i + 1 to i + 3 do begin
         end;
         j := Low(ind); // Поиск в массиве актуальных структур схожей записи
         while (j <= max) and ((Lines[ind[j] + 1] <> nam) or (Lines[ind[j] + 2] <> col)) do inc(j);
         if j > max then begin // Запись не найдена
            ind[j] := i; // Сохраняем в массиве ind индекс начала новой записи
            max := j; // Увеличиваем количество занятых элементов в массиве ind
         end else begin // Запись найдена, суммирование
            inc(lst); // Увеличиваем количество занятых элементов в массиве del
            del[lst] := ind[j]; // Сохраняем в массиве del индекс суммированной структуры
            ind[j] := i; // Обновляем в массиве ind индекс начала структуры
            Lines[i + 1] := nam; // Обновляем поля структуры, заодно сортируем
            Lines[i + 2] := col;
            Lines[i + 3] := LeftStr(qua, 11) + inttostr(strtoint(copy(qua, 11)) + strtoint(copy(Lines[del[lst] + 3], 11))); // и суммируем
         end; // if j > max then begin
         c := 0; // Сбрасываем счетчик пропущенных строк с предыдущей строки 'prod:'
      end else inc(c); // if Memo1.Lines[i] = 'prod:' then begin
   with Memo1.Lines do for i := Low(del) to lst do begin // Удаление структур в Memo суммированных с другими структурами
      c := i;
      for j := i + 1 to lst do if del[j] > del[c] then c := j;
      if c <> i then begin // Нашли максимальный индекс в массиве
        j := del[c];
        del[c] := del[i];
        del[i] := j;
      end else j := del[i]; // if c <> i then begin
      Delete(j + 3); // Удаляем строки связанные со структурой
      Delete(j + 2);
      Delete(j + 1);
      Delete(j);
   end; // for i := lst downto Low(del) do begin
end;

Ввод

class: 1234
buf: 2323
prod:
 name: msi 990
 col: red
 quantity: 1
prod:
 name: micro 500
 col: blue
 quantity: 1
prod:
 name: msi 990
 col: red
 quantity: 2
prod:
 name: allso
 col: blue
 quantity: 1
prod:
 name: micro 500
 col: blue
 quantity: 1
book: open
TF: open

Вывод

class: 1234
buf: 2323
prod:
 name: msi 990
 col: red
 quantity: 3
prod:
 name: micro 500
 col: blue
 quantity: 2
prod:
 name: allso
 col: blue
 quantity: 1
book: open
TF: open

[cybernewbie]

Первый код отлично работает, у меня кое что не получалось, но потом подправил и всё ок.
Нижние записи получались в середине, ща всё ок.
Код с массивами попробую сейчас.
Большое спасибо за помощь, а ещё огроменное спасибо за классное объяснение.

Получается желательно использовать код с массивами, если следующие данные имеют такой вид:

Form FO
class:1234
buf:2323
par1:445345345
par2:2387545
par3:1111
par4:d26.09.2022 16:01:00
par5:33665656
set1:4534534
set2:54
set3:1
set4:118
set5:none
allindex:333
mail:mail@ya.ru
prod:
 name:msi 990
 col:red
 quantity:1
 SN:0834744554
 model N:7124A
 PAS:t
 tel:12345
 GAT:54
 SIZE:8
  VVN:2200001  //эти строки у всех разные, но при суммировании структур, оставляю первую
prod:
 name:micro 500
 col:blue
 quantity:1
 SN:834224
 model N:52E
 PAS:fal
 tel:474635
 GAT:58
 SIZE:6
  VVN:350000
prod:
 name:msi 990
 col:red
 quantity:2
 SN:0834744554
 model N:7124A
 PAS:t
 tel:12345
 GAT:54
 SIZE:8
  VVN:2205002
prod:
 name:allso
 col:blue
 quantity:1
 SN:0983452
 model N:11T
 PAS:fal
 tel:999856
 GAT:58
 SIZE:6
  VVN:1883727
prod:
 name:micro 500
 col:blue
 quantity:1
 SN:834224
 model N:52E
 PAS:fal
 tel:474635
 GAT:58
 SIZE:6
  VVN:350065
region1:asia
region2:eu
region3:cn
generalreg1:us
generalreg2:ru
generalreg3:uk
calib1:58x28
calib2:28x128
calib3:none
paramgen:yes
book:open
TF:open

После суммирования:

Form FO
class:1234
buf:2323
par1:445345345
par2:2387545
par3:1111
par4:d26.09.2022 16:01:00
par5:33665656
set1:4534534
set2:54
set3:1
set4:118
set5:none
allindex:333
mail:mail@ya.ru
prod:
 name:msi 990
 col:red
 quantity:3
 SN:0834744554
 model N:7124A
 PAS:t
 tel:12345
 GAT:54
 SIZE:8
  VVN:2200001  
prod:
 name:micro 500
 col:blue
 quantity:2
 SN:834224
 model N:52E
 PAS:fal
 tel:474635
 GAT:58
 SIZE:6
  VVN:350000
prod:
 name:allso
 col:blue
 quantity:1
 SN:0983452
 model N:11T
 PAS:fal
 tel:999856
 GAT:58
 SIZE:6
  VVN:1883727
region1:asia
region2:eu
region3:cn
generalreg1:us
generalreg2:ru
generalreg3:uk
calib1:58x28
calib2:28x128
calib3:none
paramgen:yes
book:open
TF:open

Тут смысл такой же, но уже больше строк, также суммирую их... но уже строка 'quantity', не последняя, а также есть строка VVN, которая у всех конструкций разная, но при суммировании, остаётся первая VVN. С учётом всего этого, каким методом это легче сделать?

Ещё раз спасибо

[cybernewbie]

Сначала думал что с массивами будет выглядеть сложнее, когда только прочёл о них, но сейчас должен признать, что код с массивами показался мне легче, относительно списка, это по первому чтению... не знаю так ли это на самом деле

[macomics]

А что это за значение VVN?

Обновил алгоритм для работы с новой структурой. Так и не разобрался как вы суммируете поля структуры. Так как он не уместился, то прикрепляю файл

[cybernewbie]

Сообщение от macomics

А что это за значение VVN?

Это идентификатор "prod". Сама структура всегда уникальна, и родителем структуры, является строка name. Если текст содержит несколько одинаковых строк name, то и все дочерние строки родителя одинаковы с дочерними строками другого идентичного родителя, хотя есть исключение в виде строки VVN. А суммирую по строке name.
Спасибо большое за обновлённый алгоритм и за подробное объяснение.
А что значит?

// Количество строк разделенное на 4 это максимальное количество структур, которое может поместиться в тексте

Почему именно 4?
Попробовал такие условия, структуры объединяются, но почему то суммируются не так:

while (j <= max) and (Lines[ind[j]+1] <> fld[0]) do inc(j);

например должно быть три, а выходит 13 в:

prod:
 name:msi 990
 col:red
 quantity:13
...
...

Можете объяснить это?

// Количество пропущенных строк (для определения возможности вычленения структуры)

Влияет ли значение этой переменной на количество начальных пропущенных строк?
Заранее спасибо