Re[8]: Циклы с произвольным уровнем вложенности - Философия программирования

Мне несколько раз потребовалось сделать неопределённое множество вложенных циклов. Например такая задача: есть брутто формула молекулы, скажем C6H7N, и надо перебрать все возможные осколки (для масс-спектра). Конкретно для этой молекулы будет три вложенных цикла: семь шагов, восемь шагов и два шага. Сделал примерно так (мой работающий код относительно громоздкий, поэтому написал для наглядности новый и на 100.00% не уверен что он верен):

var
curn: integer;
i: integer;
finished:boolean;
begin
...
for q:=0 to count-1 do bruttoarr[i]:=sourcearr[i];
performstep(bruttoarr);
repeat
curn:=count-1;
finished:=false;
repeat
dec(bruttoarr[curn]);
if bruttoarr[curn]<0 then begin
bruttoarr[curn]:=sourcearr[curn];
dec(curn);
if curn<0 then begin finished:=true; break; end;
continue;
end;
break;
until false;

if finished then break;
performstep(bruttoarr);
until false;

Когда писал этот код, пришлось изрядно скрипеть мозгами и исправлять ошибки. Вопрос, можно ли в других ЯП написать как-то более изящно? Напишу вариант с бредом, но наверно будет понятно:

sfor si:=0 to count-1
for i:=0 to sourcearr[si]-1 do begin
next sfor
bruttoarr[si]:=i;
performstep(bruttoarr);
end;//next i

Здравствуйте, Khimik, Вы писали:

K>Когда писал этот код, пришлось изрядно скрипеть мозгами и исправлять ошибки. Вопрос, можно ли в других ЯП написать как-то более изящно?

Я бы начал с формирования стойкого навыка выделять структуру программы отступами. Иначе читать же невозможно.

Здравствуйте, Khimik, Вы писали:

K> Вопрос, можно ли в других ЯП написать как-то более изящно?
Да. Есть итераторы, генераторы и параметры функции

-- lua
for conf in all_possible_conf(input) do
    performstep(conf)
end

  // c++
  for(auto conf : all_possible_conf_iter(input)) performstep(conf);
  // или так
  all_possible_conf(input,[](State &conf){ performstep(conf); });

// pascal
it:=CreateAllPossibleConfIterator(input);
while(it.Next(state)) do performstep(state);

Здравствуйте, kov_serg, Вы писали:

_>// pascal
_>it:=CreateAllPossibleConfIterator(input);
_>while(it.Next(state)) do
_> performstep(state);
_>end
_>[/pascal]

Можно подробнее, что это такое?

Здравствуйте, Khimik, Вы писали:

K>Можно подробнее, что это такое?

Вот примерно такое:

{$APPTYPE CONSOLE}

type
  TItem=record z,k:integer end;
  TState=array of TItem;
  IGen=interface
    function Next(var state:TState):boolean;
  end;
  GenAll=class(TInterfacedObject,IGen)
    inp,cur:TState;
    constructor Create(input:TState);
    function Next(var state:TState):boolean;
  end;

function mkGen(input:TState):GenAll;
begin
  result:=GenAll.Create(input);
end;

constructor GenAll.Create(input:TState);
var i:integer;
begin
  inp:=copy(input); cur:=copy(input);
  for i:=0 to length(input)-1 do begin cur[i].k:=0; end;
end;

function GenAll.Next(var state:TState):boolean;
var i,n:integer;
begin
  result:=false; i:=0; n:=length(cur);
  while i<n do begin
    inc(cur[i].k); if cur[i].k<=inp[i].k then begin result:=true; break end;
    cur[i].k:=0; inc(i);
  end;
  if result then state:=copy(cur);
end;

function getName(z:integer):string;
const
  names:array[0..8] of string=('?','H','He','Li','Be','B','C','N','O'); {...}
begin
  result:=names[z];
end;

procedure showState(const state:TState);
var i:integer;
begin
  for i:=0 to length(state)-1 do
  begin
    if state[i].k>0 then begin
      write(getName(state[i].z));
      if state[i].k>1 then write(state[i].k);
    end;
  end;
  writeln;
