Помощь - Поиск - Пользователи - Календарь
Полная версия: Удаление элементов из массива 1мерного.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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
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
Гость
скиньте ссылку на похожее пожалуйста..
Гость
Вот так подойдет?
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
Спасибо всем! просто большое человеческое спасибо! good.gif
Fraddy
Чето не работает blink.gif

Добавлено через 9 мин.
Цитата(volvo @ 27.11.2007 11:44) *

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


const

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

.


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

Добавлено через 5 мин.
Цитата(Гость @ 27.11.2007 11:41) *

Вот так подойдет?
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 - то он у тебя битый, бери другой дистрибутив и устанавливай... Вообще-то программа отработала, так что извини, но в следующий раз клевета будет наказываться минусами... Надоело мне с вами цацкаться! Это видишь - ли не работает ему, да это не так откомментировали... Ути-пути, ложечку за маму, ложечку за папу скушал, малыш? dry.gif
Fraddy
Цитата(volvo @ 28.11.2007 19:55) *

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

У меня винда ВИСТА на ней идет тока паскаль АБЦ который, мать его как оказалось, не читает мув... уж извените такая вот засада... Ну программа значит работает - за это спасибо... я проверить не могу покачто, но буду разбираться.. и странно что мув не работает.. blink.gif вроде последняя версия.
Короче спасибоо good.gif
Lapp
Цитата(Fraddy @ 27.11.2007 18:19) *

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

LOL.. lol.gif
Просто удивительно, как мне удалось такое сварганить! Непонятно, в каком тумане какого моря я пребывал.. гость был я smile.gif
Короче, вот рабочий вариант. И - извини за дезу.. smile.gif
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.



Ну проверить не могу но вот это налепил по памяти.. должно работать..
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.