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

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

Решение:

program Array98;
var
  a : array[1..10] of Integer;
  N,i,i2,k,num: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
    begin
     Num:=0;
     for i2:=1 to N do
      if a[i]=a[i2] then inc(num);
     if num<3 then k:=i;
    end;

   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 Array98;

var

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

N,i,i2,k,num: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

begin

Num:=0;

for i2:=1 to N do

if a[i]=a[i2] then inc(num);

if num<3 then k:=i;

end;

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 можно посмотреть здесь.

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

Все работает, но как то сложно получается.. 🙁

Program a98;

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

Procedure Destroy(n:integer; Var k:integer; Var a:mass);
Var
 i,j,g,l: integer;
 Temp1,Temp2,Temp3:mass;
 b,t: boolean;
Begin

 For i:=1 to n do Temp2[i]:=a[i];
 
 k:=1;
 Temp1[k]:=a[n];
 For i:=n-1 downto 1 do
  Begin
   b:=false;
   For j:=1 to k do
     If a[i]=Temp1[j] then b:=True;
   If not b then
    Begin
     Inc(k);
     Temp1[k]:=a[i];
    End;
  End;
 For i:=1 to k do a[i]:=Temp1[i];
 
 For i:=1 to k do
 Begin
  l:=0;
  t:=false;
  For j:=1 to n do
  If a[i]=Temp2[j] then
   Begin
    Inc(l);
    If l>=3 then t:=true;
   End;
  If t then
   For j:=1 to n do
    If a[i]=Temp2[j] then Temp3[j]:=a[i];
 End;
 For i:=1 to n do a[i]:=Temp3[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 n do 
  If a[i]>0 then Write(a[i]:3);
End.

Program a98;

Type

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

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

Var

i,j,g,l: integer;

Temp1,Temp2,Temp3:mass;

b,t: boolean;

Begin

For i:=1 to n do Temp2[i]:=a[i];

k:=1;

Temp1[k]:=a[n];

For i:=n-1 downto 1 do

Begin

b:=false;

For j:=1 to k do

If a[i]=Temp1[j] then b:=True;

If not b then

Begin

Inc(k);

Temp1[k]:=a[i];

End;

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

For i:=1 to k do

Begin

l:=0;

t:=false;

For j:=1 to n do

If a[i]=Temp2[j] then

Begin

Inc(l);

If l>=3 then t:=true;

End;

If t then

For j:=1 to n do

If a[i]=Temp2[j] then Temp3[j]:=a[i];

End;

For i:=1 to n do a[i]:=Temp3[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 n do

If a[i]>0 then Write(a[i]:3);

End.

Ответить

Anton

02.05.2017 в 09:49

дааа… сложно… три массива… куча циклов и условий… и ничего не говорящих переменных… я не осилил…. может быть когда высплюсь. 🙂

Ответить

Kirk

29.04.2017 в 09:37

Ответить

program abc;

var
  i,n,j,k,z: integer;
  t:boolean;
 a:array [1..15] of integer;
begin
  read(n);
  for i:=1 to n do read(a[i]);
  k:=0;
  
  for i:=1 to n do
   begin
    z:=0;
    for j:=1 to n do
    if a[i]=a[j] then inc(z);
    
    if z>=3 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,z: integer;

t:boolean;

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

begin

read(n);

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

k:=0;

for i:=1 to n do

begin

z:=0;

for j:=1 to n do

if a[i]=a[j] then inc(z);

if z>=3 then begin inc(k); a[k]:=a[i]; end

end;

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

end.

Ответить

program array_98;//pascalABC.net

begin
  var n := 10;
  var l := Lst(4, 9, 5, 7, 9, 9, 1, 5, 5, 1); l.Println;
  
  var i := 0;
  
  while i <= l.Count - 1 do
  begin
    var count := 0;
    for var j := 0 to l.Count - 1 do
      if l[j] = l[i] then count += 1;
    if count < 3 then
    begin
      var temp := l[i];
      repeat
        var b := l.Remove(temp);
        if not b then break
      until false;
    end
    else i+=1;
  end;
  
  l.Count.Println;//6
  l.Println;//9 5 9 9 5 5
end.

program array_98;//pascalABC.net

begin

var n := 10;

var l := Lst(4, 9, 5, 7, 9, 9, 1, 5, 5, 1); l.Println;

var i := 0;

while i <= l.Count - 1 do

begin

var count := 0;

for var j := 0 to l.Count - 1 do

if l[j] = l[i] then count += 1;

if count < 3 then

begin

var temp := l[i];

repeat

var b := l.Remove(temp);

if not b then break

until false;

end

else i+=1;

end;

l.Count.Println;//6

l.Println;//9 5 9 9 5 5

end.

Ответить

program array98;
var a,b:array [1..10] of integer; n,cx:integer;
begin
  readln (n);//чтение кол-ва элементов
  for var i:=1 to n do read (a[i]);// чтение элементов(в строку через пробел)
  for var i:=1 to n do begin// внешний цикл где поочередно берется 1 число для сравнения с остальными
  cx:=0;//счетчик одинаковых значений обнулить
  for var j:=1 to n do // внутренний цикл - сравнивает со всеми значениями
  if a[i]=a[j] then inc(cx);// если одинаковые - увелич. счетчик
  if cx>=3 then b[i]:=a[i];// если таких 3 и > пишем число из внешнего цикла во временный масив
  end;// поменять в предыдущей строке: для array99 на cx<=2;для array100 на cx<>2
  cx:=0;// обнулим счетчик
  for var i:=1 to n do a[i]:=0;// чистим исходный массив
  for var i:=1 to n do if b[i]<>0 then // уберем 0-ли с мест где были числа которых <3
  begin 
  inc(cx);// считаем номер значения
  a[cx]:=b[i];// в исходный массив с номером значения заносим ненулевые значения из временного
  end;
 println(cx);//ответ: размер нового массива
 for var i:=1 to cx do print (a[i]);//ответ: значения нового массива
 end.

program array98;

var a,b:array [1..10] of integer; n,cx:integer;

begin

readln (n);//чтение кол-ва элементов

for var i:=1 to n do read (a[i]);// чтение элементов(в строку через пробел)

for var i:=1 to n do begin// внешний цикл где поочередно берется 1 число для сравнения с остальными

cx:=0;//счетчик одинаковых значений обнулить

for var j:=1 to n do // внутренний цикл - сравнивает со всеми значениями

if a[i]=a[j] then inc(cx);// если одинаковые - увелич. счетчик

if cx>=3 then b[i]:=a[i];// если таких 3 и > пишем число из внешнего цикла во временный масив

end;// поменять в предыдущей строке: для array99 на cx<=2;для array100 на cx<>2

cx:=0;// обнулим счетчик

for var i:=1 to n do a[i]:=0;// чистим исходный массив

for var i:=1 to n do if b[i]<>0 then // уберем 0-ли с мест где были числа которых <3

begin

inc(cx);// считаем номер значения

a[cx]:=b[i];// в исходный массив с номером значения заносим ненулевые значения из временного

end;

println(cx);//ответ: размер нового массива

for var i:=1 to cx do print (a[i]);//ответ: значения нового массива

end.

Ответить

долго медитировал над предложенным кодом автора сайта пока не понял что переменная k не несёт особого смысла. Тоже самое только без неё:

var
  n, ax: integer;
  a: array [1..10] of integer;

begin
  read(n);
  for var i := 1 to n do read(a[i]);
  
  for var i := 1 to n do
  begin
    ax := 0;
    for var x := 1 to n do
    begin
      if a[i] = a[x] then inc(ax);
    end;
    if ax < 3 then 
    for var y := i to n do a[y] := a[y + 1];
    
  end;
  print(a);
end.

var

n, ax: integer;

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

begin

read(n);

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

for var i := 1 to n do

begin

ax := 0;

for var x := 1 to n do

begin

if a[i] = a[x] then inc(ax);

end;

if ax < 3 then

for var y := i to n do a[y] := a[y + 1];

end;

print(a);

end.

Ответить

var
  n, ax: integer;
  a: array [1..11] of integer;

begin
  read(n);
  for var i := 1 to n do read(a[i]);
  
  for var i := 1 to n do
  begin
    ax := 0;
    for var x := 1 to n do
    begin
      if a[i] = a[x] then inc(ax);
    end;
    if ax < 3 then 
    for var y := i to n do a[y] := a[y + 1];
    
  end;
  print(a);
end.

var

n, ax: integer;

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

begin

read(n);

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

for var i := 1 to n do

begin

ax := 0;

for var x := 1 to n do

begin

if a[i] = a[x] then inc(ax);

end;

if ax < 3 then

for var y := i to n do a[y] := a[y + 1];

end;

print(a);

end.

Ответить

var
  n, ax,i: integer;
  a: array [1..11] of integer;

begin
  read(n);
  for i := 1 to n do read(a[i]);
  i:=1;
  while i<n do
  begin
    ax := 0;
    for var x := 1 to n do
    begin
      if a[i] = a[x] then inc(ax);
    end;
    if ax < 3 then 
    for var y := i to n do a[y] := a[y + 1]
    else inc(i);
  end;
  ax:=0;
  for var y:=1 to i do if a[y]<>0 then inc(ax);
  print(ax,a);
end.

var

n, ax,i: integer;

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

begin

read(n);

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

i:=1;

while i<n do

begin

ax := 0;

for var x := 1 to n do

begin

if a[i] = a[x] then inc(ax);

end;

if ax < 3 then

for var y := i to n do a[y] := a[y + 1]

else inc(i);

end;

ax:=0;

for var y:=1 to i do if a[y]<>0 then inc(ax);

print(ax,a);

end.

Ответить

asdfg

26.04.2021 в 03:59

первые 2 варианта удалите пожалуйста,потестил потом больше наборов данных и ошибки повылазили

Ответить

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

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

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

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