end;

procedure test;
var gen:IGen; src,item:TState;
const
  H=1; C=6; N=7;
begin
  setlength(src,3);
  src[0].z:=C; src[0].k:=6;
  src[1].z:=H; src[1].k:=7;
  src[2].z:=N; src[2].k:=1;
{------------------------------------------------}
  gen:=mkGen(src);
  while gen.Next(item) do begin
    showState(item);
  end;
{------------------------------------------------}
end;

begin
  test;
end.

output

C
C2
C3
C4
C5
C6
H
CH
C2H
C3H
C4H
C5H
C6H
H2
CH2
C2H2
C3H2
C4H2
C5H2
C6H2
H3
CH3
C2H3
C3H3
C4H3
C5H3
C6H3
H4
CH4
C2H4
C3H4
C4H4
C5H4
C6H4
H5
CH5
C2H5
C3H5
C4H5
C5H5
C6H5
H6
CH6
C2H6
C3H6
C4H6
C5H6
C6H6
H7
CH7
C2H7
C3H7
C4H7
C5H7
C6H7
N
CN
C2N
C3N
C4N
C5N
C6N
HN
CHN
C2HN
C3HN
C4HN
C5HN
C6HN
H2N
CH2N
C2H2N
C3H2N
C4H2N
C5H2N
C6H2N
H3N
CH3N
C2H3N
C3H3N
C4H3N
C5H3N
C6H3N
H4N
CH4N
C2H4N
C3H4N
C4H4N
C5H4N
C6H4N
H5N
CH5N
C2H5N
C3H5N
C4H5N
C5H5N
C6H5N
H6N
CH6N
C2H6N
C3H6N
C4H6N
C5H6N
C6H6N
H7N
CH7N
C2H7N
C3H7N
C4H7N
C5H7N
C6H7N

Здравствуйте, kov_serg, Вы писали:

K>>Можно подробнее, что это такое?

Извиняюсь может я туплю, лень думать, но разве это не примерно то же что у меня? Только у меня repeat а у вас while. Зачем тут нужны интерфейсы — я не понял.
На всякий случай приведу свой полный код, там много всего, ещё разные дополнительные проверки (может ли существовать такой осколок):

Скрытый текст

procedure TMassSpecAnalyzerForm.CalculateButtonClick(Sender: TObject);
var
bruttoarr:TBruttoArrayCompact;
q:integer;
cq:integer;
w:integer;
curfragbrutto:TBruttoArrayCompact;
curfrag:tmoldata;
maxch:integer;
peakpos:double; peakerr:double;
docheck:boolean;
excluderear:boolean;
excludebyvalences:boolean;
variantscount:int64;
curvariant:int64;
curadvmoldata:TAdvMolData;
enumfinished:boolean;
curstopped:boolean;
stopped:boolean;
procedure AddFoundIonByBrutto(curbruttoarr:TBruttoArrayCompact; charg:integer; checkpeakmatch:boolean);overload;
var
mass:double;
chstr:string;
curpeak:double;
curbruttochargestr:string;
qq:integer;
begin
mass:=curbruttoarr.GetStandMass;
curpeak:=mass/charg;
if checkpeakmatch then if abs(curpeak-peakpos)>peakerr then exit;

if excludebyvalences then if not curbruttoarr.CheckCanBeCreatedWithPossibleValences(ProgressShowForm.outproc,curvariant/variantscount,curstopped) then begin
if curstopped then stopped:=true;
exit;
end;


if charg=1 then chstr:='+' else chstr:=inttostr(charg)+'+';

curbruttochargestr:=curbruttoarr.GetAsStr+'('+chstr+')';
for qq:=0 to fragmentslist.Items.Count-1 do if GetBruttoAndChargeStrFromList(qq)=curbruttochargestr then exit;

FragmentsList.Items.Add(curbruttochargestr+': '+floattostr(curpeak)+' DA');
end;

