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

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

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

 
 Ответить  Открыть новую тему 
> Задача на алгоритм полного перебора
сообщение
Сообщение #1





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

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


Необходимо найти четырехзначное число, кратное 2, 7 и 11, причем оно записывается только из 2-х цифр(например 1122), и сумма его цифр должна быть равна 30. Написал, но Паскаль не выводит никакакого ответа, хотя ответ есть, это число 8778. Подскажите, что не так

Program qa;
type CI=1000..9999;
var a:CI;
q,w,e,r:integer;

function SumaC(a:integer):integer;
var suma: integer;
begin
suma:=0;
repeat
suma:=suma+(a mod 10);
a:=a div 10;
until a=0;
SumaC:=suma;
end;

function Uslovie (a:CI):boolean;
begin
for a:=1000 to 9999 do
begin
if (a mod 2=0) and (a mod 7=0) and (a mod 11=0)
then Uslovie:=true
else Uslovie:=false;
end;
end;

function Resh(a:CI):boolean;
begin
q:=a div 1000;
w:=(a mod 1000) div 100;
e:=(a mod 100) div 10;
r:=a mod 10;

if (SumaC(a)=30) and (q=w) and (e=r) or
(SumaC(a)=30) and (q=e) and (w=r) or
(SumaC(a)=30) and (q=r) and (w=e)


then Resh:=true
else Resh:=false;
end;

begin
for a:=1000 to 9999 do
if Resh(a) and Uslovie(a) then writeln ('a=', a);
readln;
end.









Сообщение отредактировано: Apmeм -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Знаток
****

Группа: Пользователи
Сообщений: 481
Пол: Мужской
Реальное имя: Федосеев Павел

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


С учётом замечания volvo можно сделать так
program test;

var
i: integer;
N: integer;
Count, Summa, Digit: integer;
DigitsSet: set of byte;
begin
for i := 1000 div (2 * 7 * 11) to 9999 div (2 * 7 * 11) do
begin
N := i * 2 * 7 * 11;
if N < 1000 then
continue;
DigitsSet := [];
Count := 0;
Summa := 0;
while N <> 0 do
begin
Digit := N mod 10;
N := N div 10;
if not (Digit in DigitsSet) then
Inc(Count);
include(DigitsSet, Digit);
Summa := Summa + Digit;
end;
if (Summa = 30) and (Count = 2) then
writeln(i * 2 * 7 * 11);
end;
end.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 28.03.2024 19:23
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name