Сочетания из слов строк , представление заданных строк сочетаниями составляющих их слов

[Barklay]

Цитата сандр @ 20.02.14, 10:37

Видел! - А ссылку на сообщение из другой ветки форума тебе религия дать не позволяла?!!

Там какой-то файл нужен 386.txt

Ты думаешь тут все телепаты?
В конце-концов, это ведь ты просишь о помощи...

[сандр]

Не умею вставлять ссылки

[сандр]

var fi, fo: text;
    s: string;
    a: array [1..110] of Integer;
    b: array [1..111] of string;
    i, j, m, n, c: Integer;
 
procedure Out; {процедура вывода текущего сочетания из слов строки}
 var i: Integer;
 begin
  Write(fo, ' ');
  for i := 1 to n do Write(fo, b[a[i]]);
  WriteLn(fo)
 end;
 
begin
 Write(' Из скольких элементов задать сочетания: n = '); ReadLn(n);
 Assign(fi, 'esum651825.txt'); Reset(fi);
 Assign(fo, 'output.txt'); ReWrite(fo);
 c := 0;
 While not EoF(fi) do
  begin
   Readln(fi, s);
   while s[1] = ' ' do delete(s, 1, 1);
   while Pos('  ', s) > 0 do delete(s, Pos(' ', s), 1);
   while s[Length(s)] = ' ' do delete(s, Length(s), 1);
   s := s + ' ';
   m:=0;
   {WriteLn(fo, s);}
   repeat
    Inc(m);
    b[m] := Copy(s, 1, Pos(' ', s));
    Delete(s, 1, Pos(' ', s));
   until s = '';
   try
    for i := 1 to n do
     a[i] := i;
     repeat
      Out;
      i := n;    
      while (a[i] = m - n + i) do
       dec(i); {поиск элемента для изменения}
       inc(a[i]);    
       for j := i + 1 to n do
        a[j] := a[j - 1] + 1; {изменение правой части сочетания}
     until i = 0;
     inc(c);
   except on e: System.IndexOutOfRangeException do
    writeln(e.Message); else writeln('Какое-то другое исключение');
   end;
  end;
 Close(fi); Close(fo);
 Writeln('   Выполнено');
end.