Составте программу вычисления суммы квадратов составных чисел, лежащих в интервале (m,2m-1).Решить с использованием процедуры.

Составте программу вычисления суммы квадратов составных чисел, лежащих в интервале (m,2m-1). Решите пожалуйста с использованием процедуры.
4 ответа

var
  Summa: Longint;
  m: Integer;
 
procedure SqrSumma(m: Integer);
var
  i: Longint;
begin
  Summa:=0;
  for i:=m to (2*m-1) do
    Summa:=Summa + sqr(i);
  writeln('Сумма в интервале [', m, ', ', 2*m-1, ']: ', Summa);
end;
 
begin
  write('M: ');
  readln(m);
  SqrSumma(m);
end.


uses crt;
var i,j,k,m,sum: integer;
begin
 clrscr;
 write('m: ');
 readln(m);
 writeln('Интервал: [',m,';',2*m-1,']');
 for i:=m to 2*m-1 do
  begin
   k:=0;
   for j:=2 to round(sqrt(i)) do
    if (i mod j)=0 then
    k:=k+1;
    if k<>0 then
     begin
      sum:=sum+(sqr(i));
      write(i,' ');
     end;
   end;
  writeln('Сумма = ',sum);
 readln;
end.
Хотя, нет, что-то у меня не так У меня 9 выводит при вводе m=5, в википедии такого нет Ev[G]eN, у Вас все подряд суммирует UPD: все правильно, это в википедии они просто нагло 9 пропустили)


for i:=m to (2*m-1) do Summa:=Summa + sqr(i);
В задании сказано составные числа. Поэтому
for i:=m to 2*m-1 do 
 begin
 bool:=true;
 for j:=2 to i-1 do
  if i mod j = 0 then bool:=false;
 if bool = false then summa:=summa + sqr(i);
 end;
Мда. Написала, перечитала, протерла глаза, перечитала, офигела)) Оказывается уже исправили)
uses crt;
 
var
m: integer;
 
{--------------------------------------------------------------------}
function sostavnoe(a: integer): boolean;
var i: integer;
begin sostavnoe:=false;
for i:=2 to a div 2 do
 if a mod i = 0 then
  begin
  sostavnoe:=true;
  exit;
  end;
end;
{--------------------------------------------------------------------}
function summa(m: integer): integer;
var i: integer;
begin summa:=0;
for i:=m to m*2-1 do
 if sostavnoe(i) then inc(summa,sqr(i));
end;
{--------------------------------------------------------------------}
 
 
begin clrscr;
write('m = '); readln(m);
writeln('Summa = ',summa(m));
readkey; end.


Вот с процедурой:
uses crt;
var m,sum: integer;
 
procedure Sost(m:integer; var sum: integer);
var i,j,k: integer;
begin
 for i:=m to 2*m-1 do
  begin
   k:=0;
   for j:=2 to round(sqrt(i)) do
    if (i mod j)=0 then
    k:=k+1;
    if k<>0 then
     begin
      sum:=sum+(sqr(i));
      write(i,' ');
     end;
   end;
end;
 
begin
 clrscr;
 write('m: ');
 readln(m);
 writeln('Интервал: [',m,';',2*m-1,']');
 sost(m,sum);
 writeln('Сумма = ',sum);
 readln;
end.