ЗЫ я знаю что это решалось.. но мне надо именно доделать (переделать) эту.. А именно удалить элементы а не скрыть..:
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 4:07
if A[i]=A[j] then s:=s+1; if s<=1 then
после етого должно идти удаление как я понимаю... подскажите команду или команды нужные для етого...
Артемий
21.11.2007 15:33
А можно условие конкретней?Что именно нужно удалять?
Добавлено через 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
22.11.2007 23:46
Надо удалить не повторяющиеся элементы! ну типа есть 3 4 5 3 6 4 должно стать 3 4 3 4
Гость
27.11.2007 15:05
скиньте ссылку на похожее пожалуйста..
Гость
27.11.2007 15: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
27.11.2007 15:44
Если задавать массив константой - то примерно так:
Вот этого не видет.. типа неизвестная команда мув..
Добавлено через 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.
Ну, если твоему компилятору неизвестен Move - то он у тебя битый, бери другой дистрибутив и устанавливай... Вообще-то программа отработала, так что извини, но в следующий раз клевета будет наказываться минусами... Надоело мне с вами цацкаться! Это видишь - ли не работает ему, да это не так откомментировали... Ути-пути, ложечку за маму, ложечку за папу скушал, малыш?
Fraddy
29.11.2007 2:02
Цитата(volvo @ 28.11.2007 19:55)
Ну, если твоему компилятору неизвестен Move - то он у тебя битый, бери другой дистрибутив и устанавливай... Вообще-то программа отработала, так что извини, но в следующий раз клевета будет наказываться минусами... Надоело мне с вами цацкаться! Это видишь - ли не работает ему, да это не так откомментировали... Ути-пути, ложечку за маму, ложечку за папу скушал, малыш?
У меня винда ВИСТА на ней идет тока паскаль АБЦ который, мать его как оказалось, не читает мув... уж извените такая вот засада... Ну программа значит работает - за это спасибо... я проверить не могу покачто, но буду разбираться.. и странно что мув не работает.. вроде последняя версия. Короче спасибоо
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
29.11.2007 17:22
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.
Ну проверить не могу но вот это налепил по памяти.. должно работать..
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.