procedure AddFoundItemByBrutto(curbrottoarr:TBruttoArrayCompact; checkpeakmatch:boolean);
var
qq:integer;
begin
for qq:=1 to maxch do AddFoundIonByBrutto(curbrottoarr,qq,checkpeakmatch);
end;

procedure AddFoundIonByMolData(curmoldata:TMolData; charg:integer; checkpeakmatch:boolean);
var
mass:double;
chstr:string;
curpeak:double;
curbruttochargestr:string;
qq:integer;
curbruttoarr:TBruttoArrayCompact;
begin
curbruttoarr:=curmoldata.GetBruttoArrayCompact;
mass:=curbruttoarr.GetStandMass;
curpeak:=mass/charg;

if checkpeakmatch then if abs(curpeak-peakpos)>peakerr then begin curbruttoarr.Free; exit; end;

if curmoldata.HasMoreThanOneMolecule(false) then begin curbruttoarr.Free; exit; end;

if charg=1 then chstr:='+' else chstr:=inttostr(charg)+'+';

curbruttochargestr:=curbruttoarr.GetAsStr+'('+chstr+')';
for qq:=0 to fragmentslist.Items.Count-1 do if GetBruttoAndChargeStrFromList(qq)=curbruttochargestr then begin curbruttoarr.Free; exit; end;

FragmentsList.Items.Add(curbruttochargestr+': '+floattostr(curpeak)+' DA');

curbruttoarr.Free;
end;

procedure AddFoundItemByMolData(curmoldata:TMolData; checkpeakmatch:boolean);
var
qq:integer;
begin
for qq:=1 to maxch do AddFoundIonByMolData(curmoldata,qq,checkpeakmatch);
end;



begin
peakpos:=0; peakerr:=0;//warn
curadvmoldata:=nil;//warn
curfragbrutto:=nil;//warn
curfrag:=nil;//warn

docheck:=WhatToDoCombo.ItemIndex=2;
excluderear:=FilterTypeCombo.ItemIndex=1;
excludebyvalences:=FilterTypeCombo.ItemIndex=2;
if WhatToDoCombo.ItemIndex=0 then begin excluderear:=false; excludebyvalences:=false; end;


if excluderear then if SetCustomBruttoCheck.Checked then begin application.MessageBox('With custom molecular formulas. the filter "Exclude rearrangement ions" is not possible.','Chemcraft',mb_ok); exit; end;



bruttoarr:=GetBruttoArrayCompFromString(BruttoFormEdit.Text,false);

if bruttoarr.FCount=0 then begin bruttoarr.Free; exit; end;
if bruttoarr.HasNonExistingAtoms then begin application.MessageBox('The molecule contains atoms for which the data on isotopes is not provided.','Chemcraft',MB_OK); bruttoarr.Free; exit; end;


maxch:=strtoint(MaxChargeEdit.Text);

fragmentslist.Items.Clear;

if docheck then begin
peakpos:=strtofloat(PeakPosEdit.Text);
peakerr:=strtofloat(PeakErrEdit.Text);
end;


if excluderear then if fmoldata.HasMoreThanOneMolecule(false) then begin application.MessageBox('Your molecule contains several isolated fragments.','Chemcraft', mb_ok); bruttoarr.Free; exit; end;


if excluderear then begin curadvmoldata:=TAdvMolData.Create; curadvmoldata.Assign(FMolData); end;


case WhatToDoCombo.ItemIndex of
0:begin
AddFoundItemByBrutto(bruttoarr,false);
end;
1,2:begin//Все осколки этой молекулы
curvariant:=0;
progressshowform.Prepare(1);
if excluderear then AddFoundItemByMolData(curadvmoldata,docheck)
else AddFoundItemByBrutto(bruttoarr,docheck);


if excluderear then curadvmoldata.StartEnumeratingFragments(variantscount)
else bruttoarr.StartEnumeratingFragments(variantscount);
curvariant:=0;
stopped:=false;

