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

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

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

 
 Ответить  Открыть новую тему 
> Очередь, Наработки есть, помогите с решениеем.
сообщение
Сообщение #1





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

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


Основные действия с очередью я реализовал (очистить, проверить, добавить, удалить, прочитать 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.

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

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


Гость






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

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





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

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


Цитата(volvo @ 22.12.2010 19:56) *

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


Смысл сохранять содержимое очереди? можно же встроить эти 2 задачки, как процедуры? Чтобы вызывать их в главном меню. Следовательно, очередь у нас уже есть.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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

Вот так как-то (если элемент очереди - целочисленный) :
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 переменных: начало и конец очереди? Объедини их в одну структуру и работай с ней, меньше переменных - меньше вероятности совершить ошибку.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





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

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


Цитата(volvo @ 22.12.2010 21:05) *

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

Вот так как-то (если элемент очереди - целочисленный) :
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!! спасибо, сейчас попробую всё, чуть позже отпишусь, что получилось!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6





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

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


Цитата(volvo @ 22.12.2010 19:56) *

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

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

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

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

Цитата
Зачем таскать 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;
{---------------------------------------------------}


Сообщение отредактировано: Бунтарь -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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