All pastes #982614 Raw Edit

Miscellany

public text v1 · immutable
·published 2008-04-12 18:59 UTC
rendered paste body
program list;

type
  PElement = ^Element;
  Element = record
    data: integer;
    prev: PElement;
    next: PElement;
  end;

procedure list_create(var head: PElement; data: integer);
begin
  new(head);
  head^.data := data;
  head^.next := head;
  head^.prev := head;
end;

procedure list_appbeg(var head: PElement; data: integer);
var
  p: PElement;
begin
  new(p);
  p^.data := data;
  head^.prev^.next := p;
  p^.prev :=  head^.prev;
  head^.prev := p;
  p^.next := head;
  head := p;
end;

procedure list_print(head: PElement);
var
  p: PElement;
begin
  p := head;
  repeat
    write(p^.data,' ');
    p := p^.next;
  until p = head;
  writeln(' ');
end;

procedure search_middle(var head: PElement; var i:integer);
var
  p: PElement;
begin
  p := head^.next;
  i := 1;
  while p <> head do
    begin
      p := p^.next;
      i := i+1;
    end;
  i := i div 2 - 1;
end;

procedure add_in_middle(var head:PElement; i:integer);
var
  p, k: PElement;
  poz: integer;
begin
  p:= head;
  for poz:=1 to i do
    p := p^.next;
  new(k);
  writeln('Input data of new element:');
  read(k^.data);
  p^.next^.prev := k;
  k^.next := p^.next;
  k^.prev:=p;
  p^.next := k;
end;

procedure search_min(head:PElement; var min:PElement);
var
  p:PElement;
begin
  min:=head;
  p:=head;
  repeat
    p:=p^.next;
    if min^.data>p^.data then min:=p
  until p=head
end;

procedure delete_min(var head:PElement; var min:PElement);
begin
  if min = head then head:=head^.next;
  min^.next^.prev := min^.prev;
  min^.prev^.next := min^.next;
  dispose(min);
end;

function count(head: PElement; var i:integer):integer;
var
  p: PElement;
begin
  p := head^.next;
  i := 1;
  while p <> head do
    begin
      p := p^.next;
      i := i+1;
    end;
count:=i;
end;

procedure edit_num(number:integer; var head:PElement; editElem:PElement);
var
  i,max_num:integer;
  k:PElement;
begin
  max_num:=count(head,i);
  read(editElem^.data);
  k:=head;
  if number>max_num then writeln('Element not found!') else
  begin
  if number=1 then head^.data:=editElem^.data
  else
  for i:=2 to number do k:= k^.next;
  k^.data:=editElem^.data;
  writeln('After editing element: ');
  list_print(head);
  end;
end;



var
  head:     PElement;
  p:        PElement;
  min:      PElement;
  editElem: PElement;
  data:     integer;
  i, num:   integer;
  action:   integer;
  number:   integer;
begin
  writeln('Create list:');
  write('Enter data of first element: ');
  read(data);
  list_create(head, data);
  repeat
  writeln('--------------------------------');
  writeln('Choose Action:');
  writeln('1: Add n elements before head.');
  writeln('2: Add one element in middle.');
  writeln('3: Delete minimal element.');
  writeln('4: Edit data of element.');
  writeln('5: Exit.');
  read(action);
  if (action>5) or (action<1) then writeln('Warning!!! Input error!!!')
    else
  case action of
  1:
    begin
      write('Input number of element, which You want to add: ');
      read(num);
      write('Input data: ');
      for i:=1 to num do
        begin
          read(data);
          list_appbeg(head, data);
        end;
      writeln('After adding in begin: ');
      list_print(head);
    end; {Add before head}
  2:
    begin
      writeln('Adding in middle: ');
      search_middle(head, i);
      add_in_middle(head, i);
      writeln('After adding in middle: ');
      list_print(head);
    end; {Add in middle}
  3:
    begin
      writeln('After deleting minimal element: ');
      search_min(head,min);
      delete_min(head,min);
      list_print(head);
    end; {Delete min}
  4:
    begin
      write('Input number of element which You want to edit: ');
      read(number);
      write('Input data of element which You want to edit: ');
      edit_num(number,head,editElem);
    end; {Edit element}
  end;
  until action=5
end.