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

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

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

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


Новичок
*

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

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


Сама задача простая: бьет ли карта 1 карту 2 с учетом козырной масти. Но! препод помешана на менюшках, требует, чтобы все было максимально удобно для пользователя и всевозможные случаи были учтены...естественно, достоинства карт и масти должны вводится с клавиатуры на русском...если, что не так, то необходимо оповестить пользователя...и тд.
Задачу я написала, вроде работает...но как-то мне не нравится...очень много и коряво...
Помогите, пожалуйста, подсократить, исправить ее, сделать более рациональным решение...

program zapis;

{$APPTYPE CONSOLE}

uses
SysUtils,
windows;

type
suit=(spades, clubs, diamonds, hearts);
size=(six, seven, eight, nine, ten, jack, queen, king, ace);
card= record
m:suit;
d:size
end;
var u:char;
a,b1,b2,c1,c2,yes:boolean;
K1,K2:card; KM:suit;
m1,m2,d1,d2:string;

procedure input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string; var a,b1,b2,c1,c2:boolean);
var kz:string;
begin
writeln ('Введите козырную масть');
readln(kz);
writeln('Введите первую карту');
write('масть: '); readln(m1);
write('достоинство: '); readln(d1);
writeln('Введите вторую карту');
write('масть: '); readln(m2);
write('достоинство: '); readln(d2);

a:=true;
b1:=true;
b2:=true;
c1:=true;
c2:=true;

if (kz='пики') then KM:=spades
else if (kz='трефы') then KM:=clubs
else if (kz='бубны') then KM:=diamonds
else if (kz='червы') or (kz='черви') then KM:=hearts
else begin a:=false;
writeln('Неправильно введена козырная масть!')
end;

if (m1='пики') then K1.m:=spades
else if (m1='трефы') then K1.m:=clubs
else if (m1='бубны') then K1.m:=diamonds
else if (m1='червы') or (m1='черви') then K1.m:=hearts
else begin b1:=false;
writeln('Неправильно введена масть первой карты!')
end;

if (m2='пики') then K2.m:=spades
else if (m2='трефы') then K2.m:=clubs
else if (m2='бубны') then K2.m:=diamonds
else if (m2='червы') or (m2='черви') then K2.m:=hearts
else begin b2:=false;
writeln('Неправильно введена масть второй карты!')
end;

if (d1='шесть')or(d1='шестерка')or(d1='6') then K1.d:=six
else if (d1='семь')or(d1='семерка')or(d1='7') then K1.d:=seven
else if (d1='восемь')or(d1='восьмерка')or(d1='8') then K1.d:=eight
else if (d1='девять')or(d1='девятка')or(d1='9') then K1.d:=nine
else if (d1='десять')or(d1='десятка')or(d1='10') then K1.d:=ten
else if (d1='валет') then K1.d:=jack
else if (d1='дама') then K1.d:=queen
else if (d1='король') then K1.d:=king
else if (d1='туз') then K1.d:=ace
else begin c1:=false;
writeln('Неправильно введено достоинство первой карты!')
end;

if (d2='шесть')or(d2='шестерка')or(d2='6') then K2.d:=six
else if (d2='семь')or(d2='семерка')or(d2='7') then K2.d:=seven
else if (d2='восемь')or(d2='восьмерка')or(d2='8') then K2.d:=eight
else if (d2='девять')or(d2='девятка')or(d2='9') then K2.d:=nine
else if (d2='десять')or(d2='десятка')or(d2='10') then K2.d:=ten
else if (d2='валет') then K2.d:=jack
else if (d2='дама') then K2.d:=queen
else if (d2='король') then K2.d:=king
else if (d2='туз') then K2.d:=ace
else begin c2:=false;
writeln('Неправильно введено достоинство второй карты!')
end
end;

function cover(K1,K2:card;KM:suit; var yes:boolean):boolean;

begin
if K1.m=K2.m then yes:=K1.d>K2.d
else yes:=K1.m=KM
end;




