Вывести все возможные варианты трехзначного числа [не решено]

Втр, 01/21/2014 - 12:23 — tech

Задача:

Дано трехзначное число. Вывести на экран все трехзначные числа, которые можно получить из цифр данного числа.

Алгоритм решения задачи:

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

Допустим, дано число abc, где a, b и c - цифры. Возможных вариантов, помимо abc, вроде бы будет 5: acb, bac, bca, cab, cba. Однако, если цифра a равна цифре b, то само число можно записать в виде aac, и тогда других вариантов будет всего два - это aca и caa. B таких нюансов в данной задаче много.

Предусмотреть все варианты в конструкции if-else непосильная задача. Ниже приводится лишь часть.

Есть вариант решения через массив. Записывать туда каждое очередное число, если оно больше 99 и меньше 1000 и если его еще нет в этом массиве. Но и тут возникают сложности, связанные с повторением кода.

Программа на языке Паскаль:

var
    n: 100..999;
    a,b,c: byte;
 
begin
        readln(n);
        a := n div 100;
        b := n div 10 mod 10;
        c := n mod 10;
 
        if (ab) and (ac) and (bc) and (a0) and (b0) and (c0) then begin
                n := a * 100 + c * 10 + b;
                writeln(n);
                n := b * 100 + a * 10 + c;
                writeln(n);
                n := b * 100 + c * 10 + a;
                writeln(n);
                n := c * 100 + a * 10 + b;
                writeln(n);
                n := c * 100 + b * 10 + a;
                writeln(n);
        end else
                if (a=b) and (ac) and (a0) and (b0) and (c0) then begin
                        n := a * 100 + c * 10 + b;
                        writeln(n);
                        n := c * 100 + a * 10 + b;
                        writeln(n);
                end;
end.

Добавить комментарий

var a:array[100..999] of byte;
i:integer; b,c,d:byte; e:integer;
 
begin
 readln(e);
 b:=e div 100;
 c:=(e-b*100) div 10;
 d:=e-b*100-c*10;
 for i:=100 to 999 do
  a[i]:=0;
 a[b*100+d*10+c]:=a[b*100+d*10+c]+1;
 a[c*100+b*10+d]:=a[c*100+b*10+d]+1;
 a[c*100+d*10+b]:=a[c*100+d*10+b]+1;
 a[d*100+b*10+c]:=a[d*100+b*10+c]+1;
 a[d*100+c*10+b]:=a[d*100+c*10+b]+1;
 for i:=100 to 999 do
  if (a[i]>0) and (ie) then writeln(i);
end.

ответить

Втр, 05/20/2014 - 05:57 — Гость

Мой вариант

program z2;
 
var
n,i,x: integer;
s, s1, r: string;
begin
   s:='233';r:='';
   if ((strtoint(s)mod 100)=0) or ((s[1]=s[2])and(s[2]=s[3])) then r:=s;
   if (s[1]s[2])and(s[2]s[3]) then
     for i:=100 to 999 do
      begin
        n:=0;
        s1:=inttostr(i);
          for x:=1 to 3 do
            if pos(s[x],s1)0 then n:=n+1;
          if n=3 then r:=r+', '+s1;
      end;
    if s[2]=s[3] then r:=s+ ', '+ s[2]+s[1]+s[3]+ ', '+s[2]+s[3]+s[1];
    if s[1]=s[2] then r:=s+ ', '+ s[1]+s[3]+s[2]+ ', '+s[3]+s[2]+s[1];
    writeln(r);
 end.

ответить

чт, 05/15/2014 - 22:26 — Гость

комбинации трехзначного числа

var
  s: string;
  a, b, c: byte;
 
begin
  read(s);
  if (length(s) = 3) and (s[1] in ['0'..'9']) and (s[2] in ['0'..'9']) and (s[3] in ['0'..'9']) then
  begin
    a := StrToInt(s[1]);  b := StrToInt(s[2]);  c := StrToInt(s[3]);
 
    if (a  b) and (a  c) then
      write(a, b, c, ', ', a, c, b, ', ', c, a, b, ', ', c, b, a, ', ', b, a, c, ', ', b, c, a) else
    if (a = b) and (a = c) then
      write('одна комбинация', a, a, a) else
    begin
      if a = b then write(a, a, c, ', ', a, c, a, ', ', c, a, a) else
      if a = c then write(a, a, b, ', ', a, b, a, ', ', c, a, a) else
      if b = c then write(b, b, a, ', ', b, a, b, ', ', a, b, b);
    end;
  end else write('некоректный ввод');
end.

ответить

вс, 05/11/2014 - 13:32 — Гость

Рабочая программа через if-ы

var
n:integer;
a,b,c:byte;
begin
readln(n);
c:= n mod 10;  n:=n div 10;
b:= n mod 10;  n:=n div 10;
a:=n;
if (b=c) and (c=0) then
writeln('Вариантов нет') else
if(a0) and (b 0) and (c0) then begin
if (ab) and (bc) then
writeln(a,c,b,' ',b,c,a,' ',b,a,c,' ',c,b,a,' ',c,a,b) else
if (ab) and (a=c) then
writeln(b,a,c,' ',a,c,b) else
if(ab) and (b=c) then
writeln(b,a,c,' ',b,c,a) else
writeln(a,c,b,' ',c,a,b);
end else
if (b=0) then begin
if (a=c) then
writeln(a,c,b) else
writeln(a,c,b,' ',c,b,a,' ',c,a,b);
end else
if c = 0 then begin
if (a=b) then 
writeln(a,c,b) else
writeln(a,c,b,' ',b,c,a,' ',b,a,c);
end;
end.

ответить

