IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Задачка про Хемминга, в поиске лазил-там другое
patriotru
сообщение 11.12.2005 16:03
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


Задание:Последовательность Хемминга образуют натуральные числа,не имеющие других простых делителей,кроме 2,3,5.Найти:Сумму всех элементов с номера N по номер M.(например вводишь
N=20,M=300,прога находит числа Хемминга в заданном промежутке и считает их сумму)
Прогу уже как только не переписывал-не считает и всё тутsad.gifХотя алгоритм вроде правильный
Вариант1:
Код
program hemmingnew;
uses crt;
label konec;
var N,M,a,i,j,z,S:integer;
begin
clrscr;
writeln ('vvesti N i M');
readln (N,M);
if N>M then
begin
a:=M;
M:=N;
N:=a;
end;
writeln ('diapozon chisel ot ',N,' do ',M);
for i:=N to M do
begin
     if (N mod 2=0) and (N mod 3=0) and (N mod 5=0) then
    begin
     for j:=7 to N-1 do
     begin
     for z:=2 to j-1 do if (j mod z =0) then goto konec;
      if (N mod j=0) then goto konec;
      writeln ('podxodiashee,N=',N);
      S:=S+N;
      end;
    end;
    konec:
    end;
writeln ('S=',S);
readkey;
end.

***************************************************************************
Вариант2:
Код
program hemmiksa;
uses crt;
label delenie,konec;
var M,N,S,i,a,j:integer;
begin
clrscr;
S:=0;
writeln ('vvesti N');
readln (N);
writeln ('vvesti M');
readln (M);
if N>M then
   begin
      a:=M;
       M:=N;
        N:=a;
              end;
writeln (' N=',N);
  for N:=N to M do
  begin
          if (N mod 2=0) and (N mod 3=0) and (N mod 5=0) then
        begin
             for i:=7 to N do
             begin
             for j:=2 to i do
             begin
             if (i mod j=0) then goto delenie;
             end;
             if (N mod i=0) then goto konec else
             begin
             writeln ('nashelsia element');
             S:=S+N;
             writeln ('nedeliashiisia element N=',N);
             end;
             delenie:
             end;
        end;
  konec:
  n:=n+1;
  end;
writeln ('S=',S);
end.

Вобщем проверьте чего тут не так,плиз unsure.gif

Сообщение отредактировано: patriotru - 11.12.2005 16:16
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
patriotru
сообщение 12.12.2005 5:39
Сообщение #2





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


Чего,никто не знает?Никто не поможет??? mad.gif norespect.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 12.12.2005 9:21
Сообщение #3


Гость






Цитата
Чего,никто не знает?

Ну, почему же "не знает"?
Вот так, например, можно найти сумму чисел Хэмминга в заданном интервале:
uses Crt;

var
N, M, a, i, j, Sj, Count_Call : Integer;
Sum: LongInt;

procedure simple_number(sn: Integer);
var
x : integer;

begin
x := 2; i := 1;
while (x < sn) and (i = 1) do begin

if (sn mod x) = 0 then i := 0 else inc(x);

end;
end;

begin
ClrScr;
Write('start (M) = '); ReadLn(M);
Write('finish (N) = '); ReadLn(N);

a := 1;
Sj := 0; Count_Call := 0;

while A <= N do begin

for j := 2 to a do begin

if a mod j = 0 then Simple_number(j)
else i := 0;

if i = 1 then begin
Sj := Sj + j;
inc(Count_Call);
end;

end;

if (Sj = 10) and (Count_Call = 3) then begin

if (A >= M) and (A <= N) then Sum := Sum + a;

end;

Sj := 0;
Count_Call := 0;

Inc(a);
end;

WriteLn('S = ', Sum);
ReadLn;
end.
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 19.07.2025 11:14
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"