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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.07.2012, 11:49   #21
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от s-andriano
Я нигде не проверял, так что, если у кого есть желание, проверьте
нормальное решение.
я проверил на acmp.ru. Accepted
Цитата:
Код:
Тест	Результат	Время	Память
1	Accepted	 0,255	828 Кб
2	Accepted	 0,213	824 Кб
3	Accepted	 0,217	824 Кб
4	Accepted	 0,249	816 Кб
5	Accepted	 0,288	816 Кб
6	Accepted	 0,228	828 Кб
7	Accepted	 0,268	828 Кб
8	Accepted	 0,145	828 Кб
9	Accepted	 0,221	828 Кб
10	Accepted	 0,336	828 Кб
Цитата:
Сообщение от TinMan
Мужики, а поделитесь сокровенным знанием: что вы называете "символом"? Скажем - необязательные пробелы (неразделительные) включаются? Или, скажем, концы строк? Или же - это просто размер файла? выразитесь яснее, плз..
это из acmp.ru. у них там идиотский подход - TOP лучших решений попадают решения с самым КОРОТКИМ кодом.
цитирую:
Цитата:
Сообщение от acmp.ru
В качестве критерия ранжирования лучших попыток служит размер кода закачиваемой программы. При подсчете размера кода не учитываются пробелы, а так же символы переноса и табуляции.

Последний раз редактировалось Serge_Bliznykov; 21.07.2012 в 11:53.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 21.07.2012, 13:30   #22
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Мой косяк с rfin.
Полный код :
Код:
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
    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;

    for i := 1  to Length(rfin) do
        Write (rfin[i])
end.
Код:
program MinNumber;

const
    SIZE = 255;

type
    TStr = string[SIZE];

    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
    s, s1 : string;
    r, r1 : 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
        WriteLn (r1)
    else
        WriteLn (r)
end.
1 - все тесты
2 - на 8 рушится
Poma][a вне форума Ответить с цитированием
Старый 22.07.2012, 00:18   #23
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
это из acmp.ru. у них там идиотский подход - TOP лучших решений попадают решения с самым КОРОТКИМ кодом.
А, ясно.. Спасибо, Серж!
Самому мне было влом регится, так что я действовал через подругу (+Юлия GaL+, спасибо ей!!)). Тесты прошли,длина кода оказалась 294. Я дооооооооолго влипал воспаленными (со сна)) глазами в код, пока подруга мне не заметила, что i и j в коде не используются (остались с предыдущей версии)). Потер ))). Результат - 280 символов.

Вот код:
Код:
var
  s:array[0..1] of string;
  k:word;
  f: text;

begin
  assign(f,'input.txt');
  reset(f);
  readln(f,s[0]);
  readln(f,s[1]);
  close(f);
  assign(f,'output.txt');
  rewrite(f);
  while (s[0]>'')and(s[1]>'') do begin
    k:=Ord((s[0]+'9')>(s[1]+'9'));
    write(f,s[k,1]);
    Delete(s[k],1,1)
  end;
  writeln(f,s[0],s[1]);
  close(f)
end.
Ромаха, посмотрю твой код чуть позже и отвечу.
Предпочитаю на "ты".

Последний раз редактировалось TinMan; 22.07.2012 в 02:18.
TinMan вне форума Ответить с цитированием
Старый 22.07.2012, 13:10   #24
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

Ромаха, привет, отвечаю как обещал.
Цитата:
Сообщение от Poma][a Посмотреть сообщение
1 - все тесты
2 - на 8 рушится
Убери указание размера строки в определении типа TStr, то есть сделай так:
tStr= string;
- и будет тебе щасье.. ))

Ну и заодно закидываю еще один вариант кода, немного доработанный:
Код:
var
  s: array[0..1] of string;
  k: 0..1;
  f: text;

begin
  assign(f,'input.txt');
  reset(f);
  readln(f,s[0]);
  readln(f,s[1]);
  assign(f,'output.txt');
  rewrite(f);
  while s[0]+s[1]>'' do begin
    k:=Ord(s[0]+'9'>s[1]+'9');
    if s[k]='' then k:=1-k;
    write(f,s[k,1]);
    Delete(s[k],1,1)
  end;
  close(f)
end.
Этот вариант тоже проходит все тесты на сервере и весит 257 символов.
Предпочитаю на "ты".
TinMan вне форума Ответить с цитированием
Старый 22.07.2012, 15:41   #25
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