begin
setconsolecp(1251);
setconsoleoutputcp(1251);
repeat
input_data(K1,K2,KM,m1,m2,d1,d2,a,b1,b2,c1,c2);
if (a=true) and (b1=true) and (b2=true) and (c1=true) and (c2=true) then
begin
cover (K1,K2,KM,yes);
if yes then writeln (d1,' ',m1,' бьет ',d2,' ',m2)
else writeln (d1,' ',m1,' не бьет ',d2,' ',m2)
end;
writeln('Вы хотите выйти?(Д/Н)');
readln(u)
until (u='Д') or (u='д')
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Человек
*****

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

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


<<и коряво...>>
а взять в теги не пробывала


--------------------
Спасибо!
Удачи!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


Не судите строго... wub.gif я здесь в первый раз...еще не со всем разобралась...

Исправляюсь...

program zapis;

{$APPTYPE CONSOLE}

uses
SysUtils,
windows;

type
suit=(spades, clubs, diamonds, hearts);
size=(six, seven, eight, nine, ten, jack, queen, king, ace);
card= record
m:suit;
d:size
end;
var u:char;
a,b1,b2,c1,c2,yes:boolean;
K1,K2:card; KM:suit;
m1,m2,d1,d2:string;

procedure input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string; var a,b1,b2,c1,c2:boolean);
var kz:string;
begin
writeln ('Введите козырную масть');
readln(kz);
writeln('Введите первую карту');
write('масть: '); readln(m1);
write('достоинство: '); readln(d1);
writeln('Введите вторую карту');
write('масть: '); readln(m2);
write('достоинство: '); readln(d2);

a:=true;
b1:=true;
b2:=true;
c1:=true;
c2:=true;

if (kz='пики') then KM:=spades
else if (kz='трефы') then KM:=clubs
else if (kz='бубны') then KM:=diamonds
else if (kz='червы') or (kz='черви') then KM:=hearts
else begin a:=false;
writeln('Неправильно введена козырная масть!')
end;

if (m1='пики') then K1.m:=spades
else if (m1='трефы') then K1.m:=clubs
else if (m1='бубны') then K1.m:=diamonds
else if (m1='червы') or (m1='черви') then K1.m:=hearts
else begin b1:=false;
writeln('Неправильно введена масть первой карты!')
end;

if (m2='пики') then K2.m:=spades
else if (m2='трефы') then K2.m:=clubs
else if (m2='бубны') then K2.m:=diamonds
else if (m2='червы') or (m2='черви') then K2.m:=hearts
else begin b2:=false;
writeln('Неправильно введена масть второй карты!')
end;

if (d1='шесть')or(d1='шестерка')or(d1='6') then K1.d:=six
else if (d1='семь')or(d1='семерка')or(d1='7') then K1.d:=seven
else if (d1='восемь')or(d1='восьмерка')or(d1='8') then K1.d:=eight
else if (d1='девять')or(d1='девятка')or(d1='9') then K1.d:=nine
else if (d1='десять')or(d1='десятка')or(d1='10') then K1.d:=ten
else if (d1='валет') then K1.d:=jack
else if (d1='дама') then K1.d:=queen
else if (d1='король') then K1.d:=king
else if (d1='туз') then K1.d:=ace
else begin c1:=false;
writeln('Неправильно введено достоинство первой карты!')
end;

if (d2='шесть')or(d2='шестерка')or(d2='6') then K2.d:=six
else if (d2='семь')or(d2='семерка')or(d2='7') then K2.d:=seven
else if (d2='восемь')or(d2='восьмерка')or(d2='8') then K2.d:=eight
else if (d2='девять')or(d2='девятка')or(d2='9') then K2.d:=nine
else if (d2='десять')or(d2='десятка')or(d2='10') then K2.d:=ten
else if (d2='валет') then K2.d:=jack
else if (d2='дама') then K2.d:=queen
else if (d2='король') then K2.d:=king
else if (d2='туз') then K2.d:=ace
else begin c2:=false;
writeln('Неправильно введено достоинство второй карты!')
end
end;

