Проверьте програмку. а то при выполнении вылетает из паскаля ;)

 
{Дано два однонаправленных списка целых чисел. Удалить во втором списке все
 элементы, больше среднеарифметического положительных элементов первого
 списка и продублировать все элементы второго списка, меньше среднего арифметического четных элементов первого списка}
type list=^elem;
     elem=record
                inf:integer;
                next:list;
                end;
var p,l,o,i,q,w:list;
    x,z,u:integer;
    a,s:real;
begin
 writeln('Введите первый список: ');
 new(p);
 l:=p;
 readln(x);
 p^.inf:=x;
 readln(x);
  while x<>0 do
   begin
    new(q);
    q^.inf:=x;
    p^.next:=q;
    p:=q;
    readln(x);
   end;
  p^.next:=nil;
  p:=l;
  writeln('Введите второй список: ');
  new(o);
  i:=o;
  readln(x);
  o^.inf:=x;
  readln(x);
   while x<>0 do
    begin
     new(w);
     w^.inf:=x;
     w^.next:=w;
     o:=w;
     readln(x);
    end;
  o^.next:=nil;
  o:=i;
   while p^.next<>nil do
    begin
     if p^.inf >= 0 then
      begin
       s:=s+p^.inf;
       inc(u);
       p:=p^.next;
      end;
     if p^.inf mod 2 <> 0 then
      begin
       a:=a+p^.inf;
       inc(z);
       p:=p^.next;
      end;
    end;
   a:=a/z;
   s:=s/u;
    while o^.next^.next<>nil do
     begin
      if o^.next^.inf>s then
       begin
        o^.next:=o^.next^.next;
        o:=o^.next;
       end;
      if o^.inf<a then
       begin
        new(i);
        i^.inf:=o^.inf;
        l:=o^.next;
        o^.next:=i;
        i^.next:=l;
        o:=o^.next;
       end;
     end;
  writeln('Вывод списка:');
  o:=i;
   while o<>nil do
    begin
     writeln(o^.inf);
      o:=o^.next;
    end;
  readln
end.

.

Нет, так не пойдет Попробуй разбить программу на процедуры и функции (в частности - добавление элемента в список однозначно переноси в процедуру)... Программа станет намного проще, вот увидишь...

Ну в в принципе нечего не изменилось, нашел только ошибку при вводе списка, но как обычно прога не работает, но теперь хоть не вылетает

type list=^elem;
     elem=record
                inf:integer;
                next:list;
                end;
var q,l,p,o,i:list;
    x,z,u:integer;
    a,s:real;
procedure inputlist(var p:list);
var l,q:list;
    x:integer;
begin
 writeln('Введите список: ');
 new(l);
 p:=l;
 readln(x);
 p^.inf:=x;
 readln(x);
  while x<>0 do
   begin
    new(q);
    q^.inf:=x;
    p^.next:=q;
    p:=q;
    readln(x);
   end;
  p^.next:=nil;
end;
procedure dob(var o:list);
   var i:list;
begin
    while o^.next^.next<>nil do
     begin
      if o^.next^.inf>s then
       begin
        o^.next:=o^.next^.next;
        o:=o^.next;
       end;
      if o^.inf<a then
       begin
        new(i);
        i^.inf:=o^.inf;
        l:=o^.next;
        o^.next:=i;
        i^.next:=l;
        o:=o^.next;
       end;
      end
end;
begin
     inputlist(p);
     inputlist(o);
   while p^.next<>nil do
    begin
     if p^.inf >= 0 then
      begin
       s:=s+p^.inf;
       inc(u);
       p:=p^.next;
      end;
     if p^.inf mod 2 <> 0 then
      begin
       a:=a+p^.inf;
       inc(z);
       p:=p^.next;
      end;
    end;
   a:=a/z;
   s:=s/u;
   dob(o);
  writeln('Вывод списка:');
   while o<>nil do
    begin
     writeln(o^.inf);
      o:=o^.next;
    end;
  readln
end.
 

если ты воспользуешься модулем из FAQ"a, дело пойдет быстрее

Oleg_Z, чето я ничего нужного в этом модуле для решения задачи ненашел , но может не въехал я, если че подскажи

Тебе оттуданадо взять процедуру инициализации, уничтожения, и добавления жлемента.
А все задание выполняется за счет прохода по списку.
это делается так:

var
 l:tlist;
