Форум: "Потрепаться";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];
ВнизПятничные задачки. Сogito ergo sum. Найти похожие ветки
← →
default © (2005-10-07 15:14) [40]GuAV © (07.10.05 12:59) [29]
по-моему нифига не линеен
расскажи алгоритм на словах
← →
default © (2005-10-07 15:15) [41]Прынц (07.10.05 15:03) [39]
"Покой нам только снится"(c)
← →
MBo © (2005-10-07 15:31) [42]>default © (07.10.05 14:30) [38]
>MBo © (07.10.05 14:17) [37]
>да, неплохо бы словами объяснил
у GuAV примерно так, если не ошибаюсь:
Запоминаем очередной (n-й) элемент, смещаем по очереди n+Shift*i -ые (по модулю) элементы на Shift влево, пока не упремся в n-Shift.
>кстати, у Вас в ответе какой алгоритм?
Ну конкретного и единственного ответа здесь нет.
← →
default © (2005-10-07 15:36) [43]MBo © (07.10.05 15:31) [42]
так линейности вроде не получается?
← →
GuAV © (2005-10-07 15:51) [44]
>GuAV © (07.10.05 12:59) [29]
> расскажи алгоритм на словах
Внутренний repeat:
Запоминаем первый элемент и заменяем его элементом удалённым на shift от первого, его в свою очередь удалённым от него на shift и т.д., при нахождении индекса каждого элемента осуществляем wrap по длине строки с помощью mod; этот цикл прекращается когда доходим обратно до первого элемента, при этом для последнего берется ранее запомненое значение первого.
Внешний repeat:
Вышеописанный цикл пройдёт только элементы с индексами (N*НОД)+1, где N-целое число, НОД - наибольший общий делитель shift и length. Поэтому ведется учёт количества перемещенных символов Replaced, и если при завершении внутреннего Repeat цикла оно меньше длины, то внутренний цикл повторяется уже начиная со второго символа, затем третьего и т.д., пока не будут перемещены все символы.
← →
GuAV © (2005-10-07 16:00) [45]Линейность - это
> за время O(N)
, что означает число операций при удлинении строки в N раз увеличивается в N раз ?
Тогда это у меня соблюдается.
← →
default © (2005-10-07 16:05) [46]GuAV © (07.10.05 16:00) [45]
да, всё нормально
"Линейность - это
> за время O(N)
, что означает число операций при удлинении строки в N раз увеличивается в N раз ?
"
и это тоже, хотя настоящий смысл O(N) более общий
← →
MBo © (2005-10-07 16:10) [47]>default © (07.10.05 15:36) [43]
>так линейности вроде не получается?
получается.
Это, можно сказать, усовершенствованный с точки зрения памяти аналог простого алгоритма с потреблением памяти O(N), когда мы в доп. память записываем сдвигаемый кусок A (выбрав меньший), сдвигаем оставшийся B, копируем на своб. место А.
← →
default © (2005-10-07 17:07) [48]MBo © (07.10.05 16:10) [47]
самый лучший алгоритм который я знаю - это с обращением
пусть исходная строка ab, a-часть строки длиной сдвига, b-остаток
R-переставляет наоборот строку
тогда
R(R(a)R(b)) есть решение задачи
← →
oldman © (2005-10-07 17:40) [49]
> 3. Вася Пупкин получил два предложения о работе.
> ..........
> Куда ему лучше податься?
Устроиться на об работы!!!
:)))
← →
MBo © (2005-10-07 17:43) [50]>default © (07.10.05 17:07) [48]
Да, я знаю. По моим тестам процедура с обращением строки раза в полтора-два быстрее, а уж про изящество и так понятно.
← →
default © (2005-10-07 18:04) [51]MBo © (07.10.05 17:43) [50]
да у GuAV мудрёно
тем более надо доказывать его корректность
типа нет зацикливаний до момента встречи с сохранённым элементом и некоторое другое...
ещё рекурсивная версия есть
← →
GuAV © (2005-10-07 23:11) [52]1.
unit avHanoi;
interface
uses SysUtils, Classes;
type
TStick = 1..3;
TOnMove = procedure(Sender: TObject; Src, Dest: TStick) of object;
THanoiTowers = class(TObject)
private
FBlocks: array of TStick;
FOnChange: TNotifyEvent;
FOnMove: TOnMove;
function GetIsBlockOnStick(Stick: TStick; Block: Integer): Boolean;
procedure SetBlockCount(const Value: Integer);
function GetBlockOnStick(Block: Integer): TStick;
procedure SetBlockOnStick(Block: Integer; const Value: TStick);
function GetBlockCount: Integer;
protected
procedure Changed;
procedure Moved(Src, Dest: TStick);
public
property BlockCount: Integer read GetBlockCount write SetBlockCount;
property IsBlockOnStick[Stick: TStick; Block: Integer]: Boolean read GetIsBlockOnStick;
property BlockOnStick[Block: Integer]: TStick read GetBlockOnStick write SetBlockOnStick;
procedure Move(Src, Dest: TStick);
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnMove: TOnMove read FOnMove write FOnMove;
end;
type
THanoiSolver = class(TObject)
private
FTowers: THanoiTowers;
procedure SetTowers(const Value: THanoiTowers);
procedure GetBlockToStick(Block: Integer; Stick: TStick);
public
property Towers: THanoiTowers read FTowers write SetTowers;
procedure Solve;
end;
implementation
{ THanoiTowers }
function THanoiTowers.GetIsBlockOnStick(Stick: TStick; Block: Integer): Boolean;
begin
Result := BlockOnStick[Block] = Stick;
end;
procedure THanoiTowers.SetBlockCount(const Value: Integer);
begin
SetLength(FBlocks, Value);
Changed;
end;
function THanoiTowers.GetBlockCount: Integer;
begin
Result := Length(FBlocks);
end;
procedure THanoiTowers.Changed;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
function THanoiTowers.GetBlockOnStick(Block: Integer): TStick;
begin
Result := FBlocks[Block - 1] + 1;
end;
procedure THanoiTowers.SetBlockOnStick(Block: Integer; const Value: TStick);
begin
FBlocks[Block - 1] := Value - 1;
end;
procedure THanoiTowers.Move(Src, Dest: TStick);
var I, J: Integer;
begin
I := 1;
while BlockOnStick[I] <> Src do
begin
Inc(I);
if I > BlockCount then
raise Exception.Create("Invalid move: stick is empty");
end;
for J := I downto 1 do
if IsBlockOnStick[Dest, J] then
raise Exception.Create("Invalid move: stick has a smaller (or this) block");
BlockOnStick[I] := Dest;
Moved(Src, Dest);
Changed;
end;
procedure THanoiTowers.Moved(Src, Dest: TStick);
begin
if Assigned(FOnMove) then
FOnMove(Self, Src, Dest);
end;
function GetRemainingStick(S1, S2: TStick): TStick;
begin
if (S1 <> 1) and (S2 <> 1) then
Result := 1
else if (S1 <> 2) and (S2 <> 2) then
Result := 2
else if (S1 <> 3) and (S2 <> 3) then
Result := 3
else
raise Exception.Create("out of sticks");
end;
{ THanoiSolver }
procedure THanoiSolver.GetBlockToStick(Block: Integer; Stick: TStick);
var I: Integer; Src: TStick;
begin
Src := FTowers.BlockOnStick[Block];
if Stick = Src then
Exit; // already there
for I := Block - 1 downto 1 do
begin
GetBlockToStick(I, GetRemainingStick(Src, Stick));
end;
FTowers.Move(Src, Stick)
end;
procedure THanoiSolver.SetTowers(const Value: THanoiTowers);
begin
FTowers := Value;
end;
procedure THanoiSolver.Solve;
var I: Integer;
begin
for I := FTowers.BlockCount downto 1 do
GetBlockToStick(I, 3);
end;
end.
← →
GuAV © (2005-10-07 23:12) [53]Форма тестового проекта
.pasunit avHMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, avHanoi;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Panel1: TPanel;
btnSetCount: TButton;
Panel2: TPanel;
Memo1: TMemo;
Edit1: TEdit;
Bevel1: TBevel;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
btnPlay: TButton;
Bevel2: TBevel;
btnSolve: TButton;
chkRecord: TCheckBox;
Bevel3: TBevel;
btnClr: TButton;
Bevel4: TBevel;
btnRandomize: TButton;
procedure PaintBox1Paint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnSetCountClick(Sender: TObject);
procedure btnPlayClick(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnClrClick(Sender: TObject);
procedure chkRecordClick(Sender: TObject);
procedure btnSolveClick(Sender: TObject);
procedure btnRandomizeClick(Sender: TObject);
private
FHanoi: THanoiTowers;
FClickedRow: TStick;
FClickedBlock: Integer;
{ Private declarations }
public
property Hanoi: THanoiTowers read FHanoi;
procedure TryMove;
procedure HanoiMove(Sender: TObject; Src, Dest: TStick);
procedure HanoiChange(Sender: TObject);
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
BlockHeight,
BlockDeltaHalfWidth,
BlockHalfWidth,
BlockPos,
StickPos,
I: Integer;
S: TStick;
begin
with Hanoi, PaintBox1, Canvas do
begin
BlockHeight := Height div BlockCount;
BlockDeltaHalfWidth := (Width div 6) div BlockCount;
with Brush do
begin
Color := clWindow;
end;
for S := Low(S) to High(S) do
begin
StickPos := MulDiv(Width, S * 2 - 1, 6);
BlockPos := Height;
for I := BlockCount downto 1 do
if IsBlockOnStick[S, I] then
begin
BlockHalfWidth := BlockDeltaHalfWidth * (I + 0);
Rectangle(
StickPos - BlockHalfWidth,
BlockPos - BlockHeight,
StickPos + BlockHalfWidth,
BlockPos
);
Dec(BlockPos, BlockHeight);
end;
MoveTo(StickPos, 0);
LineTo(StickPos, PaintBox1.Height);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FHanoi := THanoiTowers.Create;
Hanoi.OnChange := HanoiChange;
Hanoi.BlockCount := 4;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FHanoi.Free;
end;
procedure TForm1.btnSetCountClick(Sender: TObject);
begin
Hanoi.BlockCount := StrToInt(Edit1.Text);
end;
procedure NextNum(var I, J: Integer; const S: string);
var Len: Integer;
begin
J := 0;
Len := Length(S);
while I <= Len do
if (S[I] in ["0".."9"]) then
Break
else
Inc(I);
while I + J <= Len do
if not (S[I + J] in ["0".."9"]) then
Break
else
Inc(J);
end;
procedure TForm1.btnPlayClick(Sender: TObject);
var
S: string;
I, J: Integer;
begin
TryMove;
S := Memo1.Text;
I := 1;
NextNum(I, J, S);
Edit2.Text := Copy(S, I, J);
I := I + J;
NextNum(I, J, S);
Edit3.Text := Copy(S, I, J);
I := I + J;
Memo1.Text := Copy(S, I, MaxInt);
end;
function MulDiv(Number, Numerator, Denominator: Integer): Integer;
begin
Result := Number * Numerator div Denominator;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
I, ClickedCol: Integer;
begin
with Hanoi do
begin
with PaintBox1 do
begin
FClickedRow := MulDiv(X, 3, Width) + 1;
ClickedCol := MulDiv(Height - Y - 1, BlockCount, Height) + 1;
end;
FClickedBlock := 0;
for I := BlockCount downto 1 do
if IsBlockOnStick[FClickedRow, I] then
begin
Dec(ClickedCol);
if ClickedCol = 0 then
begin
FClickedBlock := I;
Break;
end;
end;
end;
end;
procedure TForm1.PaintBox1Click(Sender: TObject);
begin
if FClickedRow = 0 then Exit;
if FClickedBlock <> 0 then
begin
Edit2.Text := IntToStr(FClickedRow);
end
else
begin
Edit3.Text := IntToStr(FClickedRow);
TryMove;
end;
end;
procedure TForm1.TryMove;
var I, J: Integer;
begin
if TryStrToInt(Edit2.Text, I) then
if TryStrToInt(Edit3.Text, J) then
Hanoi.Move(I, J);
end;
procedure TForm1.HanoiChange(Sender: TObject);
begin
PaintBox1.Invalidate;
end;
procedure TForm1.btnClrClick(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
procedure TForm1.HanoiMove(Sender: TObject; Src, Dest: TStick);
begin
Memo1.Text := Memo1.Text + Format(" %d-%d", [Src, Dest]);
end;
procedure TForm1.chkRecordClick(Sender: TObject);
begin
if chkRecord.Checked then
Hanoi.OnMove := HanoiMove
else
Hanoi.OnMove := nil;
end;
procedure TForm1.btnSolveClick(Sender: TObject);
begin
with THanoiSolver.Create do
try
Towers := Self.Hanoi;
Solve;
finally
Free;
end;
end;
procedure TForm1.btnRandomizeClick(Sender: TObject);
var I: Integer;
begin
Hanoi.BlockCount := Random(4) + 3;
for I := 1 to Hanoi.BlockCount do
Hanoi.BlockOnStick[I] := Random(3) + 1;
end;
end.
← →
GuAV © (2005-10-07 23:12) [54].dfm
object Form1: TForm1
Left = 202
Top = 107
Width = 637
Height = 353
Caption = "Form1"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 629
Height = 161
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 0
object Bevel1: TBevel
Left = 2
Top = 2
Width = 103
Height = 39
Shape = bsRightLine
end
object Label1: TLabel
Left = 144
Top = 16
Width = 9
Height = 13
Caption = "to"
end
object Bevel2: TBevel
Left = 138
Top = 2
Width = 103
Height = 39
Shape = bsRightLine
end
object Bevel3: TBevel
Left = 280
Top = 2
Width = 65
Height = 39
Shape = bsRightLine
end
object Bevel4: TBevel
Left = 360
Top = 2
Width = 65
Height = 39
Shape = bsRightLine
end
object btnSetCount: TButton
Left = 40
Top = 8
Width = 57
Height = 25
Caption = "set count"
TabOrder = 0
OnClick = btnSetCountClick
end
object Memo1: TMemo
Left = 8
Top = 40
Width = 609
Height = 113
TabOrder = 1
end
object Edit1: TEdit
Left = 8
Top = 8
Width = 25
Height = 21
TabOrder = 2
Text = "3"
end
object Edit2: TEdit
Left = 112
Top = 8
Width = 25
Height = 21
TabOrder = 3
end
object Edit3: TEdit
Left = 160
Top = 8
Width = 25
Height = 21
TabOrder = 4
end
object btnPlay: TButton
Left = 192
Top = 8
Width = 41
Height = 25
Caption = "play"
TabOrder = 5
OnClick = btnPlayClick
end
object btnSolve: TButton
Left = 432
Top = 8
Width = 57
Height = 25
Caption = "Solve !"
TabOrder = 6
OnClick = btnSolveClick
end
object chkRecord: TCheckBox
Left = 280
Top = 16
Width = 57
Height = 17
Caption = "Record"
TabOrder = 7
OnClick = chkRecordClick
end
object btnClr: TButton
Left = 248
Top = 8
Width = 25
Height = 25
Caption = "Clr"
TabOrder = 8
OnClick = btnClrClick
end
object btnRandomize: TButton
Left = 352
Top = 8
Width = 65
Height = 25
Caption = "Randomize"
TabOrder = 9
OnClick = btnRandomizeClick
end
end
object Panel2: TPanel
Left = 0
Top = 161
Width = 629
Height = 165
Align = alClient
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 1
object PaintBox1: TPaintBox
Left = 2
Top = 2
Width = 625
Height = 161
Align = alClient
OnClick = PaintBox1Click
OnMouseDown = PaintBox1MouseDown
OnPaint = PaintBox1Paint
end
end
end
← →
GuAV © (2005-10-08 00:05) [55]На словах:
Переместить все диски на правый стержень от наибольшего к наименьшему
Переместить диск на стержень - убедится, что он ещё не на целевом стержне; затем переместить все диски меньше этого на стержень, не являющийся ни целевым, ни исходным для перемещаемого диска, от большего к меньшему; после чего переложить диск на стержень.
← →
SergP. (2005-10-08 04:32) [56]
> 3. Вася Пупкин получил два предложения о работе.
> Фирма "Рога и Копыта" предлагает ему 18000$ в год с увеличением
> каждый год
> на 2000$, а ООО "ЗюЗюЗю" предлагает тот же стартап с увеличением
> каждые полгода
> на 500$. Куда ему лучше податься?
С увеличением на 500 каждые полгода чего?
Годовой зарплаты или полугодовой ?
Страницы: 1 2 вся ветка
Форум: "Потрепаться";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];
Память: 0.59 MB
Время: 0.059 c