Господа прошу у вас помощи!!! У меня не получается сделать две задачи по теме "Множества".. Вот они:
Program Example_Set_5;
Uses Crt;
Type
mn = Set of 0..9;
Var
m, y, x, a: 0..9; { цифры числа МУХА }
count, { счетчик числа найденных решений }
n1, n2: Integer; { числа МУХА и СЛОН }
a1, a2, a3, a4: 0..9; { цифры числа CЛOH }
s1, s2: mn; { для хранения цифр каждого из чисел }
Procedure Print( x, y: Integer); { вывод решения в виде ребуса }
begin
Inc(count);
writeln(count,':');
Writeln( x: 5 );
Writeln('+');
Writeln( x: 5 );
Writeln('-------');
Writeln( y:5 );
writeln;
readkey; { Остановка для просмотра всех решений }
end;
Begin
ClrScr;
count := 0;
s1 := []; s2 := [];
for m := 1 to 4 do begin
s1:=s1 + [m]; { заносим первую использованную цифрру }
for y:=0 to 9 do
{ если эта цифра не была еще взята, то добаеляем ее во множество
цифр числа МУХА и выбираем цифру для следующей буквы }
if not (y in s1) then begin
s1 := s1 + [y];
for x := 0 to 9 do
if not (x in s1) then begin
s1 := s1 + [x];
for a:=1 to 9 do
if not (a in s1) then begin
s1 := s1 + [a];
n1:=1000*m+100*y+10*x+a; { число для слова МУХА }
n2 := 2*n1; { число для слова СЛОН }
a1:=n2 div 1000; { выделяем цифры СЛОНа }
a2:=n2 div 100 mod 10;
a3:=n2 div 10 mod 10;
a4:=n2 mod 10;
s2:=[a1,a2,a3,a4]; {множество цифр СЛОНа}
{ если слова состаят из разных цифр
и в слове СЛОН нет одинаковых, то
вывыводим решнение ребуса на экран }
if (s1 * s2 = []) and ([a1]*[a2] = [])
and ([a1]*[a3] = []) and ([a1]*[a4] = [])
and ([a2]*[a3] = []) and ([a2]*[a4] = [])
and ([a3]*[a4] = []) then Print(n1, n2);
s1 := s1 - [a]; { удаляем занесенную цифру }
end;
s1 := s1 - [x];
end;
s1 := s1 - [y];
end;
s1 := s1 - [m];
end;
Writeln('Всего найдено ', count, ' решения. Нажмите Enter ... ');
Readln;
End.
Первая задача (по крайней мере, первая ее часть) выглядит примерно так:
var vhod, printed : set of char;
s : string;
i : integer;
begin vhod:=[]; printed:=[];
readLn(s);
for i:=1 to length(s) do
if not (s[i] in vhod) then vhod:=vhod + [s[i]]
else
if not (s[i] in printed) then begin
printed := printed + [s[i]];
writeLn(s[i])
end;
end.
for b:=1 to 9 do
for a:=0 to 9 do
for r:=0 to 9 do
for o:=0 to 9 do
for s:=0 to 9 do
for i:=0 to 9 do
for k:=0 to 9 do {ой, мама... 7 циклов... : )}
if (100000*b+10000*a+1000*r+100*b+10*o+s) {BARBOS}
+
(10000*b+1000*o+100*b+10*i+k) {BOBIK}
=
(100000*s+10000*o+1000*b+100*a+10*k+i) {SOBAKI}
then print(b,a,r,o,s,i,k) {Вывести решение}
Да нет как раз то дело состоит в том что каждой букве соответствует своя цифра, каждая буква представляется в виде одной единственной цифры...
само решение должно быть таким (их два):
{745718+71702=817420;
754728+72791=827519;
barbos+bobik=sobaki;
таким образом сами цифры складываются по арифметически....}
вот как я пробую её решить, но увы ничего не выходит, может найдёте ошибку, посмотрите.........
Program barbos+bobik=sobaki;
var
b,a,r,o,s,k,i : 0..9;
dig : set of 0..9;
sobaki : word;
sum : word;
begin
for b:=5 to 9 do
include(dig,b);
for a:=3 to 9 do
if not (a in dig) then begin
include(dig,a);
for r:=3 to 9 do
if not (r in dig) then begin
include(dig,r);
for o:=1 to 9 do
if not (o in dig) then begin
include(dig,o);
for s:=7 to 9 do
if not (s in dig) then begin
include(dig,s);
for k:=1 to 9 do
if not (k in dig) then begin
include(dig,k);
for i:=1 to 9 do
if not (i in dig) then begin
include(dig,i);
sum:=(b)*100000+(a+b)*10000+(r+o)*1000+(2*b)*100+(o+i)*10+(s+k);
sobaki:=s*100000+o*10000+b*1000+a*100+k*10+i;
if sum=sobaki then begin
writeln(b,a,r,b,o,s,'+',b,o,b,i,k,'=',s,o,b,a,k,i);
exclude(dig,i);
end;
exclude(dig,k);
end;
exclude(dig,s);
end;
exclude(dig,o);
end;
exclude(dig,r);
end;
exclude(dig,a);
end;
exclude(dig,b);
end;
end.
Да, я уже понял, что дело в том, что каждой букве соответствует одна цифра. Плюс в той программе, которая решает МУХА+МУХА=СЛОН, учитывается, что 1<=М<=4. А то, что написАл я, никуда не годится. Сейчас (или завтра...) попробую написАть что-то такое же.
После первого for'a begin надо... но все равно не работает. Усиленно думаем
Еще в word не влезает, sobaki и sum описАл ка longint. Но все равно не работает
Ещё какая собака, ну ладно я завтра зайду, а пока сам подумаю, блин вот задачка попалась....Я думаю что всё дело в разном кол-ве цифр в словах : барбос и бобик...
Надо как-нибудь подругому написать....может что-то добавить и т.д. ну лады до завтра.......
У тебя немного "сдвинулись" include'ы и exclude'ы. Попробовал их "подвинуть", запутался... ИМХО проще переписАть, чем я, пожалуй, вечером и займусь
Или, может, уже и не надо?
ЗЫ А может, и не сдвинулись... Но все равно попробую переписАть.
Давай вечерком попробубуем, но мне кажется дело не в инкл и экскл..там чего-то другое, даже если их поставить на место она всё равно не прёт...
Ну что там как дела??? ты мне ещё не расхотел помочь, в общем я немного допетрился и понял что дело всё вот в этой строке sum:=(B)*100000+(a+B)*10000+(r+o)*1000+(2*B)*100+(o+i)*10+(s+k); она неправильна, потому что выдаёт глюк, который к сожалению я не могу найти!!! попробуй в циклах поставить такие значения for b:=7 to 7 do, for a:=5 to 5, короче методом от противного, аналогично r=4,j=2,s=8,i=9,k=1, т.е это числа из решения 754728+72791=827519........
далее я пробую вывести на экран числовое значение sobaki write(sobaki), получаю 827519, а вот к сожалению с sum проблемы но ведь тоже получится должно 827519, а получается совсем другое число 41087........ в общем сам посмотри
Program ryr;
uses crt;
var
b,a,r,o,s,k,i : 0..9;
dig : set of 0..9;
sobaki : longint;
sum,sum1 : word;
begin
clrscr;
for b:=7 to 7 do begin
include(dig,b);
for a:=5 to 5 do
if not (a in dig) then begin
include(dig,a);
for o:=2 to 2 do
if not (o in dig) then begin
include(dig,o);
for s:=8 to 8 do
if not (s in dig) then begin
include(dig,s);
for k:=1 to 1 do
if not (k in dig) then begin
include(dig,k);
for i:=9 to 9 do
if not (i in dig) then begin
include(dig,i);
for r:=4 to 4 do
if not (r in dig) then begin
include(dig,r);
sum:=b*100000+(a+b)*10000+(r+o)*1000+(2*b)*100+(o+i)*10+s+k;writeln(sum);
sobaki:=s*100000+o*10000+b*1000+a*100+k*10+i; writeln(sobaki);
if (sum<>sobaki) then writeln(b,a,r,b,o,s,'+',b,o,b,i,k,'=',s,o,b,a,k,i);
exclude(dig,r);
end;
exclude(dig,i);
end;
exclude(dig,k);
end;
exclude(dig,s);
end;
exclude(dig,o);
end;
exclude(dig,a);
end;
exclude(dig,b);
end;
end.
Эх блин!!! Ещё один день убит зря!!! Вот так всегда!!! Ни*рена у меня ничего не получается!!!!
Нус господа!!! от вас особой помощи я не добился, пришлось решать самому, и доходить до сути этого грёбаного ребуса, а ведь я его решил!!! Если комуто надо, держите:
Program lab7_02_3;
uses crt;
var
b,a,r,o,s,k,i : 0..9;
dig : set of 0..9;
sobaki : longint;
sum,g,w : longint;
begin
clrscr;
for b:=0 to 9 do begin
include(dig,b);
for a:=0 to 9 do
if not (a in dig) then begin
include(dig,a);
for o:=0 to 9 do
if not (o in dig) then begin
include(dig,o);
for s:=0 to 9 do
if not (s in dig) then begin
include(dig,s);
for k:=0 to 9 do
if not (k in dig) then begin
include(dig,k);
for i:=0 to 9 do
if not (i in dig) then begin
include(dig,i);
for r:=0 to 9 do
if not (r in dig) then begin
include(dig,r);
g:=100; w:=100;
sum:=b*1000*g+(a+b)*100*w+(r+o)*1000+(b+b)*100+(o+i)*10+s+k;
sobaki:=s*100000+o*10000+b*1000+a*100+k*10+i;
if (sum=sobaki) then writeln('Ў аЎ®б+Ў®ЎЁЄ=б®Ў ЄЁ: ',b,a,r,b,o,s,'+',b,o,b,i,k,'=',s,o,b,a,k,i);
exclude(dig,r);
end;
exclude(dig,i);
end;
exclude(dig,k);
end;
exclude(dig,s);
end;
exclude(dig,o);
end;
exclude(dig,a);
end;
exclude(dig,b);
end;
end.