Замок для сейфа состоит из 10 расположенных в ряд ячеек c игральными кубиками. Сумма любых трёх равна 10. Найти код (на Паскале)

[Mainak]

Может дадите еще значений?)
6,6,1,4 теперь работают

[Mainak]

На этот раз код побольше, приложил отдельным файлом.

[ViktorR]

Вчера решил блеснуть, но было поздновато, а сегодня ...
В общем мое решение, навеянное постом от evg_m такое:

var a : array[0..9] of integer;
    mn, kn, i : integer;
    fl : boolean;
 begin
    randomize;
    {Готовим исходные данные}
    mn := random(10);
    a[mn] := random(6) + 1;
    repeat
       kn := random(10);
    until (mn <> kn);
    a[kn] := random(6) + 1;

    {Случай, когда решения НЕТ!}
    if ((((mn MOD 3) = (kn MOD 3)) AND (a[mn] <> a[kn]))
       OR (((mn MOD 3) <> (kn MOD 3)) AND ((a[mn] + a[kn]) >= 10))) then
       begin
         writeln('Resheniya NET!');
         readln;
         exit;
       end;

    {Случай, когда решений МНОГО!}
    if (((mn MOD 3) = (kn MOD 3)) AND (a[mn] = a[kn])) then
    begin
       fl := true;
       for i := 0 to 9 do
          if ((i MOD 3) = (mn MOD 3)) then
             write(' ',a[mn])
          else
             if fl then begin
                write(' A');
                fl := NOT fl;
             end
             else begin
                write(' B');
                fl := NOT fl;
             end;
       writeln;
       writeln(' Gde A + B = ', 10 - a[mn]);
       readln;
       Exit;
     end;

     {Случай единственного решения!}
      if (((mn MOD 3) <> (kn MOD 3)) AND (a[mn] + a[kn] < 10)) then
      begin
         for i := 0 to 9 do begin
            if ((i MOD 3) = (mn MOD 3)) then
               a[i] := a[mn];
            if ((i MOD 3) = (kn MOD 3)) then
               a[i] := a[kn];
            if (((i MOD 3) <> (mn MOD 3)) AND ((i MOD 3) <> (kn mod 3))) then
               a[i] := 10 - a[mn] - a[kn];
         end;
         for i := 0 to 9 do
            write('  ',a[i]);
         writeln;
      end;
    readln;
end.

Без оптимизаций, в лобббб...


Как-то так, ...

[SaLoKiN]

код Mainak. что бы видеть.

    uses crt;
    Var a: array [1..10] of byte;
           i,x,y,z, pos1, pos2: byte;
    Begin
    clrscr;
    ReadLn(x,y);
    Readln(pos1, pos2);
    if (x>6) or (y>6) or (x<0) or (x<0) then 
                                                              WriteLn('Кубика с такой гранью нет.')
    else
    if (abs(pos1-pos2)=1) and (x+y>9) then 
                                                              Writeln('Код из цифр в такой позиции не существует.')
    else
    if (pos1<=0) or (pos2<=0) or (pos1>10) or (pos2>10) then
                                                                                             WriteLn('Адрес ячейки неверен.')
    else
    if pos1=pos2 then 
                          WriteLn('Цифры не могут быть в одной ячейке.')
    else
    if (x<>y) and (pos1 mod 3 = pos2 mod 3) then
                                                                         Writeln('Код из цифр в такой позиции не существует.')
    else
    begin
    if x=y then begin
                       a[pos1 mod 3]:=x;
                       y:=random(2)+1;
                       z:=10-x-y;
    case pos1 mod 3 of 
    1:begin
    For i:=1 to 10 do
                         case i of
                          1,4,7,10: a[i]:=x;
                          2,5,8: a[i]:=y;
                          3,6,9: a[i]:=z;
                          end;
        end;
    2:begin
    for i:=1 to 10 do
                          case i of
                           1,4,7,10: a[i]:=y;
                           2,5,8:      a[i]:=x;
                           3,6,9:      a[i]:=z;
                           end;
        end;
    3:begin
    for i:=1 to 10 do
                          case i of
                           1,4,7,10: a[i]:=y;
                           2,5,8:      a[i]:=z;
                           3,6,9:      a[i]:=x;
                           end;
       end;
    end;
    end
    else begin
            z:=10-x-y;
            For i:=1 to 10 do a[i]:=z;
            a[pos1 mod 3]:=x;
            a[pos2 mod 3]:=y;
            For i:=3 to 10 do a[i]:=10-a[i-1]-a[i-2];
           end;
