Решаем задачи Абрамян на Паскале. Array96

Array96. Дан целочисленный массив размера $$N$$. Удалить из массива все одинаковые элементы, оставив их первые вхождения.

Решение:

program Array96;
var
  a : array[1..10] of Integer;
  N,i,i2,k:Integer;

begin
  Write('N: ');
  Readln(N);

  Writeln('A: ');
  for i:=1 to N do
   begin
    write(i,' :');
    readln(a[i]);
   end;

  repeat
   k:=11;
   for i:=1 to N do
    for i2:=i+1 to N do
    if a[i]=a[i2] then k:=i2;

   if k<>11 then
    begin
     N:=N-1;
     for i:=K to N do a[i]:=a[i+1];
    end;
  until (k=11);

  Writeln(N);
  for i:=1 to N do writeln(i,' :',a[i]);
end.

program Array96;

var

a : array[1..10] of Integer;

N,i,i2,k:Integer;

begin

Write('N: ');

Readln(N);

Writeln('A: ');

for i:=1 to N do

begin

write(i,' :');

readln(a[i]);

end;

repeat

k:=11;

for i:=1 to N do

for i2:=i+1 to N do

if a[i]=a[i2] then k:=i2;

if k<>11 then

begin

N:=N-1;

for i:=K to N do a[i]:=a[i+1];

end;

until (k=11);

Writeln(N);

for i:=1 to N do writeln(i,' :',a[i]);

end.

Задачи из раздела Array можно посмотреть здесь.

Комментарии 4

Наконец то решил!
Целый день мне покоя не давала.

Program a96;

Type 
 mass = array [1..10] of integer;
 
Procedure Destroy(n:integer; Var k:integer; Var a:mass);
Var
 Temp: mass;
 i,j,l: integer;
 b: boolean;
Begin
 k:=1;
 Temp[k]:=a[1];
 For i:=2 to n do 
  Begin
   b:=false;
   j:=0;
    For l:=1 to k do
     Begin
      If (a[i]=Temp[l]) and (j=0) then
      Begin
       b:=True;
       j:=1
      End;
     End;
   If (b=false) then 
    Begin
     inc(k);
     Temp[k]:=a[i];
    End;
  End;
 For i:=1 to k do a[i]:=Temp[i];
End;

Var
 a: mass;
 n,i,k: integer;
 
Begin
Randomize;
 n:=random(6)+4;
 Writeln('N=',n);
 Write('A: ');
 For i:=1 to n do
  Begin
   a[i]:=random(4)+1;
   Write(a[i]:3);
  End;
 Writeln();
 Destroy(n,k,a);
 Write('A: ');
 For i:=1 to k do Write(a[i]:3);
End.

Program a96;

Type

mass = array [1..10] of integer;

Procedure Destroy(n:integer; Var k:integer; Var a:mass);

Var

Temp: mass;

i,j,l: integer;

b: boolean;

Begin

k:=1;

Temp[k]:=a[1];

For i:=2 to n do

Begin

b:=false;

j:=0;

For l:=1 to k do

Begin

If (a[i]=Temp[l]) and (j=0) then

Begin

b:=True;

j:=1

End;

If (b=false) then

Begin

inc(k);

Temp[k]:=a[i];

End;

For i:=1 to k do a[i]:=Temp[i];

End;

Var

a: mass;

n,i,k: integer;

Begin

Randomize;

n:=random(6)+4;

Writeln('N=',n);

Write('A: ');

For i:=1 to n do

Begin

a[i]:=random(4)+1;

Write(a[i]:3);

End;

Writeln();

Destroy(n,k,a);

Write('A: ');

For i:=1 to k do Write(a[i]:3);

End.

Ответить

Что то грязи на оставлял..
Подправил 🙂

Program a96;

Type 
 mass = array [1..10] of integer;
 
Procedure Destroy(n:integer; Var k:integer; Var a:mass);
Var
 Temp: mass;
 i,l: integer;
 b: boolean;
Begin
 k:=1;
 Temp[k]:=a[1];
 For i:=2 to n do 
  Begin
   b:=false;
    For l:=1 to k do
      If (a[i]=Temp[l]) then b:=True;
   If (b=false) then 
    Begin
     Inc(k);
     Temp[k]:=a[i];
    End;
  End;
 For i:=1 to k do a[i]:=Temp[i];
End;

Var
 a: mass;
 n,i,k: integer;
 
