Vladimir_S
Супермодераторы
- Регистрация
- 27 Авг 2008
- Сообщения
- 27,807
- Реакции
- 1,025
- Баллы
- 0
Задача о дробях
Получил на днях такое вот послание в ЛС от одного (точнее, одной) из постоянных участников форума:
Правда, попытки вести диалог с заказчицей через ЛС натолкнулись на гробовое молчание последней, что меня несколько рассердило, а потому я счёл возможным посвоевольничать: входной файл (как и выходной, естественно) может содержать не одну, а сколько угодно строк с дробями. Правила:
1. Записи дробей должны начинаться с крайней левой позиции, т.е. пробелов впереди быть не должно.
2. Каждая дробь располагается на своей отдельной строке.
3. Пустые строки не допускаются.
4. После введения последней дроби НЕ СЛЕДУЕТ переводить строку.
Адресация файлов может быть, естественно, изменена.
Вроде всё. Вот программа:
А вот результат:
Получил на днях такое вот послание в ЛС от одного (точнее, одной) из постоянных участников форума:
Вообще-то я всегда прошу не ломиться с подобными просьбами в личку, а все задания выкладывать на форум. Но задачка интересная, поэтому взялся. Любопытно, что поиск в Сети практически ничего не дал: всякие умные дяди очень любят объяснять детям, как это решать "в столбик", а вот расписать алгоритм программы - ни! Правда, на одном форуме два СИ-шника пытались написать такую программу, но получилось сыро и глючно, в общем - не понравилось. Поэтому решал "из первых принципов".
Правда, попытки вести диалог с заказчицей через ЛС натолкнулись на гробовое молчание последней, что меня несколько рассердило, а потому я счёл возможным посвоевольничать: входной файл (как и выходной, естественно) может содержать не одну, а сколько угодно строк с дробями. Правила:
1. Записи дробей должны начинаться с крайней левой позиции, т.е. пробелов впереди быть не должно.
2. Каждая дробь располагается на своей отдельной строке.
3. Пустые строки не допускаются.
4. После введения последней дроби НЕ СЛЕДУЕТ переводить строку.
Адресация файлов может быть, естественно, изменена.
Вроде всё. Вот программа:
Код:
Var
nom,den,d,m,Q:Word;
n,j,p:Byte;
f_in,f_ou:Text;
Rem:Array[1..100] of Word;
Fig:Array[1..100] of Byte;
S_in,nom_st,den_st,S,St:String;
Code:Integer;
Function Test_Rem(R:Word; k:Byte):Byte;
var
b:Boolean;
i:Byte;
begin
b:=false;
i:=0;
repeat
Inc(i);
if i<=k then if Rem[i]=R then b:=true;
until b or (i=k+1);
if b then Test_Rem:=i else Test_Rem:=0;
end;
Begin
Assign(f_in,'D:\Input.txt');
Reset(f_in);
Assign(f_ou,'D:\Output.txt');
Rewrite(f_ou);
Repeat
Readln(f_in,S_in);
p:=0;
repeat
Inc(p);
until S_in[p]='/';
nom_st:=Copy(S_in,1,p-1);
den_st:=Copy(S_in,p+1,Length(S_in)-p);
Val(nom_st,nom,Code);
Val(den_st,den,Code);
n:=1;
S:='';
Str((Nom div Den),St);
S:=S+St;
if (Nom mod den)>0 then
begin
S:=S+'.';
m:=(Nom mod Den);
Rem[1]:=m;
repeat
Inc(n);
d:=m*10 div Den;
m:=m*10 mod Den;
Q:=Test_Rem(m,n-1);
if (m>0) and (Q=0) then
begin
Rem[n]:=m;
Fig[n]:=d
end;
until (m=0) or (Q>0);
Rem[n]:=m;
Fig[n]:=d;
if m=0 then
begin
for j:=2 to n do
begin
Str(Fig[j],St);
S:=S+St;
end
end
else
begin
for j:=2 to Q do
begin
Str(Fig[j],St);
S:=S+St;
end;
S:=S+'(';
for j:=Q+1 to n do
begin
Str(Fig[j],St);
S:=S+St;
end;
S:=S+')';
end;
end;
Writeln(f_ou,S);
Until EoF(f_in);
Close(f_in);
Close(f_ou);
End.