function cover(K1,K2:card;KM:suit; var yes:boolean):boolean;

begin
if K1.m=K2.m then yes:=K1.d>K2.d
else yes:=K1.m=KM
end;




begin
setconsolecp(1251);
setconsoleoutputcp(1251);
repeat
input_data(K1,K2,KM,m1,m2,d1,d2,a,b1,b2,c1,c2);
if (a=true) and (b1=true) and (b2=true) and (c1=true) and (c2=true) then
begin
cover (K1,K2,KM,yes);
if yes then writeln (d1,' ',m1,' бьет ',d2,' ',m2)
else writeln (d1,' ',m1,' не бьет ',d2,' ',m2)
end;
writeln('Вы хотите выйти?(Д/Н)');
readln(u)
until (u='Д') or (u='д')
end.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

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

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


попробуй использовать опетаор Case
Case <выражение> of
<список мток 1>:<оператор 1>;
<список мток 2>:<оператор 2>;
....
<список мток N>:<оператор N>;
else
<оператор>
end;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

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


Ну например:

if (kz='пики') then KM:=spades
else if (kz='трефы') then KM:=clubs
else if (kz='бубны') then KM:=diamonds
else if (kz='червы') or (kz='черви') then KM:=hearts
else begin a:=false;
writeln('Неправильно введена козырная масть!')
end;


Можно заменить на

const
SuitNames: array [0 .. 4] of string = ('пики', 'трефы', 'бубны', 'червы','черви');
NameToSuit: array [0 .. 4] of suit = (spades, clubs, diamonds, hearts, hearts);
var
...
i: integer;
begin
...
a := False;
for i := 0 to 4 do
if kz = SuitNames[i] then begin
KM := NameToSuit[i];
a := True;
Break;
end;
if not a then
writeln('Неправильно введена козырная масть!')
...


И так в каждом пункте.
Идея, в общем, такая.
Caranthir, case на строки действует?

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


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


Гость






БелАчкА, прежде всего - идея такая:
procedure input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string; var a,b1,b2,c1,c2:boolean);

{ вложенные константы и функции }
const
match_suit: array[suit] of string = (
'(пики)', '(трефы)', '(бубны)', '(червы)(черви)'
);
match_size: array[size] of string = (
'(шесть)(шестерка)(6)', '(семь)(семерка)(7)', '(восемь)(восьмерка)(8)',
'(девять)(девятка)(9)', '(десять)(десятка)(10)', '(валет)', '(дама)', '(король)', '(туз)'
);
function get_suit(s: string; var res_suit: suit): boolean;
var i: suit;
begin
get_suit := false;
for i := low(suit) to high(suit) do
if pos('(' + s + ')', match_suit[i]) > 0 then begin
get_suit := true; res_suit := i; break;
end;
end;
function get_size(s: string; var res_size: size): boolean;
var i: size;
begin
get_size := false;
for i := low(size) to high(size) do
if pos('(' + s + ')', match_size[i]) > 0 then begin
get_size := true; res_size := i; break;
end;
end;

var kz:string;
begin
writeln ('Введите козырную масть'); readln(kz);
writeln('Введите первую карту');
write('масть: '); readln(m1);
write('достоинство: '); readln(d1);
writeln('Введите вторую карту');
write('масть: '); readln(m2);
write('достоинство: '); readln(d2);

a := get_suit(kz, km);
if not a then writeln('Неправильно введена козырная масть!');

b1 := get_suit(m1, K1.m);
if not b1 then writeln('Неправильно введена масть первой карты!');
b2 := get_suit(m2, K2.m);
if not b2 then writeln('Неправильно введена масть второй карты!');

c1 := get_size(d1, K1.d);
if not c1 then writeln('Неправильно введено достоинство первой карты!');
c2 := get_size(d2, K2.d);
if not c2 then writeln('Неправильно введено достоинство второй карты!');
end;

