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

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

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

 
 Ответить  Открыть новую тему 
> Стеки
Людмила
сообщение 21.04.2005 21:24
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

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


Помогите разобраться, такая ерунда получается просто жуть. sad.gif


Uses CRT;

type
TElem = string;
TStack = ^TElement;
TElement = record
info:TElem;
Next:TStack
end;
Procedure StackPush(var S:TStack; E:TElem);
Procedure print;

Procedure StackPush(var S:TStack; E:TElem);
var
z:TStack;
begin
new(z);
z^.next:=s;
Z^.INFO:=E;
s:=z;
end;
Procedure print (p:Tstack);
var i: integer;
begin
for i:=1 to length(p^.info) do
begin
Write(p^.info[i]);
end;
end;

const
gl: set of char = ['a', 'e', 'i', 'j', 'o', 'u', 'y'];
sogl: set of char = ['b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'g', 'r', 's', 't', 'v', 'w', 'x', 'z'];

var
s: string;
stekgl: Tstack;
steksogl: Tstack;
i: byte;
begin
ClrScr;
writeln('vvedite tekst: ');
readln(s);
for i := 1 to length(s) do
begin
if s[i] in gl then begin StackPush(stekgl, s[i]) end
else
if s[i] In sogl Then
begin StackPush(steksogl, s[i]) end;
end;
ClrScr;
writeln;
writeln('tekst: ', s);
writeln;
writeln('glasnie iz teksta: ');
print(stekgl);
writeln('soglasnie iz teksta: ');
print(steksogl);
writeln;
ReadKey
end.



Задание – Последовательность символов, ограниченную точкой, занести в два стека, содержащих гласные и согласные буквы. Вывести текст и элементы из обоих стеков.


--------------------
хороших людей мало... полезных ещё меньше....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 21.04.2005 21:53
Сообщение #2


Гость






Ну почему же жуть? Просто вот так будет правильней...
Uses CRT;

type
TElem = char; { зачем тут была строка? }
TStack = ^TElement;
TElement = record
info:TElem;
Next:TStack
end;

{ заносим данные в стек }
Procedure StackPush(var S:TStack; E:TElem);
var z:TStack;
begin
new(z);
z^.next:=s;
Z^.INFO:=E;
s:=z;
end;

{ забираем данные из стека }
function StackPop(var s: tstack): TElem;
var p: TStack;
begin
stackpop := #0; { это на случай если стек пустой }
if s <> nil then begin
p := s;
s := s^.next;
stackpop := p^.info;
dispose(p)
end;
end;

{ Печатаем стек, одновременно забирая из него элементы }
Procedure print(p:Tstack);
var i: integer;
begin
while p <> nil do
Writeln(StackPop(p));
end;

const
gl: set of char = ['a', 'e', 'i', 'j', 'o', 'u', 'y'];
sogl: set of char = ['b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'g', 'r', 's', 't', 'v', 'w', 'x', 'z'];

var
s: string;
stekgl: Tstack;
steksogl: Tstack;
i: byte;
begin
ClrScr;
writeln('vvedite tekst: ');
readln(s);
for i := 1 to length(s) do begin
if s[i] in gl then StackPush(stekgl, s[i])
else
if s[i] In sogl Then StackPush(steksogl, s[i])
end;
ClrScr;
writeln;
writeln('tekst: ', s);
writeln;
writeln('glasnie iz teksta: ');
print(stekgl);
writeln('soglasnie iz teksta: ');
print(steksogl);
writeln;
ReadKey
end.

Вот и все smile.gif
 К началу страницы 
+ Ответить 
Людмила
сообщение 21.04.2005 21:58
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 43
Пол: Женский

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


Цитата(volvo @ 22.04.05 0:53)
Ну почему же жуть? Просто вот так будет правильней...
Вот и все smile.gif



Работает!!! Огромное спасибо!


--------------------
хороших людей мало... полезных ещё меньше....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Altair
сообщение 21.04.2005 21:58
Сообщение #4


Ищущий истину
******

Группа: Модераторы
Сообщений: 4 824
Пол: Мужской
Реальное имя: Олег

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


Сама программа:

uses crt,stack,charlist;
var
G,S:TStack;
P:Tlist;
c:char;
MG,MS:set of char;
begin
BListinit(P);
repeat
c:=readkey;
write©;
BListAddLast(P,c);
until c='.';
MG:=['a', 'e', 'i', 'j', 'o', 'u', 'y'];
MS:=['b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'g', 'r', 's', 't', 'v', 'w', 'x', 'z'];
StackInit(G); StackInit(S);
while P <> nil DO
begin
c:=P^.Info;
if c in MG then stackpush(G,C);
if c in ms then stackpush(S,C);
P := P^.Next
end;
writeln;
writeln('согл.');
while S <> nil DO
begin
c:=S^.Info;
write(c,' ');
S := S^.Next
end;
writeln;
writeln('гласн.');
while G <> nil DO
begin
c:=G^.Info;
write(c,' ');
G := G^.Next
end;
end.

Модуль stack:Прикрепленный файл  stack.pas ( 1.07 килобайт ) Кол-во скачиваний: 373

молуль charlist: Прикрепленный файл  charlist.pas ( 148 байт ) Кол-во скачиваний: 386

и файл list.pas: Прикрепленный файл  list.pas ( 2.44 килобайт ) Кол-во скачиваний: 393

volvo быстрее...
p.s. все реализованно по материалам FAQ'a.....
модуль charlist - шаблон для работы с модулем LIST, (в списокмы помещаем символы) а stack - модуль для работы со стеком.

p.s.
writeln('vvedite tekst: ');
readln(s);

Попробую защититься - учто если последовательность больше 255 символов? smile.gif

Сообщение отредактировано: Oleg_Z - 21.04.2005 22:02


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



- Текстовая версия 21.07.2025 10:11
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"