Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.07.2012, 12:07   #1
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию Минимальное число

И снова День добрый, господа архипелаги в безмятежном море программирования, вот нашел (уже давно) очень интересную задачу(мои оченки интересности могут существенно отличаться от Ваших).
Для составления алгоритма ушло овер недели. И "думали, думали и наконец придумали!". Сама задача :

Минимальное число
(Время: 1 сек. Память: 16 Мб Сложность: 25%)
Требуется написать программу, которая из цифр двух натуральных чисел создает наименьшее возможное число, сохраняя при этом порядок следования цифр в этих числах.

Входные данные
Входной файл INPUT.TXT содержит два натуральных числа, записанных в двух строках. Числа больше нуля и меньше 10255.

Выходные данные
В единственную строку выходного файла OUTPUT.TXT нужно вывести наименьшее возможное число, удовлетворяющее условию задачи.
И снова не красивая ссыль (http://acmp.ru/index.asp?main=task&id_task=548)

Ну и маленькое лирическое отступление : сначала была идея рассмотреть все случаи, потом после усердных попыток она отпала, затем преподаватель рассмотрел идею создания алгоритма на основе сортировки "C влиянием" (но она подразумевает, что массив(куда заносим цифры) уже отсортирован => идея отпала), и наконец все общими усилиями появился на свет данный алгоритм :
Код:
program MinNumber;

const
    SIZE = 255;

type
    TStr = string;

    TElem = record
        d, next : Char;
    end;
    TNum  = array [1..SIZE * 2] of TElem;

function Strings (s,s1 : string) : string;
procedure GetElem (var num : TNum; s : TStr; k : Integer);

var
    l, i : Integer;

begin
    l := Length(s);

    num[l+k-1].next := 'A';
    num[l+k-1].d := s[l-1];

    for i := l+k-2 downto 1+k do begin
        num[i].d := s[i-k];
        if num[i].d = num[i+1].d then
            num[i].next := num[i+1].next
        else
            num[i].next := num[i+1].d
    end;

end;

procedure InsSort (var num : TNum; la, lb : Integer);

function Greater (const a, b : TElem) : boolean;

begin
    Greater := (a.d = b.d) and (a.next > b.next)
        or (a.d <> b.d) and (a.d > b.d)
end;

var
    i, j, k : Integer;
    t : TElem;

begin
    j := 1;
    for i := la+1  to la+lb do begin
        t := num[i];
        while (Greater (t, num[j])) do
            Inc (j);
        for k := i-1 downto j do
            num[k+1] := num[k];
        num[j] := t;
        Inc (j);
    end;
end;


var
    num : TNum;
    t, r : TStr;
    i, l : Integer;

begin
    GetElem (num,s+'A', 0);
    l := Length(s);

    GetElem (num, s1+'B', l);


    InsSort (num, l, Length(s1));

    r := '';

    for i := 1 to l + Length(s1) do
        r := r + num[i].d;
    Strings := r;

end;

var
    cor, i : Integer;
    s, s1 : string;
    r, r1, rfin : string;

begin
    assign(input, 'input.txt'); reset(input);
        assign(output, 'output.txt'); rewrite(output);


    ReadLn (s);
    ReadLn (s1);

    r := Strings (s, s1);
    r1 := Strings (s1, s);

    if r > r1 then
        rfin := r1
    else
        rfin := r;
    cor := 1;
    while rfin[cor] = '0' do
        Inc (cor);

    for i := cor  to Length(s) + Length(s1) do
        Write (rfin[i])
end.
И самое главное потом я еще день потратил на обработку 8 теста. Суть его что в начале был 0. А не задолго жо этого(ну месяца так 2) господин Plague в каком-то СуперЛегком решении заметил что какие-то числа вывдятся с 0 в начале. Далее гений программирования Serge согласился с данным замечанием. А какой-то балобол(в те далекие времена) сказал какую-то бредовую фразу. Балоболом был Я. И позвольте принести искрение извинения перед создателем столько замечательных алгоритмов и гениальных фраз. Ведь если бы начинающие (слово программисты здесь не корректно употребить) прислушивались к словам уже состоявшихся Программистов (имено с большой буквы), то было бы намного меньше нынешних [цензура]кодеров.


В данном алгоритме 1192 символа. Возможно это перебор. Но как не странно тесты проходит очень быстро (опять же acmp не славится хотя бы на 50% достоверными сведениями по поводу прохождения тестов). Но все же хочется красоты, изящности, оптимальности. Не могли бы, Вы, премного уважаемые Гении столько Важного Искусства, оказать маленькую (возможно) для Вас, но не оценимую (для меня) услугу.

_________________________________
С уважением и почитанием,
Poma][a.

Последний раз редактировалось Poma][a; 19.07.2012 в 21:16.
Poma][a вне форума Ответить с цитированием
Старый 19.07.2012, 14:44   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

лень регистрироваться на acmp.ru, чтобы проверить своё решение, поэтому доверяю проверку Вам.

Зачем здесь вообще сортировка?!
Так не проще?
Код:
program MinNumber;

var
  Dig1, Dig2, Res : string[255];
  i, i1, i2 : Integer;

begin
    assign(input, 'input.txt'); reset(input);
        assign(output, 'output.txt'); rewrite(output); 

    ReadLn (Dig1);
    ReadLn (Dig2);

    Res := '';
    i1 := 1;
    i2 := 1;
    for i:=1 to (Length(Dig1)+Length(Dig2)) do
      if (i1<=Length(Dig1)) and (i2<=Length(Dig2)) then
        if Dig1[i1]<Dig2[i2] 
            then begin Res := Res + Dig1[i1]; Inc(i1) end
            else begin Res := Res + Dig2[i2]; Inc(i2) end
      else
        if i1<=Length(Dig1)
            then begin Res := Res + Dig1[i1]; Inc(i1) end
            else begin Res := Res + Dig2[i2]; Inc(i2) end;

     Writeln(Res)
end.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 19.07.2012, 15:38   #3
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Спасибо, за предоставленную возможность! Но насколько я помню, Вы там уже зарегистрировались Вот, если не ошибаюсь Ваш профиль (http://acmp.ru/?main=user&id=91869)

И Ваше решение рушится на 4 тесте (вот для него контрпример :32545 32545
ответ: 3232545455)
И еще заметил : в условии сказано, что одно число не превышает 10^255 => результат может превышать эту планку
Так же тест 1 10 не проходит

Последний раз редактировалось Poma][a; 19.07.2012 в 15:46.
Poma][a вне форума Ответить с цитированием
Старый 19.07.2012, 15:56   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Вы там уже зарегистрировались
ага. Вы абсолютно правы. Вот только данных для логина у меня с собой нет. Только вечером смогу зайти в свой аккаунт. А регистрировать новый акк - лениво (да и неправильно!).


Цитата:
И Ваше решение рушится на 4 тесте (вот для него контрпример :32545 32545
ответ: 3232545455)
ага. точно! есть такая беда...

снимаю своё решение, как профнепригодное!
сорри!

Последний раз редактировалось Serge_Bliznykov; 19.07.2012 в 16:03.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 19.07.2012, 20:28   #5
s-andriano
Старожил
 
Аватар для s-andriano
 
Регистрация: 08.04.2012
Сообщений: 3,229
По умолчанию

а такой вариант:
Код:
var
  Dig1, Dig2, Res : string[255];
  i1, i2 : Integer;

procedure proc(i1,i2 : integer; s : string);
begin
  if (s < res) then begin
    if length(s) = (length(dig1) + length(dig2)) then
      res := s
    else begin
      if (i1 <= Length(Dig1)) then
        proc(i1 + 1, i2, s + Dig1[i1]);
      if (i2 <= Length(Dig2)) then
        proc(i1, i2 + 1, s + Dig2[i2]);
    end;
  end;
end;

begin
  assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output);
  ReadLn (Dig1);
  ReadLn (Dig2);
  res := dig1 + dig2;
  proc(1, 1, '');
  Writeln(Res);
end.
s-andriano вне форума Ответить с цитированием
Старый 19.07.2012, 20:39   #6
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

6 тест не проходит по времени, и опять же
Цитата:
в условии сказано, что одно число не превышает 10^255 => результат может превышать эту планку
введем 0 и 1, получим 01, выдаст ошибку!

Последний раз редактировалось Poma][a; 19.07.2012 в 21:15.
Poma][a вне форума Ответить с цитированием
Старый 19.07.2012, 22:22   #7
s-andriano
Старожил
 
Аватар для s-andriano
 
Регистрация: 08.04.2012
Сообщений: 3,229
По умолчанию

Цитата:
Сообщение от Poma][a Посмотреть сообщение
6 тест не проходит по времени, и опять же
введем 0 и 1, получим 01, выдаст ошибку!
А что в 6-м тесте?
Почему 01 - ошибка?

По времени - да, можно подобрать пример, на котором это будет работать очень долго. Мне кажется, что-то вроде "111111111111...11" + "11111111111111...11".
По поводу >255 символов - алгоритм некритичен к длине строки и не использует специфические строковые функции - только чтение очередного символа и добавление в конец массива. Так что легко может быть переделан со string на pchar. Кстати, после этого, возможно, он будет работать быстрее.
Кстати, если сделать строку, в которую мы складываем результат, глобальной переменной, скорость должна существенно возрасти из-за отсутствия копирования полукилобайта памяти при каждом рекурсивном вызове + гораздо более эффективное использование кэш-памяти.
Так что интересно, насколько не устраивает по скорости - если величина не очень большая - раз в 10 - еще есть простор для оптимизации.
s-andriano вне форума Ответить с цитированием
Старый 20.07.2012, 00:18   #8
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

чуток доработал своё первоначальное решение

Код:
program MN;

function Digit1Less(const s1, s2 : string; i1, i2 : integer):boolean;
var ld1, ld2 : char;
begin
  Digit1Less := s1[i1]<s2[i2];
  if s1[i1]<>s2[i2] then Exit
  else {сюда  мы попали, если очередные элементы равны}
     begin
      while (i1<=Length(s1)) and (i2<=Length(s2))
         and ( s1[i1] = s2[i2] ) do
         begin
           inc(i1);
           inc(i2)
         end;
      if (i1<=Length(s1)) and (i2<=Length(s2)) then
          begin  Digit1Less := s1[i1]<s2[i2]; Exit end
      else begin
        if i1>Length(s1) then i1 := Length(s1);
        if i2>Length(s2) then i2 := Length(s2);
        Digit1Less := s1[i1]<s2[i2];
      end;

    end;
end;


var
  s1, s2 : string[255];
  i, l, i1, i2 : Integer;

begin
    assign(input, 'input.txt'); reset(input);
        assign(output, 'output.txt'); rewrite(output);  

    ReadLn (s1);
    ReadLn (s2);

    i1 := 1;
    i2 := 1;
    l :=  Length(s1)+Length(s2);
    for i:=1 to l do
      if (i1<=Length(s1)) and (i2<=Length(s2)) then
        if Digit1Less(s1, s2, i1, i2)
            then begin Write(s1[i1]); Inc(i1) end
            else begin Write(s2[i2]); Inc(i2) end
      else
        if i1<=Length(s1)
            then begin Write(s1[i1]); Inc(i1) end
            else begin Write(s2[i2]); Inc(i2) end;

     WriteLn;
end.
Цитата:
Код:
Размер кода: 888
решение, конечно, "в лоб", однако, вроде бы, все тесты прошло...


p.s. и я думаю, что решения, которые висят в топе лучших по размеру исходного кода выполнены через рекурсию..

Последний раз редактировалось Serge_Bliznykov; 20.07.2012 в 00:22.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.07.2012, 04:06   #9
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

Гм.
Цитата:
Сообщение от Poma][a Посмотреть сообщение
введем 0 и 1, получим 01, выдаст ошибку!
Цитата:
Сообщение от Poma][a Посмотреть сообщение
... Числа больше нуля и меньше 10255. ...
?
(чтоб сообщение прошло по длине, пришлось пофлудить в скобках)
Предпочитаю на "ты".
TinMan вне форума Ответить с цитированием
Старый 20.07.2012, 08:21   #10
Plague
Забанен
Форумчанин Подтвердите свой е-майл
 
Аватар для Plague
 
Регистрация: 01.11.2006
Сообщений: 420
По умолчанию

Цитата:
p.s. и я думаю, что решения, которые висят в топе лучших по размеру исходного кода выполнены через рекурсию..
Сократил до 318 знаков, учитывая:
Код:
assign(input,'input.txt');reset(input);
assign(output,'output.txt');rewrite(output);
без рекурсии.
Если ничто другое не помогает, прочтите, наконец, инструкцию! Аксиома Кана
Plague вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Почему то не считает минимальное число Alekzinder Помощь студентам 0 06.05.2012 02:18
минимальное число членов сумма которых АнюточкаАА Паскаль, Turbo Pascal, PascalABC.NET 1 10.04.2012 19:33
Минимальное число выше главной диагонали... Oliveyra Общие вопросы C/C++ 9 21.04.2011 22:31
Минимальное число Progs1024 Паскаль, Turbo Pascal, PascalABC.NET 14 11.10.2009 21:21