Вторник, 07.01.2025
Pascal 4 All
[ · Новые сообщения · Участники · Правила форума · Поиск · RSS ]

 

  • Страница 1 из 1
  • 1
Модератор форума: Seqular, Pavel  

Задача!
TODDДата: Вторник, 11.12.2007, 00:03 | Сообщение # 1
Новичок
Группа: Пользователи
Сообщений: 6
Репутация: 0
Замечания: 0%
Статус: Offline
Фермеры Диетенко и Вампиров много занимались вычислениями, они очень любили разные числовые головоломки. Особенно любили обмениваться шифрованными сообщениями электронной почтой. Ключ к шифру нужно было вычислить как можно быстрее, потому что сообщение сохранялось в почтовом ящике лишь два дня. Однажды фермер Диетенко прислал фермеру Вампирову дежурную шифровку и некоторое целое число N. Ключом к шифру было менее всего положительное целое число, произведение цифр которого равняется N. Помогите фермеру Вампирову прочитать сообщение. Входные данные: в текстовом файле Z1.dat содержится число N (0<=N<=2147483647) Выходные даны: в текстовый файл Z1.sol записать искомое целое число или 0, если такого числа нет.
 
LordДата: Воскресенье, 16.12.2007, 07:27 | Сообщение # 2
Знакомый
Группа: Пользователи
Сообщений: 13
Репутация: 0
Замечания: 0%
Статус: Offline
Помогите исправить етую задачю если можете плиз...
var s:string;
n:longint;
begin
readln(n);
while (n mod 9)=0 do begin n:=n div 9; s:=s+'9'; end;
while (n mod 8)=0 do begin n:=n div 8; s:=s+'8'; end;
while (n mod 7)=0 do begin n:=n div 7; s:=s+'7'; end;
while (n mod 6)=0 do begin n:=n div 6; s:=s+'6'; end;
while (n mod 5)=0 do begin n:=n div 5; s:=s+'5'; end;
while (n mod 4)=0 do begin n:=n div 4; s:=s+'4'; end;
while (n mod 3)=0 do begin n:=n div 3; s:=s+'3'; end;
while (n mod 2)=0 do begin n:=n div 2; s:=s+'2'; end;
writeln(s);
end.


Учусь Паскаля
 
SeqularДата: Воскресенье, 16.12.2007, 11:15 | Сообщение # 3
Хранитель
Группа: Администраторы
Сообщений: 859
Репутация: 35
Статус: Offline
TODD и Lord - вы один и тот же человек???

Поддерживаю также проект сообщество молодых сисадминов
 
PavelДата: Воскресенье, 16.12.2007, 14:58 | Сообщение # 4
Приближенный
Группа: Модераторы
Сообщений: 210
Репутация: 17
Замечания: 0%
Статус: Offline
Я вот почему то так иподумал! Или братья близнецы. Может быть сеамские? Не обижайтесь! cool cool cool
 
SeqularДата: Воскресенье, 16.12.2007, 16:49 | Сообщение # 5
Хранитель
Группа: Администраторы
Сообщений: 859
Репутация: 35
Статус: Offline
Pahan, Я понял! Они скорее всего одногрупники smile

Поддерживаю также проект сообщество молодых сисадминов
 
SeqularДата: Воскресенье, 16.12.2007, 17:07 | Сообщение # 6
Хранитель
Группа: Администраторы
Сообщений: 859
Репутация: 35
Статус: Offline
Code
Uses CRT;
var s: string;
     n, x: longint;
     i, j: Byte;
     t: String;
     f1, f2: Text;
