Выбор из двузначных чисел, Задача Опции

[Саня]

Такая задача: "Выбор из двузначных чисел". Даны n (n>=12) различных двузначных чисел. Написать программу выбора из них двух чисел так, чтобы их разность давала двузначное число, записываемое двумя одинаковыми числами.

У меня ни как не получаеться Может у кого нибудь получится....

[volvo]

У меня ни как не получаеться

Значит, пробовал? Какие есть идеи? Исходники (если есть) - в студию...
:D

[Саня]

Идеи просто кончились

[volvo]

Тогда держи:

Код

type
 numset = set of byte;
const
 n = 15;
 arr: array[1 .. n] of byte =
   (23, 53, 71, 96, 34, 56, 29, 43, 56, 32, 68, 50, 49, 24, 67);

var
 x: array[1 .. n] of integer;
 nums: array[1 .. n] of numset;
 i: integer;

procedure writeset(i: integer);
 var x, count: byte;
 begin
   if nums[i] = [] then exit;

   writeln( 'набор #', i );
   count := 0;

   for x := 10 to 99 do
     if x in nums[i] then
       begin
         write(x:4); inc(count)
       end;

   if count < 2 then
     write( ' - нет пары' );
   writeln;
 end;

begin
 for i := 1 to n do
   begin
     x[i] := arr[i] mod 11;
     nums[ x[i] ] := nums[ x[i] ] + [ arr[i] ];
   end;

 writeln( 'любые из этих чисел:' );
 for i := 1 to n do
   writeset(i);

end.

Набирал без компилятора, так что могут быть ошибки ... Проверь ;)

[Altair]

синтаксических ошибок нет.

Написать программу выбора из них двух чисел

так надо всего 2 числа произвольных таких указать, или все пары чисел, удовлетворяющих этому правилу?

[Саня]

Я тут немного доработал прогу под себя, проверьте: И есть еще пара вопросов..

Код

type
numset = set of byte;

const
MaxN=100;

var
x: array[1 .. maxN] of integer;
arr: array[1 .. maxN] of byte;
nums: array[1 .. maxN] of numset;
i,n,m: integer;

procedure writeset(i: integer);
var x, count: byte;
begin
  if nums[i] = [] then exit;

  writeln( 'nabor #', i );
  count := 0;

  for x := 10 to 99 do
    if x in nums[i] then
      begin
        write(x:4); inc(count)
      end;

  if count < 2 then
    write( ' - net par' );
  writeln;
end;

begin

repeat  
 writeln('Vvedite kolichestvo elementov');
readln(n)
until n<=MaxN;
For m:=1 to n do
begin
write('a[',m,']= ');
readln(arr[m])
end;

for i := 1 to n do
  begin
    x[i] := arr[i] mod 11;
    nums[ x[i] ] := nums[ x[i] ] + [ arr[i] ];
  end;

writeln( 'Lubie is chisel:' );
for i := 1 to n do
  writeset(i);
  readln;
end.

А как сделать, что бы допустим, при вводе чисел проверялось, являються ли они двузначными? И чтобы в ответе выдовал только одну пару чисел и делал запрос на вывод следующей?

[volvo]

Саня

1. Зачем тебе нужно объявлять массив из 100 элементов, если использоваться будут, скажем, 10 из них... Не лучше ли выделить массив динамически?

2.

А как сделать, что бы допустим, при вводе чисел проверялось, являються ли они двузначными?

Код

For m:=1 to n do
 repeat
   write('a[',m,']= ');
   readln(arr[m])
 until arr[m] in [10 .. 99];

3.

И чтобы в ответе выдовал только одну пару чисел и делал запрос на вывод следующей?

Код

writeln( 'Lubie is chisel:' );
for i := 1 to n do
 begin
 writeset(i);
 writeln( 'press enter to print the next set' )
 readln;
 end;
end.

[Altair]

Век живи, век учись.

Не лучше ли выделить массив динамически

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

[volvo]

Oleg_Z

Вместо:

Код

var
...
arr: array[1 .. maxN] of byte;

...

repeat  
writeln('Vvedite kolichestvo elementov');
readln(n) { допустим, ввели 10 }
until n<=MaxN;
...
{ использование 10 элементов arr (остальные 90 не используются) }

я бы сделал так:

Код

type
 arrType = array[1 .. 1] of integer;
var
 arr: ^arrType;

...

repeat  
writeln('Vvedite kolichestvo elementov');
readln(n) { допустим, ввели 10 }
until n<=MaxN;
GetMem( arr, n*sizeof(integer));

{ и продоллжаем работать с arr^[i] вместо arr[i] }
...
FreeMem( arr, n*sizeof(integer));

[Altair]

круто ... не знал об этом... намотаю на ус....

[volvo]

Саня

У тебя объявлен лишний массив ...
Вместо

Код

