Множества: загадка-ребус Опции

[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. Но все равно не работает  

[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 !!! тебе огромное спасибо, что хоть в чём мне помог, побольше бы таких людей здесь было, тогда было бы и легче и лучше!!!!!