Дан массив состоящий из 100 целых чисел выведите все числа которые повторяются в этом...

Question

Дан массив состоящий из 100 целых чисел выведите все числа которые повторяются в этом массиве
а)несколько раз
б) только по одному разу

Comments

ребят, ребят без assign'a напишите прогу на паскале

---

почему не имеют ? имеют

---

боже мой какой аргумент.

---

https://znanija.com/task/24033880

---

Уже делал точно такое же задание

Answer 1

// PascalABC.NET 3.2, сборка 1417 от 28.03.2017
// Внимание! Если программа не работает, обновите версию!

begin
  var a:=ArrRandom(100,-50,50); a.Println;
  var d:=new Dictionary;
  foreach var x in a do
    if d.ContainsKey(x) then d[x]:=d[x]+1
    else d[x]:=1;
  Writeln('Встречаются более одного раза');
  d.Where(kv->kv.Value>1).Select(kv->kv.Key).OrderBy(x->x).Println;
  Writeln('Встречаются ровно один раз');
  d.Where(kv->kv.Value=1).Select(kv->kv.Key).OrderBy(x->x).Println;
end.

Пример
-35 40 7 -22 -4 -24 10 -46 4 23 -4 13 -44 7 -34 -13 -8 -18 -35 14 49 -36 3 -31 42 -47 -24 -34 -22 -25 36 24 39 43 -31 -26 23 -4 -41 2 -11 27 -14 -2 -47 42 -16 -38 -23 2 -27 44 -13 -36 15 -50 -14 -12 -14 -7 -50 -7 26 -22 37 22 25 -37 -13 43 15 46 -28 13 -26 -29 29 -46 -35 50 20 -36 39 26 -48 43 -14 24 -23 -31 38 -15 -41 17 2 47 -49 -43 12 -19
Встречаются более одного раза
-50 -47 -46 -41 -36 -35 -34 -31 -26 -24 -23 -22 -14 -13 -7 -4 2 7 13 15 23 24 26 39 42 43
Встречаются ровно один раз
-49 -48 -44 -43 -38 -37 -29 -28 -27 -25 -19 -18 -16 -15 -12 -11 -8 -2 3 4 10 12 14 17 20 22 25 27 29 36 37 38 40 44 46 47 49 50

Answer 2

Первое 

var
a:array[1..100] of integer;
i,j:integer;
procedure swap(var x,y: integer);
   var t: integer;
 begin
    t := x;
    x := y;
    y := t
 end;
begin
for i:=1 to 100 do a[i]:=random(100);
for j:=1 to 99 do
for i:=1 to 100-j do if a[i] > a[i+1] then swap(a[i],a[i+1]);
for i:=2 to 99 do if (a[i]=a[i+1]) or (a[i]=a[i-1]) then writeln('a[',i,']=',a[i]);
end.

Второе

var
a:array[1..100] of integer;
i,j:integer;
procedure swap(var x,y: integer);
   var t: integer;
 begin
    t := x;
    x := y;
    y := t
 end;
begin
for i:=1 to 100 do a[i]:=random(100);
for j:=1 to 99 do
for i:=1 to 100-j do if a[i] > a[i+1] then swap(a[i],a[i+1]);
if a[1]<>a[2] then writeln('a[1]=',a[1]);
for i:=2 to 99 do if (a[i]<>a[i+1]) and (a[i]<>a[i-1]) then writeln('a[',i,']=',a[i]);
if a[100]<>a[99] then writeln('a[100]=',a[100]);
end.

Comments

строки "решить через assign" уже давно нет))

---

а вы?

---

Добавил б