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

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

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

 
 Ответить  Открыть новую тему 
> Стеки
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


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



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


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


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

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

Репутация: -  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 килобайт ) Кол-во скачиваний: 558

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

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

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

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

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

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


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

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

 





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