var
x: array[1 .. maxN] of integer;
...
for i := 1 to n do
 begin
   x[i] := arr[i] mod 11;
   nums[ x[i] ] := nums[ x[i] ] + [ arr[i] ];
 end;

можно сделать так:

Код

var
x: integer;
...
for i := 1 to n do
 begin
   x := arr[i] mod 11;
   nums[ x ] := nums[ x ] + [ arr[i] ];
 end;

Вот к чему приводит Ctrl-V :D

[Guest]

Спасибо volvo
:D :D :D :D

[Саня]

У меня возникло еще пара вопросов (надеюсь я не надоел :D ) :
проверку чисел на двузначность я сделал так

Код

write('a[',m,']= ');
 readln(arr[m]);
 for t:=1 to 3 do begin
   if ((arr[m]<10)) or ((arr[m]>99)) then begin
     writeln('Chisla dolzhny byt dvyznach');
     write('Vvedite zanovo: a[',m,']=');
     readln(arr[m]);
     dec(t);
   end;

Но она 100% работает только с однозначными числами, а с трехзначными - через раз?

И еще, ответ выходит в таком виде:
Lubie is chisel:
nabor #1
12 - net par
press enter to print the next set
press enter to print the next set

nabor #3
14 36
press enter to print the next set
nabor #4
37 48 92
press enter to print the next set ...
Нельзя ли сделать так, что бы в ответ выводились только по 2 цифры, и не писалось в противном случае, что нет пар.
Заранее благодарен!

[volvo]

1.

Код

 for t:=1 to 3 do begin
  if ((arr[m]<10)) or ((arr[m]>99)) then begin
    writeln('Chisla dolzhny byt dvyznach');
    write('Vvedite zanovo: a[',m,']=');
    readln(arr[m]);
    dec(t); { Внутри цикла изменяется его параметр !!! }
  end;

я же уже писал выше проверку на двузначность числа... чем она не подходит?

2.

Нельзя ли сделать так, что бы в ответ выводились только по 2 цифры

nabor #4
37 48 92

какие именно 2 цифры? 37 и 48? или 48 и 92? а может 37 и 92? по какому критерию выбирать числа? или выводить все возможные перестановки по 2 числа?

[Саня]

Просто я хотел, что бы, если число не верное, выводилось об эом сообщение, и предложение его исправить.

Нужно что бы выводились все возможные переборы по 2 числа.
Примерно так:
37 48
press enter
48 92
press enter
37 92

[volvo]

1.

если число не верное, выводилось об эом сообщение, и предложение его исправить

Код

var
 good: boolean;
...
repeat
  write('a[',m,']= ');
  readln(arr[m]);
  good := arr[m] in [10 .. 99];
  if not good then
    writeln('Chisla dolzhny byt dvyznach. Eshe raz...');
until good;

2.

Нужно что бы выводились все возможные переборы по 2 числа

Для этого придется переделывать программу полностью...

[volvo]

Проверь вот это... Я думаю, это - то, что тебе нужно ...

Код

type
 numset = set of byte;
const
 maxn = 15;

var
 arr: array[1 .. maxn] of byte;

var
 x: integer;
 cnt: array[1 .. maxn] of integer;
 nums: array[1 .. maxn] of numset;
 i: integer;

procedure writeset(i: integer);
 var
   x, count: byte;
   numbers: array[1 .. maxn] of integer;
   ii, jj: integer;
 begin
   count := 0;

   for x := 10 to 99 do
     if x in nums[i] then
       begin
         inc(count); numbers[count] := x;
       end;

   for ii := 1 to count do
     for jj := ii + 1 to count do
       begin
         writeln( 'para:', numbers[ii], ' ', numbers[jj] );
         writeln( 'enter to view next pair' );
         readln;
       end;
 end;

var
 n: integer;
 good: boolean;

begin
 repeat
   writeln('Vvedite kolichestvo elementov');
   readln(n)
 until n <= maxN;

 for i := 1 to n do
   begin
     repeat
       write('a[',i,']= ');
       readln(arr[i]);
       good := arr[i] in [10 .. 99];
       if not good then
         writeln('Chisla dolzhny byt dvyznach. Eshe raz...');
     until good;

     x := arr[i] mod 11;
     nums[ x ] := nums[ x ] + [ arr[i] ];
     inc( cnt[ x ] );
   end;

 writeln;
 writeln( 'results:' );
 writeln;
 for i := 1 to n do
   if cnt[i] > 1 then
     writeset(i);

end.

[Саня]

volvo
Это круто!!!!!
спасибо, спасибо, спасибо, спасибо !!!!!!!

[Саня]

Не моглибы помочь еще немного?
к этой программе нужно какое ни буудь меню приделать, чтобы там было типа такого - пункты:
- Ввод данных в файл;
- Запуск самой программы ( в нем запрос имени файла, возможность ввода с клавиатуры или запуск счетчика случайных чисел; когда получен результат запросить сохранить результат в файл или нет);
- И пункт Help;
,если не сложно