IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> списки ООП
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Сергей

Репутация: -  0  +


Кому не трудно помогите, нужно несколько процедур:
1.Для однонапрвленного списка
а) найти наибольший элемент
б) удалить все простые числа
в)найти кол-во четных чисел
г) Вставить новый элемент между двумя равными по значению
2.Для двунаправленного списка
а)найти наибольший элемент(исп наследовательный метод)
б)найти количество четных (исп наследовательный метод)
Выручите пожалуйста, много других еще проблем а голова уже совсем не варит mega_chok.gif

Реализация списка:
Код
type list=^elem;
     elem=record
          inf:integer;
          next,pred:list;
          end;

     sp=object
        l:list;
        procedure init;
        procedure add(x:integer; p: list);
        procedure del(p:list);
        function locate(x:integer):list;
    function retrieve(p:list):integer;
        function end_:list;
        function first:list;
        procedure print;
        end;

    

     sp2=object
        l:list;
        procedure init;
        procedure add(x:integer; p: list);
        procedure del(p:list);
        function locate(x:integer):list;
    function retrieve(p:list):integer;
        function end_:list;
        function first:list;
        procedure print;
        end;

procedure sp.init;
          begin
          new(l);
          l^.inf:=0;
          l^.next:=nil;
          end;

procedure sp.add;
          var t:list;
              begin
              new(p^.next);
              p^.next^.info:=x;
              p^.next^.next:=t;
              end;

procedure sp.del;
begin
p^.next:=p^.next^.next;
end;

function sp.locate;
var p,q:list
begin
p:=l; q:=nil;
while p^.next<>nil do begin
    if p^.inf=x then q:=p;
    p:=p^.next;
    end;
locate:=q;
end;

function sp.retrieve;
var q:list;begin
q:=l;Retrieve:=0;
while q^.next<>nil do begin
    if q^.next=p then Retrieve:=q^.inf;
    q:=q^.next;
    end;
end;

function sp.end_;
var q:list;
begin
q:=l;
while q^.next<> nil do q:=q^.next;
end_:=q;
end;

function sp.first;
begin
first:=l^.next;
end

prosedure sp.print;
var q:list;
begin
q:=l;
while q<>nil do begin
        writeln(q^.info);
        q:=q^.next;
        end;
end;


procedure sp2.init;
          begin
          new(l1);
          l1^.inf:=0;
          l1^.next:=l1;
          l1^.pred:=l1;
          end;

function sp2.locate;
         var p,q:list;
             begin
             p:=l1^.next;
             q:=nil;
             while p<>l1 do begin
                            if p^.inf=x then q:=p;
                            p:=p^.next;
                            end;
             Nmesto:=q;
             end;

rocedure sp2.print;
          var p:list;
              begin
              writeln('Vivod polu4ennogo spiska');
              p:=l1^.next;
              while p<>l1 do begin
                             write(p^.inf,'  ');
                             p:=p^.next;
                             end;
              writeln;
              end;

var s:sp;
  x:integer;
begin
sp.init;
readln (x);
while x <> 0 do begin
        sp.add(x,sp.end_);
        readl(x);
        end;
writeln(sp.retrieve(sp.first));
sp.print;
end.



 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Ну, во-первых, где ты тут увидел реализацию списка? Я же приводил ООП-реализацию в теме
"FAQ: Объектно-ориентированное Программирование" ...

Для односвязных списков твое задание решается вот так:
type
ttype = integer;

ptitem = ^titem;
titem = object
info: ttype;
next: ptitem;

constructor init(x: ttype; nxt: ptitem);
destructor done;
end;

constructor titem.init(x: ttype; nxt: ptitem);
begin
info := x;
next := nxt
end;
destructor titem.done;
begin end;


type
tlist = object
first, last: ptitem;

constructor init;
destructor done;

procedure invert;

procedure append(x: ttype);
procedure insert(x: ttype);

function present(x: ttype): boolean;
function find(x: ttype): ptitem;
function remove(x: ttype): integer;

procedure insert_before(p: ptitem;
x: ttype);
procedure insert_after(p: ptitem;
x: ttype);