repeat
inc(curvariant);
if curvariant mod 100=0 then if ProgressShowForm.outproc(curvariant/variantscount) then break;
if stopped then break;



if excluderear then begin
curfrag:=curadvmoldata.NextEnumFragmentSafe;
enumfinished:=not assigned(curfrag);
end
else begin
curfragbrutto:=bruttoarr.NextEnumFragment;
enumfinished:=not assigned(curfragbrutto);
end;

if enumfinished then break;

if excluderear then AddFoundItemByMolData(curfrag,docheck)
else AddFoundItemByBrutto(curfragbrutto,docheck);


if excluderear then curfrag.Free
else curfragbrutto.Free;

until false;
end;//1
end;//case

bruttoarr.Free;

if assigned(curadvmoldata) then curadvmoldata.Free;


WatchCompsEnabled;

ProgressShowForm.Finish;
end;




procedure TBruttoArrayCompact.StartEnumeratingFragments(out variantscount:int64);
var
q:integer;
prod:int64;
begin
prod:=1;
setlength(FTmpEnumNums,fcount);
for q:=0 to fcount-1 do begin
FTmpEnumNums[q]:=fatoms[q].atcount;
prod:=prod*(fatoms[q].atcount+1);
end;//next
variantscount:=prod;
end;



function TBruttoArrayCompact.NextEnumFragment: TBruttoArrayCompact;
var
cursea:integer;
q:integer;
begin
result:=nil;
cursea:=fcount-1;
repeat
dec(FTmpEnumNums[cursea]);
if FTmpEnumNums[cursea]<0 then begin
FTmpEnumNums[cursea]:=fatoms[cursea].atcount;
dec(cursea);
if cursea<0 then exit;
continue;
end;
break;
until false;

result:=TBruttoArrayCompact.Create;
setlength(result.fAtoms,fcount);
for q:=0 to FCount-1 do result.AddElem(fatoms[q].atomtype,ftmpenumnums[q]);
if result.IsNil then begin result.Free; result:=nil; end;

end;

Сорри за многабукв, но в общем моя функция TBruttoArrayCompact.NextEnumFragment это как ваша GenAll.Next.
Мне кстати было приятно, что выходит не один я использую конструкции вроде if ... then begin result:=true; exit; end; (поместить несколько операторов в одну строку после if).

Здравствуйте, Khimik, Вы писали:

K>Извиняюсь может я туплю, лень думать, но разве это не примерно то же что у меня? Только у меня repeat а у вас while. Зачем тут нужны интерфейсы — я не понял.
Объясняю:
Можно было использовать абстрактный класс вместо интерфейса, но интерфейс в дельфях автоматически самоубивается, когда не нужен. То есть не надо потом вызывать FreeAndNil. Он сам подсчитывает ссылки, так же как и динамические массивы. Что просто позволяет меньше писать, да и удобнее.
while вместо repeat потому как может множество может быть пустым и мы в обработку и не зайдём.
Для чего вынесен абстрактный класс (интерфейс) что бы уменьшить связность. Вы можете передавать его в любой модуль или функцию, не привязываясь к конкретной реализации. Например один и тот же метод может получать как полный перебор, так и частичный или более экзотические варианты с учетом вероятностей разных веток.

K>На всякий случай приведу свой полный код, там много всего, ещё разные дополнительные проверки (может ли существовать такой осколок):
Тут я могу сказать что всегда следует отделять котлеты от мух. Не пишите логику в коде с формами, вынесите её в отдельный модуль (unit).

K>Сорри за многабукв, но в общем моя функция TBruttoArrayCompact.NextEnumFragment это как ваша GenAll.Next.
K>Мне кстати было приятно, что выходит не один я использую конструкции вроде if ... then begin result:=true; exit; end; (поместить несколько операторов в одну строку после if).
Это просто способ компенсировать длинный синтаксис команды. Просто для чтения удобнее когда одно действие не размазано по куче строк. Но на вкус и цвет карандаши разные.

Здравствуйте, kov_serg, Вы писали:

