Var A: Array[1..N] of Integer;
     r, i, j, c, k, temp: Byte;
   flag: Boolean;
Function GetCountUniqal: Byte;
Var count: Byte;
Begin
count := 0;
For i := 1 to N do
    Begin
    flag := False;
    For j := 1 to N do
        Begin
        If (a[j] = i) then
           Begin
           If (flag) then Inc(Count);
           flag := True;
           End;
        End;
    End;
GetCountUniqal := N - count;
End;

Procedure CreateArray;
Var i: Byte;
Begin
Randomize;
a[1] := Random(E) + 1;
i := 2;
While (i <= N) do
      Begin
      r := Random(E) + 1;
      If (r <> a[i-1]) then
         Begin
         a[i] := r;
         Inc(i);
         End;
      End;
End;

Begin
ClrScr;
CreateArray;
For i := 1 to N do Write(a[i], ' ');
Writeln(#10#13,'Всего уникальных: ', GetCountUniqal);
Repeat
Write('Сколько элементов выбрать?: '); Readln(k);
Until (k <= GetCountUniqal) and (k >= 1);
r := Random(N) + 1;
temp := a[1];
a[1] := a[r];
a[r] := temp;
c := 2;
While (c <= k) do
      Begin
      r := Random(n - c + 1) + c;
      flag := False;
      For j := 1 to c - 1 do
          Begin
          If (a[j] = a[r]) then
             Begin
             flag := True;
             Break;
             End;
          End;
      If (flag = False) then
         Begin
         temp := a[c];
         a[c] := a[r];
         a[r] := temp;
         Inc(c);
         End;
      End;
Writeln;
For i := 1 to k do Write(a[i], ' ');
ReadKey;
End.

Источник:

Категория: Одномерные массивы | Добавил: Seqular (28.09.2007) | Автор: Дмитрий

Просмотров: 2920 | Комментарии: 6 | Рейтинг: 1.0/1 |

Всего комментариев: 6

Порядок вывода комментариев:

6 Falcon (07.06.2011 00:57)

задан массив структур товар со следующими полями: фирма-поставщик, стоимость, количество товара, наименование товара, страна-поставщик, дата поступления (день, месяц, год) Определить фирму, товар которой поступал чаще

5 Roman (31.05.2011 19:43)

дано масив розмірністю N і два цілих числа K i M (1<K<10, 1<М<10). Пред елементом масиву з номеромК вставити М нових елементів з нульовими значеннями. Будб-ласка скиньте на mail

4 Seqular (07.10.2007 12:45)

Кстати, тогда в процедуре CreateArray можно исправить строку
r := Random(E) + 1;
на
r := Random(E) + 1 - E div 2;
Тем самым сделаем разброс и в отрицательные и в положительные числа.

3 Seqular (07.10.2007 12:42)

Пахан, пиши конкретно, какие переменные и на что менять ;))

2 Pavel (01.10.2007 09:02)

Function GetCountUniqal: integer;
var
min, max: integer;
count: byte;
Begin
min := a[1];
max := a[1];
for i := 2 to N do
begin
if a[i] < min then min := a[i];
if a[i] > max then max := a[i];
end;
count := 0;
writeln(min, ' ', max);
for i := min to max do
for j := 1 to N do
if a[j] = i then
begin
inc(count);
break;
end;
GetCountUniqal := count;
End;
Если поставить эту процедуру и в разделе var поменять переменные на тип integer, то программа будет работать со всеми целыми числами biggrin

(т.е. и с отрицательными)

1 Tilda (28.09.2007 23:17)

Задачка попалась капризная, но справились с ней на "ура"! wink

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]

Форма входа

Поиск

Друзья сайта

Статистика

		Воскресенье, 05.01.2025
	Pascal 4 All