Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.03.2008, 12:51   #11
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Да уж как не поможет! Осталось добавить несколько букв и все работает, по крайней мере на тех числах, которые я проверил.
Код:
uses crt;
var n,t,a,b,c,s:longint;
begin
clrscr;
  readln(n);
  t:=round(int(sqrt(n)));
  s:=0;
  if t*t=n then
     begin
       s:=1;
       writeln(t*t);
     end;
if s=0 then
  for a:=t downto 1 do
    begin
      for b:=1 to a do
      if a*a+b*b=n then
        begin
          s:=2;
          writeln(a*a);
          writeln(b*b);
          break;
        end;
      if s=2 then break;
    end;

if s=0 then
  for a:=t downto 1 do
    begin
      for b:=1 to a do
        begin
          for c:=1 to b do
            if a*a+b*b+c*c=n then
              begin
                s:=3;
                writeln(a*a);
                writeln(b*b);
                writeln(c*c);
                break;
              end;
          if s=3 then break;
        end;
      if s=3 then break;
    end;
if s=0 then s:=4;
  writeln('kol slag=',s);
readln
end.
puporev вне форума Ответить с цитированием
Старый 11.03.2008, 13:19   #12
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

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

А если добавить еще один цикл, то сколько считаться будет, например, для 10 000 002, для которого я приводил ответ ?
alexBlack вне форума Ответить с цитированием
Старый 11.03.2008, 14:42   #13
Plague
Забанен
Форумчанин Подтвердите свой е-майл
 
Аватар для Plague
 
Регистрация: 01.11.2006
Сообщений: 420
По умолчанию

Цитата:
Задача: разбить введенное число на сумму таких чисел, из которых вычесляется квадратный корень, причем количество чисел дожно быть наименьшим.
минимальным!
Пограмма мной предложенная это находит.

А решение для 10 000 002 нашлось добовлением в программу пару строк за 0.4 секунды.
Если ничто другое не помогает, прочтите, наконец, инструкцию! Аксиома Кана
Plague вне форума Ответить с цитированием
Старый 11.03.2008, 15:44   #14
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

В коде, который я привел с подачи Plague выводятся числа разложения и их количество.
puporev вне форума Ответить с цитированием
Старый 11.03.2008, 23:51   #15
B_N
Новичок
Джуниор
 
Регистрация: 18.01.2008
Сообщений: 1,720
По умолчанию

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

Код:
uses
    sysutils, crt;
var
    squares                 : array [ 1 .. 65536 ] of cardinal;
    N                       : cardinal;
    i1, i2, i3, i4          : cardinal;
	total					: cardinal;
	OnlyFirst				: boolean;

function Breakdown1 : cardinal;
begin
	result := 0;
	writeln;
	writeln('---- Sum of ONE ---- START ----');
    for i1 := trunc(sqrt(N)) downto 1 do begin
        if ( squares [i1] = N ) then begin
			result := result + 1;
			writeln(format('N = %d = sqr(%d) = %d', [ N, i1, squares[i1] ]));
			if(OnlyFirst) then exit;
        end;
    end;
	writeln('---- Sum of ONE ---- END ---- Total : ', result);
end;

function Breakdown2 : cardinal;
begin
	result := 0;
	writeln;
	writeln('---- Sum of TWO ---- START ----');
    for i1 := trunc(sqrt(N)) downto 1 do begin
		for i2 := trunc(sqrt(N - squares[i1])) downto 1 do begin
			if ( squares [i1] + squares[i2] = N ) then begin
				result := result + 1;
				writeln(format('N = %d = sqr(%d) + sqr(%d) = %d + %d',
					[ N, i1, i2, squares[i1], squares[i2] ]));
				if(OnlyFirst) then exit;
            end;
        end;
    end;
	writeln('---- Sum of TWO ---- END ---- Total : ', result);
end;

function Breakdown3 : cardinal;
begin
	result := 0;
	writeln;
	writeln('---- Sum of THREE ---- START ----');
    for i1 := trunc(sqrt(N)) downto 1 do begin
		for i2 := trunc(sqrt(N - squares[i1])) downto 1 do begin
			for i3 := trunc(sqrt(N - squares[i1] - squares[i2])) downto 1 do begin
				if ( squares [i1] + squares[i2] + squares[i3] = N ) then begin
					result := result + 1;
					writeln(format('N = %d = sqr(%d) + sqr(%d) + sqr(%d) = %d + %d + %d',
						[ N, i1, i2, i3, squares[i1], squares[i2], squares[i3] ]));
					if(OnlyFirst) then exit;
				end;
            end;
        end;
    end;
	writeln('---- Sum of THREE ---- END ---- Total : ', result);
end;

function BreakDown4 : cardinal;
begin
	result := 0;
	writeln;
	writeln('---- Sum of FOUR ---- START ----');
    for i1 := trunc(sqrt(N)) downto 1 do begin
		for i2 := trunc(sqrt(N - squares[i1])) downto 1 do begin
			for i3 := trunc(sqrt(N - squares[i1] - squares[i2])) downto 1 do begin
				for i4 := trunc(sqrt(N - squares[i1] - squares[i2] - squares[i4] )) downto 1 do begin
					if ( squares [i1] + squares[i2] + squares[i3] + squares[i4] = N ) then begin
						result := result + 1;
						writeln(format('N = %d = sqr(%d) + sqr(%d) + sqr(%d) + sqr(%d) = %d + %d + %d + %d',
							[ N, i1, i2, i3, i4, squares[i1], squares[i2], squares[i3], squares[i4] ]));
						if(OnlyFirst) then exit;
					end;
				end;
			end;
		end;
    end;
	writeln('---- Sum of FOUR ---- END ---- Total : ', result);
end;

begin
    for i1 := 1 to 65536 do squares[i1] := i1 * i1;

	write('Only first? (Y/N) ');
	i1 := ord(readkey);
	OnlyFirst := (i1 = ord('Y')) or (i1 = ord('y'));
	writeln;
	
	repeat
		write ('Enter N: '); readln(N);
{
    if BreakDown1 = 0 then
    if BreakDown2 = 0 then
    if BreakDown3= 0 then
    if BreakDown4 = 0 then;
}
		total := BreakDown1 + BreakDown2 + BreakDown3 + BreakDown4;

		writeln(format('N = %d, Breakdowns total: %d',[N, total]));
		writeln('Press escape to quit or any other key to repeat');
	until readkey = #27;
	writeln;
end.

Последний раз редактировалось B_N; 12.03.2008 в 01:15.
B_N вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Qu 1.0 - программа для решения квадратных уравнений DM_bite Софт 5 20.03.2010 22:37
Сравнение 2-ух квадратных матриц размер 3*3 Artem1987 Помощь студентам 2 23.03.2008 16:16
Три квадратных уравнения. Найти минимальное значение среди действительных корней этих уравнений. Паскаль. GE076 Помощь студентам 2 17.12.2007 20:41
5 задач Wander Помощь студентам 17 01.06.2007 09:17