K>>Извиняюсь может я туплю, лень думать, но разве это не примерно то же что у меня? Только у меня repeat а у вас while. Зачем тут нужны интерфейсы — я не понял.
_>Объясняю:
_>Можно было использовать абстрактный класс вместо интерфейса, но интерфейс в дельфях автоматически самоубивается, когда не нужен. То есть не надо потом вызывать FreeAndNil. Он сам подсчитывает ссылки, так же как и динамические массивы. Что просто позволяет меньше писать, да и удобнее.

Меня сейчас чуть смущает: в Delphi интерфейсы это же com, значит лишние сложности и тормоза?

Здравствуйте, Khimik, Вы писали:

K>Меня сейчас чуть смущает: в Delphi интерфейсы это же com, значит лишние сложности и тормоза?
Сложностей нет. Когда будет тормозить профилирование покажет где. Очень сомневаюсь что узким местом будет мехнанизм интерфейсов.
У IUnknown всего 3 метода QueryInterface _AddRef и _Release первый преобразует типы, и два метода увеличить кол-во ссылок и уменьшить на один. Как только кол-во ссылок равно 0 он вызывает деструктор и освобождает память. И delphi под капотом сама расставляет вызовы AddRef и Release.

Если пугают интерфейсы сделайте на абстрактном классе.

...
uses SysUtils;
...

type
  TStateGen=class
    function Next(var state:TState);virtual;abstract;
  end;

  TGenAll=class(TStateGen)
    function Next(var state:TState);override;
    ...

...
  gen:=mkGen(src);
  while gen.Next(item) do begin
    showState(item);
  end;
  FreeAndNil(gen);
...

Здравствуйте, Khimik, Вы писали:

K>Мне несколько раз потребовалось сделать неопределённое множество вложенных циклов. Например такая задача: есть брутто формула молекулы, скажем C6H7N, и надо перебрать все возможные осколки (для масс-спектра). Конкретно для этой молекулы будет три вложенных цикла: семь шагов, восемь шагов и два шага. Сделал примерно так (мой работающий код относительно громоздкий, поэтому написал для наглядности новый и на 100.00% не уверен что он верен):

Нда...
И этот человек метит в губернаторы Лос-Анжелеса...

Здравствуйте, kov_serg, Вы писали:

_>Если пугают интерфейсы сделайте на абстрактном классе.

В вашем примере абстрактный класс нужен, чтобы можно было что-то поправить/добавить? Я пока не вижу в чём это удобно. В моём коде класс есть; рядом есть ещё одна процедура другого класса с похожим функционалом, тоже иерархический перебор, и мне кажется скучно делать базовый код для обоих функций. Иногда код приходится размножать. А алгоритм иерархического перебора не такой уж сложный, в моём первом примере всего 26 строк. Лично мне сейчас кажется проще один раз выучить как это работает, и дальше код можно дублировать.

Здравствуйте, kov_serg, Вы писали:

K>>Меня сейчас чуть смущает: в Delphi интерфейсы это же com, значит лишние сложности и тормоза?
_>Сложностей нет. Когда будет тормозить профилирование покажет где. Очень сомневаюсь что узким местом будет мехнанизм интерфейсов.
_>У IUnknown всего 3 метода QueryInterface _AddRef и _Release первый преобразует типы, и два метода увеличить кол-во ссылок и уменьшить на один. Как только кол-во ссылок равно 0 он вызывает деструктор и освобождает память. И delphi под капотом сама расставляет вызовы AddRef и Release.

_>Если пугают интерфейсы сделайте на абстрактном классе.

Почему всё-таки абстрактном?

Мне потребовалось сделать перебиратор ещё раз, и я решил написать отдельный класс:

type
TEnumeratorItem=record
MaxValue:integer;//У нас от нуля до скажем 1
tmpcurvalue:integer;
end;
TCustomEnumerator=class(TAnyStandardArray<TEnumeratorItem>)
public
constructor Create;
procedure AddItemWithEnumCount(newenumcount:integer);
procedure StartEnumerating;
//(первый nextvar после этой инициализации даст начальный, т.е.
//нулевой элемент, одни нули)
function GetCurVar:tintarray;
function NextVar:tintarray;
//Делает итерацию, если дошёл до конца - возвращает nil
end;