Begin
Randomize;
 n:=random(6)+4;
 Writeln('N=',n);
 Write('A: ');
 For i:=1 to n do
  Begin
   a[i]:=random(4)+1;
   Write(a[i]:3);
  End;
 Writeln();
 Destroy(n,k,a);
 Write('A: ');
 For i:=1 to k do Write(a[i]:3);
End.

Program a96;

Type

mass = array [1..10] of integer;

Procedure Destroy(n:integer; Var k:integer; Var a:mass);

Var

Temp: mass;

i,l: integer;

b: boolean;

Begin

k:=1;

Temp[k]:=a[1];

For i:=2 to n do

Begin

b:=false;

For l:=1 to k do

If (a[i]=Temp[l]) then b:=True;

If (b=false) then

Begin

Inc(k);

Temp[k]:=a[i];

End;

For i:=1 to k do a[i]:=Temp[i];

End;

Var

a: mass;

n,i,k: integer;

Begin

Randomize;

n:=random(6)+4;

Writeln('N=',n);

Write('A: ');

For i:=1 to n do

Begin

a[i]:=random(4)+1;

Write(a[i]:3);

End;

Writeln();

Destroy(n,k,a);

Write('A: ');

For i:=1 to k do Write(a[i]:3);

End.

Ответить

Ещё один вариант:-)

program abc;

var
  i,n,j,k: integer;
  t:boolean;
 a:array [1..15] of integer;
begin
  read(n);

  for i:=1 to n do read(a[i]);

  k:=1;

  for i:=1 to n do
   begin
    t:=true;

    for j:=1 to k do
    if a[i]=a[j] then t:=false;

    if t=true then begin inc(k);a[k]:=a[i]; end;
   end;
   for i:=1 to k do write(a[i],' ');
end.

program abc;

var

i,n,j,k: integer;

t:boolean;

a:array [1..15] of integer;

begin

read(n);

for i:=1 to n do read(a[i]);

k:=1;

for i:=1 to n do

begin

t:=true;

for j:=1 to k do

if a[i]=a[j] then t:=false;

if t=true then begin inc(k);a[k]:=a[i]; end;

end;

for i:=1 to k do write(a[i],' ');

end.

Ответить

program array_96;//pascalABC.net

begin
  var n := 10;
  var l := Lst(SeqRandom(n, 0, 9)); l.Println;//3 2 8 4 3 4 9 8 6 8
  
  var j := 0;
  var i := 0;
  
  while i < l.Count - 1 do
  begin
    j := i + 1;
    while j <= l.Count - 1 do
    begin
      if l[j] = l[i] then
      begin l.RemoveAt(j); continue end;
      j += 1
    end;
    i += 1
  end;
  
  l.Println;//3 2 8 4 9 6
end.

program array_96;//pascalABC.net

begin

var n := 10;

var l := Lst(SeqRandom(n, 0, 9)); l.Println;//3 2 8 4 3 4 9 8 6 8

var j := 0;

var i := 0;

while i < l.Count - 1 do

begin

j := i + 1;

while j <= l.Count - 1 do

begin

if l[j] = l[i] then

begin l.RemoveAt(j); continue end;

j += 1

end;

i += 1

end;

l.Println;//3 2 8 4 9 6

end.

program array_96;//fpc

const
  n = 10;

var
  a: array[1..n] of integer = (3, 2, 8, 4, 3, 4, 9, 8, 6, 8);
  k, i, j: integer;

begin
  k := 1;
  
  for i := 1 to n do
  begin
    j := 1;
    while a[j] <> a[i] do Inc(j);
    if j = i then
    begin
      a[k] := a[i];
      k := k + 1;
    end;
  end;
  
  for i := 1 to k - 1 do Write(a[i], ' ');//3 2 8 4 9 6 
  Readln;
end.

program array_96;//fpc

const

n = 10;

var

a: array[1..n] of integer = (3, 2, 8, 4, 3, 4, 9, 8, 6, 8);

k, i, j: integer;

begin

k := 1;

for i := 1 to n do

begin

j := 1;

while a[j] <> a[i] do Inc(j);

if j = i then

begin

a[k] := a[i];

k := k + 1;

end;

for i := 1 to k - 1 do Write(a[i], ' ');//3 2 8 4 9 6

Readln;

end.

Ответить

Решаем задачи Абрамян на Паскале. Array96

Комментарии:

Комментарии 4

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