В остальной программе тоже можно пошаманить.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

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

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


Алена, TarasBer, большое спасибо за помощь!!! give_rose.gif
правда, вложенные константы и функции мы еще не проходили...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






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

program zapis;

{$APPTYPE CONSOLE}

uses
SysUtils,
windows;

type
suit=(spades, clubs, diamonds, hearts);
size=(six, seven, eight, nine, ten, jack, queen, king, ace);
card= record
m:suit;
d:size
end;
var u:char;
K1,K2:card; KM:suit;
m1,m2,d1,d2:string;

const
match_suit: array[suit] of string = (
'(пики)', '(трефы)', '(бубны)', '(червы)(черви)'
);
match_size: array[size] of string = (
'(шесть)(шестерка)(6)', '(семь)(семерка)(7)', '(восемь)(восьмерка)(8)',
'(девять)(девятка)(9)', '(десять)(десятка)(10)', '(валет)', '(дама)', '(король)', '(туз)'
);

function get_suit(s: string; var res_suit: suit;
const msg: string): boolean;
var i: suit;
b: boolean;
begin
b := false;
for i := low(suit) to high(suit) do
if pos('(' + s + ')', match_suit[i]) > 0 then begin
b := true; res_suit := i; break;
end;

if not b then writeln(msg);
get_suit := b;
end;
function get_size(s: string; var res_size: size;
const msg: string): boolean;
var i: size;
b: boolean;
begin
b := false;
for i := low(size) to high(size) do
if pos('(' + s + ')', match_size[i]) > 0 then begin
b := true; res_size := i; break;
end;

if not b then writeln(msg);
get_size := b;
end;

function input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string):boolean;
var kz:string;
begin
writeln ('Введите козырную масть'); readln(kz);
writeln('Введите первую карту');
write('масть: '); readln(m1);
write('достоинство: '); readln(d1);
writeln('Введите вторую карту');
write('масть: '); readln(m2);
write('достоинство: '); readln(d2);

{$b+}
input_data :=
get_suit(kz, km, 'Неправильно введена козырная масть!') and
get_suit(m1, K1.m, 'Неправильно введена масть первой карты!') and
get_suit(m2, K2.m, 'Неправильно введена масть второй карты!') and
get_size(d1, K1.d, 'Неправильно введено достоинство первой карты!') and
get_size(d2, K2.d, 'Неправильно введено достоинство второй карты!');
{$b-}
end;

function cover(K1,K2:card;KM:suit): boolean;
begin
if K1.m=K2.m then cover := (K1.d > K2.d)
else cover := (K1.m = KM)
end;

const
text: array[boolean] of string = (' не бьет ', ' бьет ');
var
is_cover: boolean;

begin
setconsolecp(1251);
setconsoleoutputcp(1251);

repeat

if input_data(K1,K2,KM,m1,m2,d1,d2) then begin
is_cover := cover(K1, K2, KM);
writeln (d1,' ',m1,text[is_cover],d2,' ',m2)
end;
writeln('Вы хотите выйти?(Д/Н)');
readln(u)

until (u='Д') or (u='д')
end.
(если убрать директивы {$b+} и {$b-}, то программа будет выдавать только первую совершённую при наборе ошибку, если не убирать - то будут показаны все ошибки)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

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


Алёна, а ваша программа случайно не воспримет 'червы)(черви' как правильную масть?


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


Гость






    ...
b := false;
if pos(')(', s) = 0 then { <-- Должно убрать этот недочет, если не внесет новых багов }
for i := low(suit) to high(suit) do
if pos('(' + s + ')', match_suit[i]) > 0 then begin
b := true; res_suit := i; break;
end;
...

(Чисто теоретически, не тестировала)
Во второй функции - аналогично.

Спасибо за замечание...
 К началу страницы 
+ Ответить 

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

 





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