Hello,
I've passed successfully passed both tests 3N+1 and 101 Blocks.
3N+1 is similar to VIncent's solution.
101 Blocks solution is attached here. Mode ObjFPC is accepted which
means we can use our modern pascal dialects. I was afraid it wouldn't be
possible.
Thanks.
Thierry
Vincent Snijders wrote:
Thierry Coq schreef:
Thank you guys,
Has somebody here delivered a successful pascal program to the UVa
online judge: http://icpcres.ecs.baylor.edu/onlinejudge/index.php ?
Test problem 100:
http://icpcres.ecs.baylor.edu/onlinejudge/index.php?option=com_onlinejudge&Itemid=8&category=3&page=show_problem&problem=36
I just succesfully submitted and passed this test problem. See
attachment for source code.
Vincent
------------------------------------------------------------------------
_______________________________________________
Lazarus mailing list
Lazarus@lazarus.freepascal.org
http://www.lazarus.freepascal.org/mailman/listinfo/lazarus
//==============================================================================
program test101_16_asobj(input, output);
//==============================================================================
// Submission n° 7034612
// result is right answer. Speed is OK: 0.000 s
{$MODE OBJFPC}
uses
SysUtils;
type
TBlock = class
number: integer;
stack: integer;
above: TBlock; //the one higher on the pile. nil if nobody after
below: TBlock; //the one below on the pile, nil if nobody before
public
procedure RemoveStackFromStack;
procedure ResetBlocksAbove;
procedure PutStackOnStack(aStack:integer);
end;
const
MaxBlocks = 25;
var
WaitingForCommands: Boolean;
aCommand: String;
N : Integer; // blocksize
table: array[0..MaxBlocks] of TBlock;
tablelast: array[0..MaxBlocks] of TBlock;
blocks: array[0..MaxBlocks] of TBlock;
//==============================================================================
//creates a block for each position on the table
procedure InitializeState;
//==============================================================================
var
iBlock: integer;
ablock: TBlock;
begin
for iBlock := 0 to MaxBlocks do
begin
aBlock := TBlock.Create;
aBlock.number := iBlock;
aBlock.stack := iBlock;
aBlock.above := nil;
aBlock.below := nil;
blocks[iBlock] := aBlock;
table[iBlock] := aBlock;
tableLast[iBlock] := aBlock;
end;
end;
//==============================================================================
//prints the status of the table
procedure PrintState;
//==============================================================================
var
iStack: integer;
aBlock: TBlock;
begin
for iStack := 0 to N-1 do
begin
write(iStack,':');
aBlock := table[iStack];
while (aBlock<>nil) do
begin
write(' ', aBlock.number);
aBlock := aBlock.above;
end;
writeln;
end;
end;
//==============================================================================
function IsIllegalMove(block1, block2: integer): Boolean;
//==============================================================================
begin
//a move is illegal, if block1 = block2, or
// if block1 and block2 are in the same pile...
IsIllegalMove := false;
// a = b
if block1=block2 then
begin
IsIllegalMove := true;
end
else
begin
// a and b in same stack
if (block1>=N) or (block2>=N) then
begin
IsIllegalMove := true;
end
else
begin
if blocks[block1].stack = blocks[block2].stack then
IsIllegalMove := true;
end;
end;
end;
//==============================================================================
// removes the stack starting with aBlock from the current stack.
procedure TBlock.RemoveStackFromStack;
//==============================================================================
var
oldStack : integer;
previous : TBlock;
begin
//removing the block from the current stack...
oldStack := Self.stack;
//unchaining the block;
previous := Self.below;
// reknitting forward chain
if previous = nil then
table[oldStack] := nil
else
previous.above := nil;
//reknitting backwards chain
Self.below := nil;
tableLast[oldStack] := previous;
end;
//==============================================================================
// puts the block on top of the stack..
procedure TBlock.PutStackOnStack(aStack:integer);
//==============================================================================
var
lastBlock: TBlock;
nextBlock: TBlock;
begin
if aStack<0 then exit;
lastBlock := tableLast[ aStack];
Self.RemoveStackFromStack;
// don't add the block if it is already on the stack
if assigned(lastBlock) then
if lastBlock.Number = Self.Number then
exit;
//knitting forward chain...
if not assigned(lastBlock) then
table[aStack] := Self
else
lastBlock.above := Self;
nextBlock := Self;
while (nextBlock<>nil) do
begin
nextBlock.stack := aStack;
tableLast[aStack] := nextBlock;
nextBlock := nextBlock.above;
end;
//knitting backwards chain...
if not assigned(lastblock) then
Self.below := nil
else
Self.below := lastBlock;
end;
//==============================================================================
// moves all blocks above and including aBlock to their original stack
procedure TBlock.ResetBlocksAbove;
//==============================================================================
var
firstBlock: TBlock;
nextBlock: TBlock;
aStack: integer;
begin
// we need to move from the top block down... or we lose the stack
information.
aStack := Self.stack;
firstBlock := tableLast[aStack];
while (firstBlock<>nil) do
begin
if firstblock.number=Self.number then break;
nextBlock := firstBlock.below;
firstBlock.PutStackOnStack(firstBlock.number);
firstBlock := nextBlock;
end;
end;
//==============================================================================
procedure MoveOnto(block1, block2:integer);
//==============================================================================
begin
blocks[block1].ResetBlocksAbove;
blocks[block2].ResetBlocksAbove;
blocks[block1].PutStackOnStack( blocks[block2].stack);
end;
//==============================================================================
procedure MoveOver(block1, block2:integer);
//==============================================================================
begin
blocks[block1].ResetBlocksAbove;
blocks[block1].PutStackOnStack( blocks[block2].stack);
end;
//==============================================================================
procedure PileOnto(block1, block2:integer);
//==============================================================================
begin
blocks[block2].ResetBlocksAbove;
blocks[block1].PutStackOnStack( blocks[block2].stack);
end;
//==============================================================================
procedure PileOver(block1, block2:integer);
//==============================================================================
begin
blocks[block1].PutStackOnStack( blocks[block2].stack);
end;
//==============================================================================
//processes each command
procedure ProcessCommand(const aCommand:String);
//==============================================================================
var
C1, C2: Char;
B1, B2 : String;
p : integer; // position
dec: integer;
aChar : char;
l : integer;
block1, block2 : integer;
begin
// my parsing has to be faster.
// each command is of the format : command1 block1 command2 block2, like:
// "move a onto b"
// "move a over b"
// "pile a onto b"
// "pile a over b"
// C1 B1 C2 B2
// except "quit"
// parse command
//writeln('p:', p); //DEBUG
// checking for the quit command
if (aCommand[1] = 'q') then //'quit'
begin
WaitingForCommands := false;
Exit;
end;
// reinit for parsing command:
dec := 0;
l := length(aCommand);
// getting C1
C1 := aCommand[1]; // C1 is always 4 letters, only the first is needed
// getting B1's position
p := 6;
B1 := aCommand[p];
inc(p);
aChar := aCommand[p];
if aChar <>' ' then
begin
inc(dec); // the B1 is on two chars...
B1 := B1 + aChar;
end;
block1 := StrToInt(B1);
C2 := aCommand[9+dec]; // C2 is always 4 letters, only the second is needed
p := 13+dec;
B2 := aCommand[p];
if p<l then
begin
inc(p);
aChar := aCommand[p];
if aChar <>' ' then
begin
B2 := B2 + aChar;
end;
end;
block2 := StrToInt(B2);
If not isIllegalMove(block1, block2) then
begin
if C1 = 'm' then //move
begin
if C2 = 'n' then //onto
MoveOnto(block1, block2)
else
MoveOver(block1, block2);
end
else
begin
if C2 = 'n' then
PileOnto(block1, block2)
else
PileOver(block1, block2);
end;
end;
end;
// main program read data
begin
Readln(N);
InitializeState;
WaitingForCommands := true;
while WaitingForCommands do
begin
Readln( aCommand);
ProcessCommand( aCommand);
end;
PrintState;
end.
_______________________________________________
Lazarus mailing list
Lazarus@lazarus.freepascal.org
http://www.lazarus.freepascal.org/mailman/listinfo/lazarus