procedure TCustomEnumerator.StartEnumerating;
var
q:integer;
begin
for q:=0 to fcount-2 do fitems[q].tmpcurvalue:=0;

fitems[fcount-1].tmpcurvalue:=-1;
end;

function TCustomEnumerator.NextVar: tintarray;
var
curn:integer;
begin
curn:=FCount-1;
repeat
inc(fitems[curn].tmpcurvalue);
if fitems[curn].tmpcurvalue>fitems[curn].MaxValue then begin
fitems[curn].tmpcurvalue:=0;
dec(curn);
if curn<0 then begin result:=nil; exit; end;
continue;
end
else break;
until false;

result:=GetCurVar;
end;

Здравствуйте, Khimik, Вы писали:

K>Мне несколько раз потребовалось сделать неопределённое множество вложенных циклов.

Может ты для начала отступы освоишь? Нечитаемо же нихрена

K>Мне потребовалось сделать перебиратор ещё раз, и я решил написать отдельный класс:
0Вы проявляете вопиющее неуважение к участникам форума. Лично у меня это отбивает любое желание оказать хоть какую-то помощь.
1. ОТСТУПЫ!
2. На RSDN есть специальный тег для подсветки Паскаля.

Здравствуйте, Sinclair, Вы писали:

K>>Мне потребовалось сделать перебиратор ещё раз, и я решил написать отдельный класс:

S>0Вы проявляете вопиющее неуважение к участникам форума. Лично у меня это отбивает любое желание оказать хоть какую-то помощь.

Ну пожалуйста...

S>1. ОТСТУПЫ!

Я вот пишу без отступов, мне кажется так удобнее. Для логической разбивки кода я использую комментарии вместо отступов, например после разных end-ов пишу //next q и тому подобное. Конечно если устроюсь на работу — придётся переучиваться.

S>2. На RSDN есть специальный тег для подсветки Паскаля.

Ок, исправил.

Здравствуйте, Khimik, Вы писали:

K>Я вот пишу без отступов, мне кажется так удобнее.

Почему все программисты, вообще все, кто хоть что-то полезное и нетривиальное в жизни написал, пишут с отступами?

Здравствуйте, Khimik, Вы писали:

K>Почему всё-таки абстрактном?
Таков путь. Интерфейс описывает интерфейс и не имеет реализации.
Абстрактный значит без реализации, только объявление намерений. Если интересно почему так делают рекомендую подумать и почитать что такое SOLID.

K>Мне потребовалось сделать перебиратор ещё раз, и я решил написать отдельный класс:
Тут вся эта обвязка нужна только для того что бы можно было передать перебиратор, как параметр и он никак не демонстрирует наружу свои особенности реализации.
И можно сделать другой пребиратор который никак не завязан на другие такие же перебираторы, что бы уменьшить связность. Что бы изменения в одном не аукалось в другом.
То что это на паскале выглядит слишком длинно, ну что поделать к этому придётся привыкнуть и всю длинную лапшу выносить в модули.

	От:	Khimik
	Дата:	09.06.24 14:02
	Оценка:

От:	Pzz	https://github.com/alexpevzner
Дата:	09.06.24 15:31
Оценка:	+9

	От:	kov_serg
	Дата:	09.06.24 16:03
	Оценка:	78 (2)

	От:	Khimik
	Дата:	09.06.24 17:20
	Оценка:

	От:	kov_serg
	Дата:	09.06.24 19:43
	Оценка:

От:	Sinclair	https://github.com/evilguest/
Дата:	12.06.24 14:20
Оценка:

	От:	пффф
	Дата:	10.06.24 10:02
	Оценка:

	От:	T4r4sB
	Дата:	11.06.24 17:43
	Оценка:	+3