Задача на Pascal - вывестикомбинации (подмножества) цифр заданной длины

[aless23]

Уважаемые,я хотел бы обратиться к вам с просьбой: помочь решить данную задачу по Pascal...
На одном из занятий на дали код программы который выводит все какие только возможны комбинации(подмножества) цифр из числа 10 (1; 1,2; 1,2,3;1,2,3,4;2,2,4,5,...и.т.д)
Наша задача заключается в следующем,переделать этот код программы,чтобы он выводил только те числа,разряд которых мы укажем....(например ввели число 3, Результат программы будет 3-значное число 2,3,5,ввели число 5 выведет все числа которые состоят из 5-значных элементов 1,3,4,5,2)
Вот тот самый код:

Program AllSubsest;
const n=10;
Type NumSet=array[1..n] of byte;
var A,B:NumSet;
i,j:integer;
Procedure WriteSubSet(j:integer);
var i:integer;
begin
writeln;write('/');
for i:=1 to j do write(b[i],'/');
end;
Procedure SubSet (k:integer);
begin
if k<=N
then begin
Inc(j);
b[j]:=a[k];
WriteSubSet(j);
SubSet (k+1);
Dec(j);
SubSet(k+1);
end
end;
begin
for i:=1 to N do A[i]:=i;
j:=0;
SubSet(1)
end.

Очень прошу разобраться в данной задачи,и помочь её решить...заранее огромное спасибо!!!!



________
1) Название темы по правилам форума должно адекватно отражать суть решаемой задачи/проблемы.

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

Модератор.

[TinMan]

Сообщение от aless23

программу которая подсчитывает все k-элементные подмножества множества из N элементов.То есть если мы ввели число 4,то нам выведет 4-значное число,из представленного списка.

чего-чего?..

[whatever]

Сообщение от TinMan

чего-чего?..

Дас ист "метод продвинутых халявщиков". Большенство из тех, кто пишет на этом форуме, просто выкладывают задание и просят решить, после чего обычно посылаются за наработками, либо по неопределенному адрусу.
В данном случае ТС какбэ дает нам наработки, но совсем не те, что нужно, но ведь надо только чутка переделать, делов то.

aless23, если это твой код, значит ты знаешь что он делает и понимаешь как он написан => для тебя не составит труда его переделать. Если не твой (а это на 99% так), то какой смысл его здесь показывать?

[TinMan]

я так и не понял, кто же исправил условие - ТС или Серж.. ))

aless23, держи исправленный код..

Program AllSubsest;
const
  n=10;
Type
  NumSet=array[1..n] of byte;
var
  A,B:NumSet;
  i,m: integer;

Procedure WriteSubSet(j:integer);
var
  i:integer;
begin
  if j=m then begin
    writeln;
    write('/');
    for i:=1 to j do write(b[i],'/')
  end
end;

Procedure SubSet (k:integer);
begin
  if k<=N then begin
    Inc(j);
    b[j]:=a[k];
    WriteSubSet(j);
    SubSet (k+1);
    Dec(j);
    SubSet(k+1);
  end
end;

begin
  for i:=1 to N do A[i]:=i;
  write('m = ');
  readln(m);
  j:= 0;
  SubSet(1)
end.

Правда, метод не самый эффективный, но занял не больше пары минут (вместе со временем на форматирование твоего кода), и работает )).

И скажи своему преподу, что если уж рекурсия - то рекурсия до конца. Лучше обойтись без глобальной переменной j. Вот, я даже не вникая в суть проги, просто внес ее параметры:

Program AllSubsest;
const
  n=10;
Type
  NumSet=array[1..n] of byte;
var
  A,B:NumSet;
  i,m: integer;

Procedure WriteSubSet(j:integer);
var
  i:integer;
begin
  if j=m then begin
    writeln;
    write('/');
    for i:=1 to j do write(b[i],'/')
  end
end;

Procedure SubSet (k,j:integer);
begin
  if k<=N then begin
    b[j+1]:=a[k];
    WriteSubSet(j+1);
    SubSet (k+1,j+1);
    SubSet(k+1,j);
  end
end;

begin
  for i:=1 to N do A[i]:=i;
  write('m = ');
  readln(m);
  SubSet(1,0)
end.

[Serge_Bliznykov]

ОФФТОП

Сообщение от TinMan

я так и не понял, кто же исправил условие - ТС или Серж.. ))

TinMan, постановку задачи (условие) исправил сам автор темы,
я лишь оформил код тегами и написал комментарий (красненький), ничего более того. я вообще стараюсь не трогать "авторский" текст, ибо моё субъективное понимание может быть неверным..