TinMan, огромное спасибо!
Poma][a вне форума Ответить с цитированием
Старый 22.07.2012, 16:31   #26
Plague
Забанен
Форумчанин Подтвердите свой е-майл
 
Аватар для Plague
 
Регистрация: 01.11.2006
Сообщений: 420
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
нормальное решение.
я проверил на acmp.ru. Accepted

это из acmp.ru. у них там идиотский подход - TOP лучших решений попадают решения с самым КОРОТКИМ кодом.
цитирую:
Почему же идиотский подход? По моему хороший подход. Иногда полезно подумать что лишнего в коде написал.
Вот на пример мой первый вариант был такой (размер кода: 283):
Код:
var a,b,s:string;
procedure p(var y:string);
  begin
    s:=s+y[1];
    delete(y,1,1)
  end;
begin
  assign(input,'input.txt');reset(input);
  assign(output,'output.txt');rewrite(output);
    readln(a);
    read(b);
    a:=a+'A';
    b:=b+'B';
    s:='';
    while (a<>'')and(b<>'') do
      if a<=b then p(a) else p(b);
    delete(s,length(s),1);
    write(s)   
end.
Подумав и переработав этот код получилось (размер кода: 224):
Код:
var a,b:string;
procedure p(var y:string);
  begin
    write(y[1]);
    delete(y,1,1)
  end;
begin
  assign(input,'input.txt');reset(input);
  assign(output,'output.txt');rewrite(output);
    readln(a);
    read(b);
    while a+b>'' do
      if a+'A'>b+'B' then p(b) else p(a)
end.
Много лишнего убралось, а потом вообще по другому решил и получил размер кода 222. Хочется еще сократить))

To TinMan, хорошее решение! Я отказался от массива string. Пробовал так, но отказался, слишком много символов получается)
Если ничто другое не помогает, прочтите, наконец, инструкцию! Аксиома Кана
Plague вне форума Ответить с цитированием
Старый 22.07.2012, 22:21   #27
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

Plague, спасибо за комплимент, и - признаю свое поражение )). Вариант с процедурой, конечно, короче, чем с массивом строк, я ему не уделил внимания, расслабившись после получения вроде неплохих результатов..
Спасибо! полагаю, нам обоим было, чему поучиться )).
+1
Предпочитаю на "ты".
TinMan вне форума Ответить с цитированием
Старый 22.07.2012, 22:52   #28
Plague
Забанен
Форумчанин Подтвердите свой е-майл
 
Аватар для Plague
 
Регистрация: 01.11.2006
Сообщений: 420
По умолчанию

Вот без процедуры еще короче. На два символа)))
Код:
var a,b,s:string;
begin
  assign(input,'input.txt');reset(input);
  assign(output,'output.txt');rewrite(output);
  readln(a);
  read(b);
  repeat
    s:=a;
    if a+'A'>b+'B' then s:=b;
    write(s[1]);
    if s=b then delete(b,1,1) else delete(a,1,1)
  until a+b<=''
end. 

Размер кода: 222
Да поучиться было чему, это факт.

Offtop: Не хочется программирование забывать просто, хотя давно им не занимаюсь уже, а тяга к паскалю осталась))
Если ничто другое не помогает, прочтите, наконец, инструкцию! Аксиома Кана

Последний раз редактировалось Plague; 22.07.2012 в 23:03.
Plague вне форума Ответить с цитированием
Старый 23.07.2012, 10:04   #29
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

в одном из комментов на ACMP.ru прочёл, что допускается сокращённая запись переопределения файлов ввода/вывода. Что позволяет съэкономить ещё около 20 байт исходного кода:
вместо:
Код:
  assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output); 
пишите:
Код:
  reset(input, 'input.txt'); 
  rewrite(output, 'output.txt');
это, конечно, противоречит стандартам языка Паскаль, зато соответствует проверяющей системе на acmp.ru

Всем удачи при сдаче решений.


Цитата:
Цитата:
это из acmp.ru. у них там идиотский подход - TOP лучших решений попадают решения с самым КОРОТКИМ кодом.
Почему же идиотский подход? По моему хороший подход. Иногда полезно подумать что лишнего в коде написал.
если бы это касалось своих попыток, то ладно, я ещё допущу (хотя тоже спорно - использование в качестве имён переменных, имён процедур и функций односимвольных идентификаторов явно не повышает надёжность и наглядность кода. Да и отказ от использования процедуры и функии (т.к. это неизбежно лишние байты исходного кода), я бы тоже не назвал положительным, если речь идёт о реальной практической задаче), но они же в одну таблицу помещают результаты на РАЗНЫХ языках программирования. а на том же C++ вместо begin end - фигурные скобки - прямая дискриминация. 6 к 2 на каждом использовании, if без then и т.д. и т.п. На мой взгляд, это не очень корректно.


p.s. за решение большое спасибо. я - "тормоз", не сообразил, что можно сравнивать строки целиком, а не посимвольно, как это я делал в своём решении.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 23.07.2012, 10:50   #30
Plague
Забанен
Форумчанин Подтвердите свой е-майл
 
Аватар для Plague
 
Регистрация: 01.11.2006
Сообщений: 420
По умолчанию

Код:
reset(input, 'input.txt'); 
  rewrite(output, 'output.txt');
Не знал. Экономится около 30 байт. Спасибо за информацию.

Итого применив это получаем:
Код:
var a,b,s:string;
begin
  reset(input, 'input.txt'); 
  rewrite(output, 'output.txt');
  readln(a);
  read(b);
  repeat
    s:=a;
    if a+'A'>b+'B' then s:=b;
    write(s[1]);
    if s=b then delete(b,1,1) else delete(a,1,1)
  until a+b<=''
end. 

Размер кода: 193
Как еще уменьшить код я не знаю. Если у кого получится, пишите.
Если ничто другое не помогает, прочтите, наконец, инструкцию! Аксиома Кана

Последний раз редактировалось Plague; 23.07.2012 в 11:02.
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