function empty: boolean;
procedure print;

private
procedure remove_item(var p: ptitem);
end;


constructor tlist.init;
begin
first := nil; last := nil;
end;
destructor tlist.done;
var p, T: ptitem;
begin
p := first;
while assigned(p) do begin
T := p;
p := p^.next;
dispose(T, done)
end;
end;

function tlist.empty: boolean;
begin
empty := not assigned(first)
end;

{
insert new item to the start of list
}
procedure tlist.insert(x: ttype);
var p: ptitem;
begin
new(p, init(x, first));
if empty then last := p;
first := p
end;

{
append new item to the end of list
}
procedure tlist.append(x: ttype);
var p: ptitem;
begin
new(p, init(x, nil));
if empty then first := p
else last^.next := p;
last := p
end;

procedure tlist.print;
var p: ptitem;
begin
p := first;
write('(list) <');
while assigned(p) do begin
write(p^.info, ' ');
p := p^.next
end;
writeln('>')
end;

procedure tlist.invert;
var p, T: ptitem;
begin
if empty or (not assigned(first^.next)) then exit
else begin
p := nil; last := first;
while assigned(first) do begin
T := first^.next;
first^.next := p;
p := first;
first := T
end;
first := p
end
end;

procedure tlist.insert_before(p: ptitem;
x: ttype);
var T: ptitem;
begin
new(T, init(p^.info, p^.next));
p^.next := T;
p^.info := x
end;
procedure tlist.insert_after(p: ptitem;
x: ttype);
var T: ptitem;
begin
new(T, init(x, p^.next));
p^.next := T
end;

function tlist.find(x: ttype): ptitem;
var
p: ptitem;
ok: boolean;
begin
p := first;
ok := true;
while assigned(p) and ok do
if p^.info = x then ok := false
else p := p^.next;

find := p
end;

function tlist.present(x: ttype): boolean;
begin
present := (find(x) <> nil)
end;


function tlist.remove(x: ttype): integer;
var
T: ptitem;
count: integer;
begin
count := 0;
repeat
T := find(x);
if assigned(T) then begin
remove_item(T);
inc(count)
end
until (T = nil);
remove := count
end;

procedure tlist.remove_item(var p: ptitem);
var r: ptitem;
begin
if p = first then
if first = last then begin
dispose(p);
p := nil; first := nil; last := nil;
exit;
end
else begin
r := first;
first := first^.next;
dispose( r );
p := first;
exit;
end;

r := first;
while r^.next <> p do r := r^.next;
if p = last then last := r;

r^.next := p^.next;
dispose(p);
p := r^.next;

end;

function isPrime(X: integer): boolean;
var i: integer;
begin
isPrime := false;
for i := 2 to trunc(sqrt(x)) do
if x mod i = 0 then exit;
isPrime := true
end;

var
lst_1: tlist;
p: ptitem;
X, count: integer;

begin
lst_1.init;
repeat
readln(X);
if X <> 0 then lst_1.append(X);
until X = 0;
lst_1.print;

{ #1 }
p := lst_1.first; X := - maxInt;
while p <> nil do begin

if p^.info > X then X := p^.info;
p := p^.next;

end;
writeln('max = ', X);

{ #2 }
p := lst_1.first;
while p <> nil do begin

if isPrime(p^.info) then
lst_1.remove_item(p)
else p := p^.next;

end;
lst_1.print;

{ #3 }
p := lst_1.first;
count := 0;
while p <> nil do begin
if not odd(p^.info) then inc(count);
p := p^.next;
end;
writeln(count, ' even numbers in list...');

{ #4 }
p := lst_1.first;
X := 101;
if p <> nil then
while p^.next <> nil do begin

if p^.info = p^.next^.info then lst_1.insert_after(p, X);
p := p^.next;

end;
lst_1.print;

lst_1.done;
end.
(просто оформи нужные фрагменты программы как методы класса TList)

С двусвязными попробуй разобраться сам...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Сергей

Репутация: -  0  +


О, огромное спасибо good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 4.10.2024 12:57
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name