begin
 {..}
 while  L<>nil do 
 begin {делаемчто-то}
  l:=L^.next;
 end;
end.
  
 

Смотри:

type
  ref=^elem;
  elem=record
    inf: integer;
    next: ref;
  end;

  tlist = record
    first, last: ref;
  end;

{ добавление элемента в список }
procedure append(var p: tlist; x: integer);
var pt: ref;
begin
  new(pt);
  pt^.inf := x;
  pt^.next := nil;

  if p.first = nil then
    p.first := pt
  else p.last^.next := pt;
  p.last := pt;
end;

{ уделение элемента, на который указывает P из списка }
procedure remove_item(var p: ref);
var r: ref;
begin
  r := p^.next;
  p^ := r^;
  dispose®;
  r := nil
end;

{ добавление значения X после элемента, на который указывает P }
procedure insert_after(p: ref;
          x: integer);
var T: ref;
begin
  new(T);
  T^.inf := x;
  T^.next := p^.next;
  p^.next := T
end;

{ печать списка }
procedure print(list: tlist);
var p: ref;
begin
  writeln;
  p := list.first;
  while p <> nil do begin
    write(p^.inf:5);
    p := p^.next
  end;
  writeln;
end;

{ ввод данных в список }
procedure inputlist(var p: tlist);
var x:integer;
begin
  repeat
    readln(x);
    if x <> 0 then append(p, x);
  until x = 0;
end;

var
  f_list, s_list: tlist;
  p: ref;
  s, s_chet: real;
  count, count_chet: integer;
begin
  writeln('Первый список:');
  inputlist(f_list);
  print(f_list);

  writeln('Второй список');
  inputlist(s_list);
  print(s_list);


  p := f_list.first;
  s := 0; s_chet := 0;
  count := 0; count_chet := 0;
  while p <> nil do begin
    if p^.inf > 0 then begin
      s := s + p^.inf; inc(count);
    end;
    if not odd(p^.inf) then begin
      s_chet := s_chet + p^.inf; inc(count_chet)
    end;
    p := p^.next;
  end;

  { подсчет средних значений }
  if count <> 0 then
    s := s / count;
  if count_chet <> 0 then
    s_chet := s_chet / count_chet;


  p := s_list.first;
  while p <> nil do begin
    if p^.inf > s then remove_item(p)
    else p := p^.next;
  end;

  writeln('Второй список после удаления элементов:');
  print(s_list);

  p := s_list.first;
  while p <> nil do begin
    if p^.inf < s_chet then begin
      insert_after(p, p^.inf);
      p := p^.next;
    end;
    p := p^.next;
  end;

  writeln('Второй список после дублирования:');
  print(s_list);
end.

Тестировалось на таких данных:
1 список: <2, -2, 4, -6, -8, 3, 5, 1>
2 список: <1, -1, -5, 12, 4, -3, 1, 2>

Предполагаемый результат: <1, -1, -5, -5, -3, -3, 1, 2>

А по поводу этого: - в FAQ-е выложен модуль, в котором по крайней мере 4 первых процедуры уже присутствуют... А в ООП-версии присутствуют вообще все вспомогательные функции, и можно было бы сразу начинать основную программу... Есть разница?

Вобщем требуется срочная помощь)
задание на списки.

Для всех заданий для выбранных структур кроме указанных функций и процедур должны быть описаны функции и процедуры для работы с этим типом данных (например для стека: очистить стек; добавить элемент в стек; удалить элемент из стека и т.д.):

1. Одно из возможных представлений “длинного” текста - это разделить его на участки (строки) равной длины. Используя представление текста в виде двунаправленного списка, описать:

- функцию Числострок (T) для подсчета числа строк в тексте Т;
- процедуру Добавить (T,I,J), добавляющую после I-той строки текста Т копию J–той строки;
- процедуру Перестановка (T,I,J),меняющую местами I-тую и J–тую строки текста Т.

желательно с комментариями. спасибо!

Ну, что, еще раз повторить?
FAQ читал? Там все функции для работы со списком приведены, сколько можно одни и те же вопросы задавать? В поиске найди подобное задание, и измени как тебе нужно. Десятки задач на списки были решены на форуме...

сори конечно но времени нету самому мутить. катастрофа!

У каждого человека каждый день бывают катастрофы, и твоя не важнее всех других. читай фак, там все написано