Оптимизация по памяти

[Аватар]

Индексы для values от 1 до 100000 (max 7 бит)

Тут у меня описочка - max 17 бит

[Poma][a]

Можно самую малость про реализацию?

Заводим переменную free, которая будет указывать на свободный элемент в values..
После каждого пуша Inc(free, 6); НО что мы должны запихивать в указатель? Очевидно, что не фри(потребовалось не 17 бит..) тогда free div 6 ?

[Аватар]

var stacks: array[1..1000] of Longint;
    values: array[1..600000] of Byte;

Массив values используется для 100000 элементов по 6 байт каждый. Вот пример обращения для начальной инициализации цепочки свободных элементов:

for i:=1 to 99999 do
  values[(i-1)*6+6]:=(i+1) mod $100;  //младший байт индекса
  values[(i-1)*6+5]:=((i+1) div $100) mod $100; //второй байт индекса
  values[(i-1)*6+4]:=(values[(i-1)*6+4] and $FE) or ((i+1) div $10000); //старший бит индекса
end;
values[(999*6+6]:=0;
values[(999*6+5]:=0;
values[(999*6+4]:=values[999*6+4] and $FE;

по индексу i помещается ссылка на элемент с индексом i+1. Для первоначального заполнения можно и попроще, но этот же код используется и для модификации ссылки без порчи собственно значения в байтах 1-3, и частично 4. Не факт, что принцип заполнения самый оптимальный, делал бегом-бегом к оптимальности не стремился особо. В твой Free изначально поместить 1. Взяв из списка свободных очередной элемент во Free помещать ссылочку на следующий из этого взятого. А этот элемент встраивается первым со значением в нумерной стек. При освобождении элемента из стека он первым встраивается в цепочку свободных и Free соответственно модифицируется. Аналогично ссылка на начало стека тоже меняется

[Somebody]

Думаю, можно ещё как вариант стек делать через связный список из массивов по несколько чисел. Это +4k на индексы верхушек стеков, но накладные расходы на указатели в списке меньше.

[Poma][a]

Аватар, огромное спасибо!

Я вот что-то написал (не прошло и года)..

var
    stacks : array [1..1000] of LongInt;
    values : array [1..600000] of Byte;
    free : LongInt;

function StrToInt(s : string) : LongInt;
var
    er : Byte;
    r : LongInt;
begin
    Val(s, r,er);
    StrToInt := r
end;

procedure GetPush(var t : LongInt; var v : LongInt; s : string);
var
    f, i : Integer;
begin
    f := Pos(' ', s)+1; i := f;
    while s[i] <> ' ' do
        Inc(i);
    t := StrToInt(Copy(s, f, i-f));

    v := StrToInt(Copy(s, i+1, Length(s)))
end;

procedure Push(var st : LongInt; v : LongInt);
var
    t : LongInt;
begin

    Move(v, values[free], 4);
    values[free+3] := values[free+3] shl 2;

    t := st;
    t := t and 1;
    values[free+3] := values[free+3] and $FC or t;

    t := st;
    t := st shr 1;
    Move(t, values[free+4], 2);

    st := free div 6+1;

    Inc(free, 6)

end;

procedure Pop(var st : LongInt);
var
    t, s, temp : LongInt;
begin
    s := (st-1)*6+1;

    Move(values[s], temp, 4);
    values[s+3] := (values[s+3] and $FC ) shr 2;
    Move(values[s], t, 4);


    WriteLn(t);

    Move(temp, values[s], 4);
    values[s+3] := values[s+3]  and $1;
    t := values[s+4] shl 1;
    t := t or values[s+3];
    t := values[s+5] shr 9 or t;

    st := t
end;

var
    n, i, t : LongInt;
    s : string;
    v : LongInt;

begin
    free := 1;
    ReadLn(n);
    for i := 1 to n do begin
        ReadLn(s);
        if s[2] = 'U' then begin
            GetPush(t, v, s);
            Push(stacks[t], v)
        end
        else begin
            t := StrToInt(Copy(s, Pos(' ', s), Length(s)));
            Pop(stacks[t])
        end
    end
end.

Но почему-то WA(Wrong Answer на 3-ем..)

[Poma][a]

Еще раз огромное спасибо!!
Я сдал

Косяк был в этой строке :

    t := values[s+5] shr 9 or t;

Нужно было shl..

[Аватар]

Только сейчас обратил внимание, что в своем коде нацеливался на максимальную глубину стека в 100000, а не такое количество строк. Можно было спокойно обойтись без начальной инициализации стека и возврата в свободные Было бы короче

program Project1;

var stacks: array[1..1000] of Longint;
    values: array[1..600000] of Byte;
    i,m,First,Last,n,v,c: Longint;
    s: String;

procedure SetIndexToStack(IndexOfStack,Index: Longint);
begin
  values[(IndexOfStack-1)*6+6]:=Index mod $100;
  values[(IndexOfStack-1)*6+5]:=(Index div $100) mod $100;
  values[(IndexOfStack-1)*6+4]:=(values[(IndexOfStack-1)*6+4] and $FE) or (Index div $10000);
end;

procedure SetValueToStack(IndexOfStack,Value: Longint);
begin
  values[(IndexOfStack-1)*6+1]:=Value mod $100;
  values[(IndexOfStack-1)*6+2]:=(Value mod $10000) div $100;
  values[(IndexOfStack-1)*6+3]:=(Value mod $1000000) div $10000;
  values[(IndexOfStack-1)*6+4]:=(values[(IndexOfStack-1)*6+4] and $01) or ((Value div $1000000) shl 2)
end;

function GetIndexFromStack(IndexOfStack: Longint): Longint;
begin
  Result:=values[(IndexOfStack-1)*6+6]+
          values[(IndexOfStack-1)*6+5]*$100+
          (values[(IndexOfStack-1)*6+4] and $01)*$10000;
end;

function GetValueFromStack(IndexOfStack: Longint): Longint;
begin
  Result:=values[(IndexOfStack-1)*6+1]+
          values[(IndexOfStack-1)*6+2]*$100+
          values[(IndexOfStack-1)*6+3]*$10000+
          (values[(IndexOfStack-1)*6+4] shr 2)*$1000000;
end;

procedure GetPush(var t, v : LongInt; s : string);
var f,i: LongInt;
begin
    f := Pos(' ', s)+1; i := f;
    while s[i] <> ' ' do Inc(i);
    Val(Copy(s, f, i-f),t,c);
    Val(Copy(s, i+1, Length(s)),v,c);
end;

procedure AddToStack(Stack,Value: LongInt);
begin
  Last:=First;
  First:=GetIndexFromStack(Last);
  SetIndexToStack(Last,stacks[Stack]);
  stacks[Stack]:=Last;
  SetValueToStack(Last,Value);
end;

procedure DelFromStack(Stack: LongInt);
begin
  WriteLn(output,GetValueFromStack(stacks[Stack]));
  Last:=stacks[Stack];
  stacks[Stack]:=GetIndexFromStack(Last);
  SetIndexToStack(Last,First);
  First:=Last;
end;

begin

{$IFNDEF ONLINE_JUDGE}
  Assign(input, 'input.txt');
  Reset(input);
  Assign(output, 'output.txt');
  Rewrite(output);
{$ENDIF}

  for i:=1 to 1000 do stacks[i]:=0;
  for i:=1 to 99999 do SetIndexToStack(i,i+1);
  SetIndexToStack(100000,0);
  First:=1;

  ReadLn(input,m);
  for i:=1 to m do begin
    ReadLn(input,s);
    if s[2]='U' then begin
      GetPush(n,v,s);
      AddToStack(n,v);
    end
    else begin
      Val(Copy(s, Pos(' ', s), Length(s)),n,c);
      DelFromStack(n);
    end;
  end;
{$IFNDEF ONLINE_JUDGE}
   close(input);
   close(output);
{$ENDIF}

end.

[kostan3]

а так не проще?

const
  max=100000;
  stacks=1000;
var
  a:array[1..max]of longint;
  p:array[1..max]of word;
  last:array[1..stacks]of longint;
  n,i,s,v:longint;
  c:char;
begin
  readln(n);
  for i:=1 to n do begin
    read(c,c,c,c);
    case c of
      'H':begin
            readln(s,v);
            a[i]:=v shl 1+last[s] and 1;
            p[i]:=last[s] shr 1;
            last[s]:=i;
          end;
      ' ':begin
            readln(s);
            writeln(a[last[s]] shr 1);
            last[s]:=p[last[s]] shl 1+a[last[s]] and 1;
          end;
    end;
  end;
end.