Var m, n: integer; s1, s2, s3: string; ms: array[1..9] of string; md: array[1..9] of string; m1: array[11..19] of string; me: array[1..9] of string; flag: boolean;
Write('Введите целое число от 1 до 1000: '); Readln(m); if (m < 1) or (m > 1000) then Writeln('Шутки шутим?') else if m = 1000 then Writeln('Одна тысяча ' + s3) else begin { сотни } n := m div 100; if n > 0 then begin Write(ms[n]); flag := true end; { десятки } m := m mod 100; if m = 0 then Writeln(' ', s3) else begin if (m > 10) and (m < 20) then begin if flag then Write(' '); Writeln(m1[m], ' ', s3) end else if m > 0 then begin n := m mod 10; m := m div 10; if m > 0 then begin if flag then Write(' ') else flag := true; Write(md[m]) end; if n <> 0 then begin { единицы } if flag then Write(' '); Write(me[n], ' '); case n of 1: Writeln(s1); 2..4: Writeln(s2); else Writeln( s3) end end else Writeln(' ', s3) end end end end.
Тестовое решение: Введите целое число от 1 до 1000: 314 триста четырнадцать рублей
m, n: integer;
s1, s2, s3: string;
ms: array[1..9] of string;
md: array[1..9] of string;
m1: array[11..19] of string;
me: array[1..9] of string;
flag: boolean;
begin
flag := false; { Пока ничего не выведено }
s1 := 'рубль';
s2 := 'рубля';
s3 := 'рублей';
ms[1] := 'сто'; ms[2] := 'двести'; ms[3] := 'триста'; ms[4] := 'Четыреста';
ms[5] := 'пятьсот'; ms[5] := 'пятьсот'; ms[6] := 'шестьсот'; ms[7] := 'семьсот';
ms[8] := 'восемьсот'; ms[9] := 'девятьсот';
md[1] := 'десять'; md[2] := 'двадцать'; md[3] := 'тридцать'; md[4] := 'сорок';
md[5] := 'пятьдесят'; md[6] := 'шестьдесят'; md[7] := 'семьдесят';
md[8] := 'восемьдесят'; md[9] := 'девяносто';
m1[11] := 'одиннадцать'; m1[12] := 'двенадцать'; m1[13] := 'тринадцать';
m1[14] := 'четырнадцать'; m1[15] := 'пятнадцать'; m1[16] := 'шестнадцать';
m1[17] := 'семнадцать'; m1[18] := 'восемнадцать'; m1[19] := 'девятнадцать';
me[1] := 'один'; me[2] := 'два'; me[3] := 'три'; me[4] := 'четыре'; me[5] := 'пять';
me[6] := 'шесть'; me[7] := 'семь'; me[8] := 'восемь'; me[9] := 'девять';
Write('Введите целое число от 1 до 1000: ');
Readln(m);
if (m < 1) or (m > 1000) then Writeln('Шутки шутим?')
else
if m = 1000 then Writeln('Одна тысяча ' + s3)
else
begin
{ сотни }
n := m div 100;
if n > 0 then
begin
Write(ms[n]);
flag := true
end;
{ десятки }
m := m mod 100;
if m = 0 then Writeln(' ', s3)
else
begin
if (m > 10) and (m < 20) then
begin
if flag then Write(' ');
Writeln(m1[m], ' ', s3)
end
else
if m > 0 then
begin
n := m mod 10;
m := m div 10;
if m > 0 then
begin
if flag then Write(' ') else flag := true;
Write(md[m])
end;
if n <> 0 then
begin
{ единицы }
if flag then Write(' ');
Write(me[n], ' ');
case n of
1: Writeln(s1);
2..4: Writeln(s2);
else Writeln( s3)
end
end
else Writeln(' ', s3)
end
end
end
end.
Тестовое решение:
Введите целое число от 1 до 1000: 314
триста четырнадцать рублей
PascalABC.NET 3.5.1
program D_contest;
type
TStat = record
nick: string;
wins, battles: integer;
proc: real;
end;
var
N, i, num: integer;
str: array of string;
stat: array of TStat;
nick: string;
function found(ni_ck: string): integer;
begin
found := -1;
for var e := 0 to Length(stat) - 1 do
begin
if stat[e].nick = ni_ck then
begin
found := e;
break;
end;
end;
end;
var
v_pts, e_pts, l_e: integer;
F: textfile;
k: real;
s: string;
begin
Assign(F, 'input.txt');
Reset(F);
readln(F, n);
SetLength(str, n);
SetLength(stat, 1);
for i := 0 to n - 1 do
begin
readln(F, str[i]);
//get enemy_nick
nick := Copy(str[i], 1, Pos(' ', str[i]) - 1);
Delete(str[i], 1, Pos(' ', str[i]));
if (stat[0].nick <> '') then
begin
num := found(nick);
if (num = -1) then //not found
begin
l_e := Length(stat);
SetLength(stat, l_e + 1);
num := l_e;
stat[num].nick := nick;
end;
end
else
begin
stat[0].nick := nick;
end;
stat[num].battles += 1;
//get Vania_points
v_pts := StrToInt(Copy(str[i], 1, Pos(' ', str[i])));
Delete(str[i], 1, Pos(' ', str[i]));
//get enemy_points
e_pts := StrToInt(str[i]);
if v_pts > e_pts Then
stat[num].wins += 1;
end;
Close(F);
//вычисляю процент побед
for i := 0 to Length(stat) - 1 do
begin
stat[i].proc := stat[i].wins / stat[i].battles;
end;
//сортировка по процентам
for i := 0 to Length(stat) - 2 do
begin
for var j := 0 to Length(stat) - i - 2 do
begin
if stat[j].proc > stat[j + 1].proc then
begin
k := stat[j].proc;
stat[j].proc := stat[j + 1].proc;
stat[j + 1].proc := k;
s := stat[j].nick;
stat[j].nick := stat[j + 1].nick;
stat[j + 1].nick := s;
end;
end;
end;
//сортировка по алфавиту
for i := 0 to Length(stat) - 2 do
begin
for var j := 0 to Length(stat) - i - 2 do
begin
if (stat[j].proc = stat[j + 1].proc) and (stat[j].nick > stat[j + 1].nick) then
begin
k := stat[j].proc;
stat[j].proc := stat[j + 1].proc;
stat[j + 1].proc := k;
s := stat[j].nick;
stat[j].nick := stat[j + 1].nick;
stat[j + 1].nick := s;
end;
end;
end;
writeln(Length(stat));
for i := 0 to Length(stat) - 1 do
begin
write(stat[i].nick, ' ');
writeln(stat[i].proc * 100:0:6);
end;
end.
Объяснение:
Смотри код