вс, 05/11/2014 - 12:30 — Гость

Почему бы не использовать if?

var
n:integer;
a,b,c:byte;
ab,ac,bc:boolean;
begin
readln(n);
c:= n mod 10;  n:=n div 10;
b:= n mod 10;  n:=n div 10;
a:=n;
if( a = b) then ab:=true else ab:=false;
if( a = c) then ac:=true else ac:=false;
if( b = c) then bc:=true else bc:=false;
if ( ab = false) and (ac = false) and (bc=false) then 
writeln(a,c,b,' ',c,a,b,' ',c,b,a,' ',b,a,c,' ',b,c,a) else
if ( a = b) and (b = c) then 
writeln('НЕТ ВАРИАНТОВ')
else
if ( ab) then
writeln(a,c,a,' ',c,a,a) else
if(ac) then
writeln(b,a,a,' ',a,a,b) else
if( bc) then
writeln(c,a,c,' ',c,c,a);
end.

ответить

вс, 04/13/2014 - 19:25 — Гость

1)вы берете через числа, а не

1)вы берете через числа, а не пробовали брать через строку? Тогда необходимость в mod и div отпадает.
2)условие будет легче и проще если проверять не все три числа одновременно, а каждое поочередно через цикл.

ответить

вс, 03/23/2014 - 00:26 — Гость

Решение

program v1;
var
x: 100..999;
i,j,k,h:integer;
A: array[1..100] of integer;
B: array[1..100] of integer;
begin
//**************
writeln('vvedite chislo ot 100 do 999');
read(x);
writeln('vashe chislo = ',x);
//**************
A[30]:=x mod 10;
A[20]:=x mod 100 div 10;
A[10]:=x div 100;
//**************
A[1]:=A[10]*100+A[30]*10+A[20];
A[2]:=A[20]*100+A[10]*10+A[30];
A[3]:=A[20]*100+A[30]*10+A[10];
A[4]:=A[30]*100+A[10]*10+A[20];
A[5]:=A[30]*100+A[20]*10+A[10];
//**************
    for i := 1 to 4 do
        for j := 1 to 4 do
            if A[j] > A[j+1] then begin
                k := A[j];
                A[j] := A[j+1];
                A[j+1] := k
            end;
//**************
    for i:=1 to 5 do
        begin
            if A[i]  A[i+1] then
            begin
                inc(h);
                B[h]:=A[i];
            end;
        end;
//**************
for i:= 1 to h do
writeln(B[i]);
//**************
readln;
readln;
end.

ответить

сб, 03/22/2014 - 23:15 — Гость

Глупо, но работает

program nomer1;
var
x,i:integer;
A: array[1..14] of integer;
begin
//**************
writeln(' vvedite 3-x znachnoe chislo');
read(x);
writeln('3-x znachnoe chislo = ',x);
//**************
A[3]:=x mod 10;
A[2]:=x mod 100 div 10;
A[1]:=x div 100;
//**************
if (A[1]A[2]) and (A[1]A[3]) and (A[2]A[3]) then
begin
A[4]:=A[3]*100+A[2]*10+A[1];
A[5]:=A[2]*100+A[1]*10+A[3];
A[6]:=A[2]*100+A[3]*10+A[1];
A[7]:=A[3]*100+A[1]*10+A[2];
A[8]:=A[3]*100+A[2]*10+A[1];
for i:= 4 to 8 do
writeln(A[i]);
end;
//**************
if A[1]=A[2] then
begin
A[9]:=A[1]*10+A[3];
A[10]:=A[3]*10+A[1];
for i:= 9 to 10 do
writeln(A[i]);
end;
//**************
if A[1]=A[3] then
begin
A[11]:=A[1]*10+A[2];
A[12]:=A[2]*10+A[1];
for i:= 11 to 12 do
writeln(A[i]);
end;
//**************
if A[2]=A[3] then
begin
A[13]:=A[1]*10+A[2];
A[14]:=A[2]*10+A[1];
for i:= 13 to 14 do
writeln(A[i]);
end;
//**************
readln;
readln;
end.

ответить

Втр, 03/04/2014 - 23:57 — Гость

Profit!!!

program p1;
var s,m:string;
    a:array[1..5] of string;
    i,j,k:byte;
    s1:string;
begin
readln(s);
m:=s;
a[1]:=s[1]+s[3]+s[2];
a[2]:=s[2]+s[1]+s[3];
a[3]:=s[2]+s[3]+s[1];
a[4]:=s[3]+s[2]+s[1];
a[5]:=s[3]+s[1]+s[2];
 
s:=a[1]+' '+a[2]+' '+a[3]+' '+a[4]+' '+a[5];                                                  
for i:= 5 downto 1 do
begin
  for j:= 1 to i-1 do
     begin 
        k:=s.IndexOf(a[i]);
        s.Remove(k,3);
     end;   
   if ((s.Contains(a[i])=true) and (s1.Contains(a[i])=false)) and (strtoint(a[i])>99) and (a[i]m) then  s1:=s1+a[i]+' '; 
    end;
writeln(s1);
end.

ответить

чт, 01/30/2014 - 19:29 — Гость

Решение

program chisla;
 
var
  d: integer;
  a, b, c, s: string;
 
begin
writeln('Введите трёхзначное число');
readln(d);
a:=inttostr(d)[1];
b:=inttostr(d)[2];
c:=inttostr(d)[3];
s:=a+b+c+#13+#10+a+c+b+#13+#10+b+a+c+#13+#10+b+c+a+#13+#10+c+a+b+#13+#10+c+b+a;
writeln(s);
 
end.

ответить

Язык Pascal. Программирование для начинающих

Учебник

Решение задач

Программы