Основные действия с очередью я реализовал (очистить, проверить, добавить, удалить, прочитать 1 и посл. элемент).

Вот реализация всех действий с очередью:

Program ochered;
Uses crt;
Type spd = ^Tspd;
     Tspd = record
     data:string;
     next,last:spd;
     end;
Var op:integer;
    stek, stek1,stek2:spd;
    st0,st1,st2:spd;
    data:string;
procedure add(var sp,st:spd; data:string);
var temp:spd;
begin
new(temp);
temp^.data:=data;
temp^.next:=nil;
 if sp = nil
  then
   begin
   temp^.last:=nil;
   sp:=temp;
   st:=sp;
    end
     else
      begin
      temp^.last:=st;
      st^.next:=temp;
      st:=temp;
    end;
 end;
procedure view(sp:spd);
begin
 if sp = nil
  then
   writeln('ochered pysta');
while sp<>nil do
 begin
 write(sp^.data,'  ');
 sp:=sp^.next;
 end;
end;
function proverka(sp:spd):boolean;
begin
 if sp = nil
  then
   proverka:=false
  else
   proverka:=true;
end;
function del(var sp, st:spd):string;
var temp:spd;
begin
 if sp = nil
  then
   begin
   writeln('Error: ochered pysta ');
   readkey;
   exit;
 end;
del:=sp^.data;
temp:=sp;
sp:=sp^.next;
 if sp = nil
  then
   st:=nil;
dispose(temp);
end;
procedure clear(var sp, st:spd);
var temp:spd;
begin clrscr;
 while sp<>nil do
 begin
 temp:=sp;
 sp:=sp^.next;
 dispose(temp);
 end;
 st:=nil;
end;
function read_the_first_element(sp:spd):string;
var a:string;
begin
   a:=sp^.data;
   read_the_first_element:=a;
end;
function read_the_last_element(st:spd):string;
var a:string;
begin
   a:=st^.data;
   read_the_last_element:=a;
end;
begin
st0:=nil;
repeat
clrscr;
writeln;
writeln('1-add element');
writeln('2-del element');
writeln('3-view ochered');
writeln('4-clear ochered');
writeln('5-read_1_element');
writeln('6-read_posledn.element');
writeln;
writeln('0-exit');
readln(op);
case op of
1:begin
   clrscr;
   write('vvedite znachenie dobavl. elementa ');
   readln(data);
   clrscr;
   add(stek, st0, data);
   writeln;
   writeln('element dobavlen');
   writeln;
   writeln('vasha ochered ');
   writeln;
   view(stek);
   writeln;
   writeln;
   writeln('najmite klavishy');
   readkey;
   end;
2:begin
   clrscr;
   if proverka(stek) then
    begin
    writeln(' element ', del(stek, st0),' udalen ');
    writeln;
    writeln('vasha ochered');
    writeln;
    view(stek);
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
   end else
   begin
    writeln('ydalenie ne vozmojno - ochered pysta');
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
   end;
  end;
3: begin
    clrscr;
    writeln;
    writeln('vasha ochered');
    writeln;
    view(stek);
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
   end;
4:begin
  clear(stek, st0);
  writeln('vasha ochered ochishena');
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
  end;
5:begin
   clrscr;
   writeln;
   writeln(''prochten. pervyu element');
   writeln;
   writeln(read_the_first_element(stek));
   writeln;
   writeln('vasha ochered');
   writeln;
   view(stek);
   writeln;
   writeln;
   writeln('najmite klavishy');
   readkey;
end;
6:begin
   clrscr;
   writeln;
   writeln('prochten. posled element');
   writeln;
   writeln(read_the_last_element(st0));
   writeln;
   writeln('vasha ochered');
   writeln;
   view(stek);
   writeln;
   writeln;
   writeln('najmite klavishy');
   readkey;
end;
0:begin
    exit;
    end;
    end;
until op=0;
end.

Хочу встроить в данную программу, эти 2 маленькие задачки, вызывая их в основной программе.

1.Пусть уже построена очередь Q, содержащая целые числа. Вычислить сумму и произведение элементов, находящихся в очереди.

2.Пусть уже построена очередь Q, содержащая целые числа. Вычислить количество элементов очереди кратных 3.

Подскажите как реализовать эти програмки.

Сообщение отредактировано: Бунтарь - 26.12.2010 10:38

Сохраняя содержимое очереди, или им можно пожертвовать? По второй программе этот вопрос тоже в силе. Если без сохранения содержимого - то реализация тривиальна: до тех пор, пока очередь не пуста, читать элемент и производить с ним определенное действие. При возможности создать доп. очередь - тоже все просто. Если без создания доп. очереди и с сохранением исходной - вот тут надо подумать...

P.S. Операции с очередью - это Put (добавляющая элемент в конец) и Get (читающая элемент из начала). Ну, и проверка на пустоту. Чтение первого и последнего элемента обычно не является допустимой операцией. Только извлечение первого...

Смысл сохранять содержимое очереди? можно же встроить эти 2 задачки, как процедуры? Чтобы вызывать их в главном меню. Следовательно, очередь у нас уже есть.

Очередь есть, но после выполнения этих процедур ее как бы уже и нет, а захочет потом пользователь еще раз посмотреть, что ж за очередь была, для которой такой результат получился - тогда что делать будешь? Ну смотри, дело твое...

Вот так как-то (если элемент очереди - целочисленный) :

var 
  s, p: longint;
  value: integer;

s := 0; p := 1;
while not proverka(q) do
begin
  value := del(q, q0);
  s := s + value; p := p * value;
end;

Хотя можно сделать более внятно, если чуть-чуть изменить интерфейс:

type
  item = string;
  pqueue_item = ^queue_item;
  queue_item = 
  record
    data: item;
    next: pqueue_item;
  end;

  queue = record
    first, last: pqueue_item;
  end;

procedure put(var q: queue; value: item);
// ...

function get(var q: queue): item;
// ...

function empty(var q: queue): boolean;
// ...

s := 0; p := 1;
while not empty(q) do
begin
  value := get(q);
  s := s + value; p := p * value;
end;

Зачем таскать 2 переменных: начало и конец очереди? Объедини их в одну структуру и работай с ней, меньше переменных - меньше вероятности совершить ошибку.

volvo!! спасибо, сейчас попробую всё, чуть позже отпишусь, что получилось!!!

У меня по заданию нужно именно вот так:очистить, проверить, добавить, удалить, прочитать 1 и посл. элемент. С условием не поспоришь)


Можно программу запустить 2 раза, для наглядного примера. Ну не в этом суть)


Обязательно это учту не будущее, спасибо за совет, volvo!

Вот что получилось:

procedure zadacha1 (var sp:spd);
Var s,p:longint;
    value:integer;
begin
while not proverka (sp) do
begin
s:=0;p:=1;
     value:=del(sp); 
     s:=s+value;
     p:=p*value;
     end;
{---------------------------------------------------}

Сообщение отредактировано: Бунтарь - 26.12.2010 10:34