Удаление элементов из массива 1мерного. Опции

[Fraddy]

ЗЫ я знаю что это решалось.. но мне надо именно доделать (переделать) эту.. А именно удалить элементы а не скрыть..:

Program lab1;
uses crt;
var
A:array[0..100] of integer;
k,s,count,i,j:integer;
Begin
clrScr;
write('count=');
readln(count);
for i:=1 to count do
begin
    write('A[',i,']=');
     readln(A[i]);
end;
writeln('Уник. элементы удалены');
for i:=1 to count do
begin
    s:=0;
    for j:=1 to count do
    if A[i]=A[j] then
    s:=s+1;
    if s<=1 then
    begin
        writeln('A[',i,']=',A[i]);
    end;
    readkey;
end;
End.

Сообщение отредактировано: Fraddy - 21.11.2007 0:06

[Fraddy]

if A[i]=A[j] then
s:=s+1;
if s<=1 then

после етого должно идти удаление как я понимаю... подскажите команду или команды нужные для етого...

[Артемий]

А можно условие конкретней?Что именно нужно удалять?

Добавлено через 6 мин.
Вот,пример удаления,допустим нам надо удалить все элементы равные 5:

for i:= 1 to n do begin
 if a[i]=5 then 
  for j:=i to n-1 do a[j]:=a[j+1];
end;

[Fraddy]

Надо удалить не повторяющиеся элементы! ну типа есть 3 4 5 3 6 4
должно стать 3 4 3 4

Сообщение отредактировано: Fraddy - 26.11.2007 16:14

[Гость]

скиньте ссылку на похожее пожалуйста..

[Гость]

Вот так подойдет?

uses crt;
var
    A:array[0..100] of integer;
    Ai,k,count,i,j:integer;
Begin
    clrScr;
    write('count=');
    readln(count);
    for i:=1 to count do
    begin
        write('A[',i,']=');
        readln(A[i]);
    end;
    for i:=1 to count do begin
        Ai:=A[i];
        for j:=count downto 1 do if Ai=A[j] then begin
            for k:=j+1 to count do A[k-1]:=A[k];
            Dec(count)
        end;
    end;
    writeln('Уник. элементы удалены');
    WriteLn('Осталось ',count,' элементов:');
    for i:=1 to count do WriteLn('A[',i,']=');
    readkey;
End.

Код не проверял, извини - проверь ошибки сам

[volvo]

Если задавать массив константой - то примерно так:

const
  n_max = 7;
  arr: array[1 .. n_max] of integer = (3, 4, 5, 3, 6, 4, 2);

var
  i, j, count, n: integer;

begin
  n := n_max;
  i := 1;
  while i <= n do begin
    count := 0;
    for j := 1 to n do
      if arr[j] = arr[i] then inc(count);

    if count = 1 then begin
      move(arr[i + 1], arr[i], (n - i) * sizeof(integer));
      dec(n);
    end
    else inc(i);
  end;

  for i := 1 to n do write(arr[i]:3);
  writeln;
end.

(для ручного ввода переделай сам...)

[Fraddy]

Спасибо всем! просто большое человеческое спасибо!

[Fraddy]

Чето не работает

Добавлено через 9 мин.

Если задавать массив константой - то примерно так:

const

      move(arr[i + 1], arr[i], (n - i) * sizeof(integer));

.

Вот этого не видет.. типа неизвестная команда мув..

Добавлено через 5 мин.

Вот так подойдет?

uses crt;
var
    A:array[0..100] of integer;
    Ai,k,count,i,j:integer;
Begin
    clrScr;
    write('count=');
    readln(count);
    for i:=1 to count do
    begin
        write('A[',i,']=');
        readln(A[i]);
    end;
    for i:=1 to count do begin
        Ai:=A[i];
        for j:=count downto 1 do if Ai=A[j] then begin
            for k:=j+1 to count do A[k-1]:=A[k];
            Dec(count)
        end;
    end;
    writeln('Уник. элементы удалены');
    WriteLn('Осталось ',count,' элементов:');
    for i:=1 to count do WriteLn('A[',i,']=');
    readkey;
End.

Код не проверял, извини - проверь ошибки сам

Непрально считает.. ща ченить попробую исправить..

[volvo]

типа неизвестная команда мув..

Ну, если твоему компилятору неизвестен Move - то он у тебя битый, бери другой дистрибутив и устанавливай... Вообще-то программа отработала, так что извини, но в следующий раз клевета будет наказываться минусами... Надоело мне с вами цацкаться! Это видишь - ли не работает ему, да это не так откомментировали... Ути-пути, ложечку за маму, ложечку за папу скушал, малыш?

[Fraddy]

Ну, если твоему компилятору неизвестен Move - то он у тебя битый, бери другой дистрибутив и устанавливай... Вообще-то программа отработала, так что извини, но в следующий раз клевета будет наказываться минусами... Надоело мне с вами цацкаться! Это видишь - ли не работает ему, да это не так откомментировали... Ути-пути, ложечку за маму, ложечку за папу скушал, малыш?

У меня винда ВИСТА на ней идет тока паскаль АБЦ который, мать его как оказалось, не читает мув... уж извените такая вот засада... Ну программа значит работает - за это спасибо... я проверить не могу покачто, но буду разбираться.. и странно что мув не работает.. вроде последняя версия.
Короче спасибоо

[Lapp]

Непрально считает.. ща ченить попробую исправить..

LOL..
Просто удивительно, как мне удалось такое сварганить! Непонятно, в каком тумане какого моря я пребывал.. гость был я
Короче, вот рабочий вариант. И - извини за дезу..

uses crt;
var
    A:array[0..100] of integer;
    count,i,j:integer;
    Unique:boolean;
Begin
    clrScr;
    write('count=');
    readln(count);
    for i:=1 to count do begin
        write('A[',i,']=');
        readln(A[i]);
    end;
    i:=1;
    while i<=count do begin
        Unique:=true;
        for j:=1 to count do Unique:=Unique and ((A[i]<>A[j]) or (i=j));
        if Unique then begin
            for j:=i+1 to count do A[j-1]:=A[j];
            Dec(count)
        end;
        Inc(i)
    end;
    writeln('Уник. элементы удалены');
    WriteLn('Осталось ',count,' элементов:');
    for i:=1 to count do WriteLn('A[',i,']=',A[i]);
    readkey;
End.

[Fraddy]

const
  n_max = 100;

var
  i, j, count, n: integer;
  arr: array[1 .. n_max] of integer;

begin
  readln(n);
  i := 1;
  for j := 1 to n do
  readln (arr[j]);
  while i <= n do begin
    count := 0;


    for j := 1 to n do
      if arr[j] = arr[i] then inc(count);

    if count = 1 then begin
      move(arr[i + 1], arr[i], (n - i) * sizeof(integer));
      dec(n);
    end
    else inc(i);
  end;
  for i := 1 to n do write(arr[i]:3);
  writeln;
end.

Ну проверить не могу но вот это налепил по памяти.. должно работать..