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

Задача

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

Решение

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

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

Допустим, дано число 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 (a<>b) and (a<>c) and (b<>c) and (a<>0) and (b<>0) and (c<>0) 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 (a<>c) and (a<>0) and (b<>0) and (c<>0) then begin
			n := a * 100 + c * 10 + b;
			writeln(n);
			n := c * 100 + a * 10 + b;
			writeln(n);
		end;
end.

Тема

Условные операторы

Уровень

Сложные задачи

Комментарии

var
  m1, m2: set of byte;
  chislo, index: longint;
begin
  read(chislo);
  m1:=[chislo mod 10, chislo div 100, chislo mod 100 div 10];
  for index:=100 to 999 do
  begin
    m2:=[index mod 10, index div 100, index mod 100 div 10];
    if (m1=m2) and (index<>chislo) then
      write(index, ' ');
  end;
  readln; readln; readln;
end.

Program chisla;
 
var
i, a, b, c : integer;
 
Begin
  write ('Введите трехзначное число: ');
  readln (i);
  a := i div 100;
  b := i div 10;
  b := b mod 10;
  c := i mod 10;
   if (a = b) and (a = c) then
    writeln ('Другие числа из этого числа составить нельзя')
   else
    if (a <> b) and (a <> c) and (b <> c) then
      writeln (a,c,b,' ',b,a,c,' ',b,c,a,' ',c,a,b,' ',c,b,a)
    else
      if (a = b) and (a <> c) then
       writeln (a,c,a,' ',c,a,a);
        if (a = c) and (a <> b) then
         writeln (a,a,b,' ',b,a,a);
           if (c = b) and (c <> a) then
            writeln (b,b,a,' ',b,a,b);
End.

program n2;
Var ch,a,b,c,v1,v2,v3,v4,v5,v6:integer;
begin
readln (ch);   {разбираем число на цифры}
a:=ch div 100;
b:=ch mod 10;
c:=ch div 10 mod 10;
v1:=a*100+b*10+c;   {Варианты получившихся чисел}
v2:=a*100+c*10+b;
v3:=c*100+a*10+b;
v4:=b*100+a*10+c;
v5:=c*100+b*10+a;
v6:=b*100+c*10+a;
If (a=b) and (a=c) and (b=c) and (a=0) then  {Предусловие программы, если числа одинаковые}
   writeln ('‚Ђђ€ЂЌ’Ћ‚ Ќ…’'); {и одно равно 0 (т.е. все равны 0)}
If  (a=b) and (a=c) and (b=c) then writeln (v1);  {Все больше 0}
if ((a<>b) and (a<>c) and (b<>c)) then {Предусматриваем вариант с разными числами}
        if (a<>0) and (b<>0) and (c<>0) then   {Ни одно число не равно 0}
         writeln (v1,' ',v2,' ',v3,' ',v4,' ',v5,' ',v6) else begin
        if a=0 then             { подварианты, если одно из них 0}
         writeln (v3,' ',v4,' ',v5,' ',v6);
        if b=0 then
         writeln (v1,' ',v2,' ',v3,' ',v5);
        if c=0 then
         writeln (v1,' ',v2,' ',v4,' ',v6);
        end;
If (a=b) and (c=0) then writeln (v1,' ',v2); {Вариант с двумя одинаковыми числами и одним нулём}
If (a=b) then writeln (v1,' ',v2,' ',v3);    {Не одного 0}
If (a=b) and (a=0) then writeln (v3);        {Два 0 и одно не 0}
If (a=c) and (b=0) then writeln (v1,' ',v2);
If (a=c) then writeln (v3,' ',v4,' ',v5);
If (a=c) and (a=0) then writeln (v4);
If (b=c) and (a=0) then writeln (v4,' ',v6);
If (b=c) then writeln (v2,' ',v3,' ',v5);
If (b=c) and (b=0) then writeln (v1);
readln ;
end.

var
s,a,b,c:string;
begin
readln(s);
a:=copy(s,1,1);
b:=copy(s,2,1);
c:=copy(s,3,1);
writeln;
write(s,' ');
if b+c>'0' then write(a+c+b,' ');
if b>'0' then write(b+a+c,' ',b+c+a,' ');
if c>'0' then write(c+a+b,' ',c+b+a,' ');
end.

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
var n:array[1..6] of 0..999;
a,b,c:0..9;
i,j,f:0..6;
n1:100..999;
begin
      readln(n1);
      a:=n1 div 100;
      b:=((n1 div 10)mod 10);
      c:=n1 mod 10;
      n[1]:=a*100+b*10+c;
      n[2]:=a*100+c*10+b;
      n[3]:=b*100+a*10+c;
      n[4]:=b*100+c*10+a;
      n[5]:=c*100+b*10+a;
      n[6]:=c*100+a*10+b;
      f:=0;
      for i:= 1 to 6 do
      begin
      if n[i]=n1 then
      begin
         n[i]:=0;
         f:=f+1;
      end
      else
      begin
          if n[i]>=100 then
          begin
              for j:= i+1 to 6 do
              begin
                  if (n[i]=n[j]) then
                  begin
                  n[j]:=0;
                  f:=f+1;
                  end;
              end;
          end
          else
          f:=f+1;
      end;
      end;
      for i:= 1 to 6 do
      begin
          if n[i]>100 then
          write(n[i],' ');
      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 (i<>e) then writeln(i);
end. 

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.

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.

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(a<>0) and (b<> 0) and (c<>0) then begin
if (a<>b) and (b<>c) then
writeln(a,c,b,' ',b,c,a,' ',b,a,c,' ',c,b,a,' ',c,a,b) else
if (a<>b) and (a=c) then
writeln(b,a,c,' ',a,c,b) else
if(a<>b) 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.

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.

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

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.

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.

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.

def pre(pref, n, a):
    if n == 0 :
        print(pref)
    else:
        for i in range (len(a)):
            pre(pref + a[i], n - 1, a)
 
a = '12'
n = len(a)
pre("", n, a)

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