begin
Assign(f1, 'Z1.dat'); ReSet(f1);
Readln(f1, n);
x := n;
while (n mod 9)=0 do begin n:=n div 9; s:=s+'9'; end;
while (n mod 8)=0 do begin n:=n div 8; s:=s+'8'; end;
while (n mod 7)=0 do begin n:=n div 7; s:=s+'7'; end;
while (n mod 6)=0 do begin n:=n div 6; s:=s+'6'; end;
while (n mod 5)=0 do begin n:=n div 5; s:=s+'5'; end;
while (n mod 4)=0 do begin n:=n div 4; s:=s+'4'; end;
while (n mod 3)=0 do begin n:=n div 3; s:=s+'3'; end;
while (n mod 2)=0 do begin n:=n div 2; s:=s+'2'; end;
For i := 1 to Length(s) do
     Begin
     For j := i to Length(s) do
         Begin
         If (s[i] > s[j]) then
            Begin
            t[1] := s[i];
            s[i] := s[j];
            s[j] := t[1];
            End;
         End;
     End;
Writeln(s);
ReadKey;
Assign(f2, 'Z1.SOL'); ReWrite(f2);
If (s <> '') then Writeln(f2, s)
              else Writeln(f2, '0');
Close(f1); Close(f2);
end.
Прикрепления: Z1.dat (0.0 Kb)


Поддерживаю также проект сообщество молодых сисадминов
 
SeqularДата: Воскресенье, 16.12.2007, 17:17 | Сообщение # 7
Хранитель
Группа: Администраторы
Сообщений: 859
Репутация: 35
Статус: Offline
Работает не со всеми числами. Это только улучшение алгоритма, предложенного вами

Поддерживаю также проект сообщество молодых сисадминов
 
LordДата: Вторник, 18.12.2007, 06:49 | Сообщение # 8
Знакомый
Группа: Пользователи
Сообщений: 13
Репутация: 0
Замечания: 0%
Статус: Offline
А можно попробивать чтобы со всемя числами ишла плиз попробуйте чтото придумать есле сможете.......
Жду ответа......


Учусь Паскаля
 
SeqularДата: Вторник, 18.12.2007, 21:34 | Сообщение # 9
Хранитель
Группа: Администраторы
Сообщений: 859
Репутация: 35
Статус: Offline
Code
Uses CRT;  
var s: string;
      n, x, y: longint;
      i, j: Byte;
      t: String;
      f1, f2: Text;
begin
ClrScr;
Assign(f1, 'Z1.dat'); ReSet(f1);
Readln(f1, n);
Close(f1);
Assign(f2, 'Z1.SOL'); ReWrite(f2);
If (n = 0) or (n = 1) then
    Begin
    Write(f2, '1');
    Write(f2, n);
    Close(f2);
    Exit;
    End;
y := 1;
x := n;
while (n mod 9)=0 do begin n:=n div 9; y := y * 9; s:=s+'9'; end;
while (n mod 8)=0 do begin n:=n div 8; y := y * 8; s:=s+'8'; end;
while (n mod 7)=0 do begin n:=n div 7; y := y * 7; s:=s+'7'; end;
while (n mod 6)=0 do begin n:=n div 6; y := y * 6; s:=s+'6'; end;
while (n mod 5)=0 do begin n:=n div 5; y := y * 5; s:=s+'5'; end;
while (n mod 4)=0 do begin n:=n div 4; y := y * 4; s:=s+'4'; end;
while (n mod 3)=0 do begin n:=n div 3; y := y * 3; s:=s+'3'; end;
while (n mod 2)=0 do begin n:=n div 2; y := y * 2; s:=s+'2'; end;
For i := 1 to Length(s) do
      Begin
      For j := i to Length(s) do
          Begin
          If (s[i] > s[j]) then
             Begin
             t[1] := s[i];
             s[i] := s[j];
             s[j] := t[1];
             End;
          End;
      End;
If (s <> '') and (y = x) then Writeln(f2, s)
                          else Writeln(f2, '0');
Close(f2);
end.

Немного доработал. Вроде работает


Поддерживаю также проект сообщество молодых сисадминов
 
  • Страница 1 из 1
  • 1
Поиск:

Copyright MyCorp © 2025
Используются технологии uCoz
javascript:;" rel="nofollow" onclick="loginPopupForm(); return false;