Помощь - Поиск - Пользователи - Календарь
Полная версия: Множества: загадка-ребус
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Amro
Господа прошу у вас помощи!!! У меня не получается сделать две задачи по теме "Множества".. Вот они:
  • Дан текст из строчных латинских букв, за которыми следует точка. Напечатать все буквы, входящие в текст не менее двух раз; все согласные буквы входящие только в одно слово.
  • Разгадайте ребус: БАРБОС + БОБИК = СОБАКИ.
В первой я не понимаю, как можно удвоить каждую букву входящую во множество...
Вторая вообще полный ужас, у меня есть даже наподобие ребусы, вот решение одного из них: "муха + муха = слон"
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.

В принципе решение этой задачи до меня дошло, но здесь на самом деле просто, потому что складываются два одинаковых слова.......это элементарно, если хорошо разобраться, но вот если слова разные то до меня не доходит как написать программу, помогите пожалуйста кто может.......
trminator
Первая задача (по крайней мере, первая ее часть) выглядит примерно так:

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) {Вывести решение}


А что тут программа делает, я не совсем понял... Вечером посмотрю, может, въеду.

На будущее: заключай текст программы в теги [ code ]...[ / code ] (без пробелов)
Amro
Да нет как раз то дело состоит в том что каждой букве соответствует своя цифра,  каждая буква представляется в виде одной единственной цифры...
само решение должно быть таким (их два):

{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.

trminator
Да, я уже понял, что дело в том, что каждой букве соответствует одна цифра. Плюс в той программе, которая решает МУХА+МУХА=СЛОН, учитывается, что 1<=М<=4. А то, что написАл я, никуда не годится. Сейчас (или завтра...) попробую написАть что-то такое же.
trminator
После первого for'a begin надо... но все равно не работает. Усиленно думаем

Еще в word не влезает, sobaki и sum описАл ка longint. Но все равно не работает   sad.gif
Amro
Ещё какая собака, ну ладно я завтра зайду, а пока сам подумаю, блин вот задачка попалась....Я думаю что всё дело в разном кол-ве цифр в словах : барбос и бобик...
Надо как-нибудь подругому написать....может что-то добавить и т.д. ну лады до завтра.......
trminator
У тебя немного "сдвинулись" include'ы и exclude'ы. Попробовал их "подвинуть", запутался... ИМХО проще переписАть, чем я, пожалуй, вечером и займусь

Или, может, уже и не надо?

ЗЫ А может, и не сдвинулись... Но все равно попробую переписАть.
Amro
Давай вечерком попробубуем, но мне кажется дело не в инкл и экскл..там чего-то другое, даже если их поставить на место она всё равно не прёт...
Amro
Ну что там как дела??? ты мне ещё не расхотел помочь, в общем я немного допетрился и понял что дело всё вот в этой строке 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.


Кстати тут я специально заменил if sum=sobaki на if sum<>sobaki, чтоб увидеть неверное решение  754728+72791=827519.............
Посмотри пожалуйста!!!! Блин завтра вечером уже здавать, а мне обязательно надо сдать, а то к экзамену не допустят!!!!
Amro
Эх блин!!! Ещё один день убит зря!!! Вот так всегда!!! Ни*рена у меня ничего не получается!!!!
Amro
Нус господа!!! от вас особой помощи я не добился, пришлось решать самому, и доходить до сути этого грёбаного ребуса, а ведь я его решил!!! Если комуто надо, держите:

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.


Вот такая вот штука....
trminator !!! тебе огромное спасибо, что хоть в чём мне помог, побольше бы таких людей здесь было, тогда было бы и легче и лучше!!!!!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.