Версия для печати темы

Автор: Unknown 29.05.2009 1:50

Необходимо найти все такие n1, ..., n10, что n1 + ... + n10 = 100.
Можно перебирать вообще все возможные комбинации n1, ..., n10 и проверять на равенство 100, но наверняка есть способ решить задачу быстрее, только какой?
Если есть готовый код (на любом, наверное, языке) - с удовольствием гляну

Автор: volvo 29.05.2009 2:59

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

procedure Test is
   type arr is array(Positive range <>) of Integer;
   max_parts: constant Integer := 5;
   
   procedure divide(s: in Integer; vals: in out arr;
                    n_parts: in Integer) is
      ok: Boolean;
   begin
      if n_parts = 1 then
         ok := True;
         -- Так отсекаем дубликаты
         for i in 2 .. max_parts - 1 loop
            ok := ok and (vals(i - 1) <= vals(i));
         end loop;
         
         if ok then
            for i in 1 .. max_parts - 1 loop
               Put(Integer'Image(vals(i)) & "+");
            end loop;
            Put_Line(Integer'Image(s));
         end if;
      else
         for i in 1 .. s - 1 loop
            vals(max_parts - n_parts + 1) := i;
            divide(s - i, vals, n_parts - 1);
         end loop;
      end if;
   end;
   
   v: arr(1 .. max_parts);
begin
   New_Line;
   divide(12, v, max_parts); -- Ищем все разложения числа 12 на 5 чисел
end Test;

Автор: sheka 29.05.2009 5:59

program summ;

uses crt;

const
  n=10; //сумма
  k=3;  //количество слогаемых

type
  mas=array [1..k]of integer;

var
  i:integer;
  m:mas;
  c:char;
  a:integer;

procedure razn(var a:integer;var m:mas);
var mm:integer;
begin
mm:=n-(a-1);
for i:=k downto a+1 do mm:=mm-m[i];
if mm<=m[a+1] then m[a]:=mm
else begin m[a]:=m[a+1]; a:=a-1; razn(a,m);end;				   //<=ошибка вот здесь, из-за рекурсии.
end;

procedure rec;
var s:integer;
begin
a:=0;
repeat inc(a);
until (a=k)or(m[a]+1<m[a+1]);
if a=k then begin
  a:=0;
  repeat inc(a);
  until (a>k-1)or(m[a]+1=m[a+1]);
  if (m[a]+1=m[a+1]) then begin
	s:=n-(a-1);
	for i:=1 to a-1 do m[i]:=1;
	for i:=a+1 to k do s:=s-m[i];
	while (s>1) do
	  if m[a]<m[a+1] then begin inc(m[a]); dec(s); end
	  else dec(a);
	end;
  end;

{if a=k then halt;} {kogda budet pravilno rabotat}
writeln('a=',a);for i:=1 to k do write(m[i]:3);writeln; c:=readkey; if c=#27 then halt;

dec(m[a+1]);
razn(a,m);
for i:=1 to a-1 do m[i]:=1;
rec;
end;

begin
clrscr;
for i:=1 to k-1 do m[i]:=1;
m[k]:=n-k+1;
for i:=1 to k do write(m[i]:3);writeln;writeln('a=',a); c:=readkey; if c=#27 then halt;
rec;

end.
 

Автор: Lapp 29.05.2009 8:27

Рекурсия - это тот же перебор, только иначе записанный. Думается, вряд ли тут можно придумать что-то еще..

Автор: Unknown 4.06.2009 21:38

А формулу для подсчета общего количества возможных вариантов разложения кто-нить может подсказать?
volvo, это то, что надо! спасибо! только вот 100 на десять слагаемых больно долго раскладывает...

Автор: volvo 4.06.2009 22:32