For i:=1 to 10 do Write(a[i]:3);
end;
readln;
end.

else
    if (abs(pos1-pos2)=1) and (x+y>9) then

для чего "abs(pos1-pos2)=1)"? И зачем вам else. не проще ли просто завершать программу? вместо того чтобы тянуть их до конца и потом париться с begin-end?

to ViktorR
ваша программа нагенерила =))

1 2 7 1 2 7 1 2 7 1

[ViktorR]

SaLoKiN

ваша программа нагенерила =))
1 2 7 1 2 7 1 2 7 1

Во блин. Упустил еще одно условие, что если два начальных значения для кубиков будут в диапазоне 1 .. 2, то решения так же нет.

if ((((mn MOD 3) = (kn MOD 3)) AND (a[mn] <> a[kn]))
       OR (((mn MOD 3) <> (kn MOD 3)) AND (((a[mn] + a[kn]) >= 10) OR ((a[mn] + a[kn]) < 4)))) then
...

Жаль, ...

[SaLoKiN]

просто, если бы скажем ввод был бы с клавиатуры - то с проверкой было бы попроще)
или нет... вообщем уже баловством занимаемся. только вот аффтар пропал)

[Алёнка ))]

В общем долго над этой задачей думала, спасибо всем, а вот и код на паскале

const n=10;
var c:array [1..n] of integer;
i,b,a,d,x,y:integer;
begin
writeln (‘введи номера ячеек');
readln (a,b);
writeln (‘введи числа’);
readln (x,y);
c[a]:=x; c[b]:=y;
if a=b then exit;
if (b=a+1) or (b=a+2) or (x=y) then
    if (x+y<4) or (x+y>=10) then exit;
if (a>n) or (b>n) or (x>6) or (y>6) then exit;
if ((b-a) mod 3=1) and (b<>a+1) then c[a+1]:=c[b];
if ((b-a) mod 3=2) or (b=a+2) then c[a+1]:=10-c[a]-c[b];
if ((b-a) mod 3=0) and (x=y) then begin
   d:=10-x;
   if d<=6 then c[a+1]:=random(d-1)+1
	else c[a+1]:=random(5)+2;
if ((b-a) mod 3<>0) or (x=y) then begin
   for i:=(a-1) downto 1 do
   c[i]:=10-c[i+1]-c[i+2];
   for i:=a+2 to b-1 do
   c[i]:=10-c[i-1]-c[i-2];
   for i:=(b+1) to n do
   c[i]:=10-c[i-1]-c[i-2];
   for i:=1 to n do
   write (c[i]:4);
   end
   else writeln (‘решения нет');
readln;
end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(это кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

[Serge_Bliznykov]

Алёнка, тот код, что Вы написали, даже не компилируется!

во-первых, в Паскале строки должны обрамляться только апострофами и ничем другим (причём, как в начале строки, так и в конце):

writeln('введи номера ячеек');
...
writeln('введи числа');
...
else writeln ('решения нет');

во-вторых,

if ((b-a) mod 3=0) and (x=y) then begin
   d:=10-x;
   if d<=6 then c[a+1]:=random(d-1)+1
	else c[a+1]:=random(5)+2;
if ((b-a) mod 3<>0) or (x=y) then begin
   for i:=(a-1) downto 1 do
   c[i]:=10-c[i+1]-c[i+2];
   for i:=a+2 to b-1 do
   c[i]:=10-c[i-1]-c[i-2];
   for i:=(b+1) to n do
   c[i]:=10-c[i-1]-c[i-2];
   for i:=1 to n do
   write (c[i]:4);
   end
   else writeln (‘решения нет');
readln;
end.

где END для выделенного begin ?!

[Mainak]

для чего "abs(pos1-pos2)=1)"?

Если известные кубики рядом, и сумма их больше или равна 10, то решения нет.

[ViktorR]

Mainak

Если известные кубики рядом, и сумма их больше или равна 10, то решения нет.

А если не рядом? Известные кубики находятся в тройке всегда.
Поэтому, для общности решения, было бы достаточно проверить, что их позиции не накладываются:
(pos1 MOD 3) <> (pos2 MOD 3)
и затем проверять сумму цифр.

В принципе, можно на стадии ввода проверять на возможность построения кода для сейфа и приводить позиции кубиков в первую тройку.
Тогда и условные выражения будут покороче.


Как-то так, ...