Каюсь, иногда играю в комп. игры. И вот в "Космических рейнджерах" был квест с этой задачкой:
Дано:
Река, лодка вместимостью 2 человека, два берега.
Условия:
На одном берегу 4 человека. Первый может проплыть на лодке на другой берег за 1 час, второй за 2 часа, третий за 5 часов, четвертый за 10 часов. Если в лодке два человека то она проплывет за время "самого медленного пассажира".
Задача:
Необходимо перевести всех людей на другой берег не более чем за 18 часов!
Сходу решить мне не удалось - написал на Паскале. Квест прошел.
Свой вариант выложу по окончанию времени конкурса.
Условия конкурса:
Свои решения присылать на "мыло": apalprival @ narod . ru.
Срок проведения 2 недели, т.е. до 7 февраля 2005 г. (это еще можно обсудить)
Номинации:
1. Самое первое правильное решение.
2. Самое короткое-оптимальное решение.
3. Самое изощренное решение.
Каждому победителю +1 к повышению рейтинга на форуме.
Свои решения присылайте в архивированном виде! И не забудьте включить в архив исполняемый модуль (*.EXE), дабы избежать конфликтов компиляторов.
Полная версия: Конкурс на решение задачи!
Опровержение такой возможности: (ИМХО)
| Скрытый текст |
| Если переправить троих человек - 2,5 и 10 часовых , то только ОТПРАВКА ИХ НА ТОТ БЕРЕГ будет занимать 2+5+10 часов =17 часов. А лодку еще надо возвращать обратно 2 раза. А в случае если поедут двое напрмиер 10+5 то обратно 5 часов возварщаться... Итого минимум 19 часов. вот доказательство на Паскале: КОД:(в теги не заключать - пропадет невидимость!) var a:array[1..4] of byte; i,j,k,l,time:byte; Function max(a,b:byte):byte; begin if a>b then max:=a else max:=b end; begin a[1]:=1; a[2]:=2; a[3]:=5; a[4]:=10; For i:=1 to 4 do for j:=1 to 4 do for k:=1 to 4 do for l:=1 to 4 do begin If (i<>j)and(i<>k)and(i<>l)and(j<>k)and(j<>l)and(k<>l) then begin time:=max(a[i],a[j])+a[i]+ {ЇҐаҐўҐ§«Ё 1®Ј® ўҐаг«Ёбм} max(a[i],a[k])+a[i]+ {ЇҐаҐўҐ§«Ё в®в ЎҐаҐЈ ўв®а®Ј® 祫 } max(a[i],a[l]); If time<=18 then writeln(i,' ',j,' ',k,' ',l,' time = ',time); end end end. |
Oleg_Z, не совсем все так просто... вот один из вариантов решения:
| Скрытый текст |
| 1-2 2 10-5 1 2-1 |
Итог - 17 часов на переброску четырех человек.
да, все понял....
я не учел что
я не учел что
| Скрытый текст |
| может кто-то вернуться из тех, кто туда уже сплавал |
я наверное тупой... но по-моему невозможно перевезти людей за 18 часов... минимальное время - 19 часов... разве-что пустую лодка сама может приплыть обратно на другой берег....
Первый едет с 4-ым на берег 2 +10 часов
Первый возвращается на берег 1 +1 час
Первый едет с 3-ым на берег 2 +5 часов
Первый возвращается на берег 1 +1 час
Первый едет с 2-ым на берег 2 +2 часов
10+1+5+1+2=19
Первый едет с 4-ым на берег 2 +10 часов
Первый возвращается на берег 1 +1 час
Первый едет с 3-ым на берег 2 +5 часов
Первый возвращается на берег 1 +1 час
Первый едет с 2-ым на берег 2 +2 часов
10+1+5+1+2=19
Junkie
Возможно и не только за 18, а за 17 - точно. Может быть, можно и за меньшее время. Кто знает...
Возможно и не только за 18, а за 17 - точно. Может быть, можно и за меньшее время. Кто знает...
Apal, ты мой герой !!!!
я над этим квестом 3-е суток парился, так и не решил :no:
стока денег и респекту потерял...
я над этим квестом 3-е суток парился, так и не решил :no:
стока денег и респекту потерял...
Цитата
я наверное тупой... но по-моему невозможно перевезти людей за 18 часов... минимальное время - 19 часов... разве-что пустую лодка сама может приплыть обратно на другой берег....
Нет, просто ты забыл, что оттуда может вернуться кто-то кто уже там ;)
Цитата(GoodWind @ 25.01.05 20:28)
Apal, ты мой герой !!!!
я над этим квестом 3-е суток парился, так и не решил :no:
стока денег и респекту потерял...
я над этим квестом 3-е суток парился, так и не решил :no:
стока денег и респекту потерял...
Я тоже немного посидел и вот сделал прогу которая сама все решила... :D
А задачка хорошая, мне понравилась!
Я Рейнджеров купил, как только они вышли. Этот квест проходил тупым перебором. Потом прошёл (17 часов). Кстати, там можно делать свои квесты (есть прога на сайте производителя).
FreeMan - флейм! Давайте не отклоняться от темы.
Дамы и господа!
Неужели все так сложно? Или сроки проведения конкурса продлить?
Еще ни одного письма с решением не получил!
P.S.: Мозги надо иногда разминать...
Дамы и господа!
Неужели все так сложно? Или сроки проведения конкурса продлить?
Еще ни одного письма с решением не получил!
P.S.: Мозги надо иногда разминать...
Первое решение поступило.
APAL
:D Жди последнего дня ... тебя решениями завалят ... всё же как обычно делается в последний день. (точнее в последнюю ночь)
:D Жди последнего дня ... тебя решениями завалят ... всё же как обычно делается в последний день. (точнее в последнюю ночь)
APAL
Письмо моё получил?
Письмо моё получил?
Цитата(Jahnerus @ 3.02.05 21:00)
APAL
Письмо моё получил?
Письмо моё получил?
Да, письмо получил.
От Volvo тоже пришло второе решение.
Итак, можно подводить итог!
К сожалению конкурсантов всего двое.
Я рад такому бурному и оживленному решению поставленной задачи. (камень в огород тех кто не принял участи)
К сожалению конкурсантов всего двое.
Я рад такому бурному и оживленному решению поставленной задачи. (камень в огород тех кто не принял участи)
1. Самое первое правильное решение
VOLVO
VOLVO
Исходный код
const
size = 4;
type
all_type = array[1 .. size] of integer;
pair = array[1 .. 2] of word;
const
s1_len = 6;
step_one: array[1 .. s1_len] of pair =
((1, 2), (1, 3), (1, 4), (2, 3), (2, 4), (3, 4));
s2_len = 2;
step_two: array[1 .. s2_len] of word =
(1, 2);
s3_len = 3;
step_three: array[1 .. s3_len] of pair =
((1, 2), (2, 3), (1, 3));
s4_len = 3;
step_four: array[1 .. s4_len] of word =
(1, 2, 3);
s5_len = 1;
step_five: array[1 .. s5_len] of pair =
((1, 2));
const
right: all_type = (1, 2, 5, 10);
left: all_type = (-1, -1, -1, -1);
procedure compact(var x: all_type);
var T: all_type;
i, next: byte;
begin
move(x, T, sizeof(x));
next := 0;
for i := 1 to size do
if T[i] <> -1 then
begin
inc(next);
x[next] := T[i]
end;
for i := succ(next) to size do
x[i] := -1;
end;
procedure append(var x: all_type; a: word);
var i: integer;
begin
i := 1;
while x[i] <> -1 do inc(i);
x[i] := a;
end;
function max(a, b: word): word;
begin
max := a;
if b > a then max := b
end;
function get_two(by: pair; var x: pair): word;
begin { from right }
x[1] := right[by[1]]; right[by[1]] := -1;
x[2] := right[by[2]]; right[by[2]] := -1;
compact(right);
get_two := max(x[1], x[2])
end;
function get_one(by: word; var x: word): word;
begin { from left }
x := left[by]; left[by] := -1;
compact(left);
get_one := x
end;
procedure print_array(x: all_type);
var i: byte;
begin
for i := 1 to size do
if x[i] <> -1 then write(x[i]:4);
writeln
end;
var
min1, min2, min3, min4, min5: byte;
mp: pair; path, T: word;
procedure create_path;
var
right0, right1, right2, right3, right4,
left0, left1, left2, left3, left4: all_type;
s1, s2, s3, s4: word;
p1, p2, p3, p4, p5: byte;
min_path: word;
begin
path := 0; min_path := maxInt;
move(left, left0, sizeof(left));
move(right, right0, sizeof(right));
for p1 := 1 to s1_len do
begin
move(left0, left, sizeof(left));
move(right0, right, sizeof(right));
path := get_two(step_one[p1], mp);
append(left, mp[1]); append(left, mp[2]);
s1 := path;
move(left, left1, sizeof(left));
move(right, right1, sizeof(right));
for p2 := 1 to s2_len do
begin
path := s1;
move(left1, left, sizeof(left));
move(right1, right, sizeof(right));
inc(path, get_one(step_two[p2], T));
append(right, T);
s2 := path;
move(left, left2, sizeof(left));
move(right, right2, sizeof(right));
for p3 := 1 to s3_len do
begin
path := s2;
move(left2, left, sizeof(left));
move(right2, right, sizeof(right));
inc(path, get_two(step_three[p3], mp));
append(left, mp[1]); append(left, mp[2]);
s3 := path;
move(left, left3, sizeof(left));
move(right, right3, sizeof(right));
for p4 := 1 to s4_len do
begin
path := s3;
move(left3, left, sizeof(left));
move(right3, right, sizeof(right));
inc(path, get_one(step_four[p4], T));
append(right, T);
s4 := path;
move(left, left4, sizeof(left));
move(right, right4, sizeof(right));
for p5 := 1 to s5_len do
begin
path := s4;
move(left4, left, sizeof(left));
move(right4, right, sizeof(right));
inc(path, get_two(step_five[p5], mp));
append(left, mp[1]); append(left, mp[2]);
if min_path > path then
begin
min1 := p1; min2 := p2; min3 := p3;
min4 := p4; min5 := p5;
min_path := path;
end;
end;
end;
end;
end;
end;
writeln('min path len = ', min_path);
move(left0, left, sizeof(left));
move(right0, right, sizeof(right));
end;
begin
write('right'); print_array(right);
write('left'); print_array(left);
writeln('starting...');
create_path;
{#1}
path := get_two(step_one[min1], mp);
append(left, mp[1]); append(left, mp[2]);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
{#2}
inc(path, get_one(step_two[min2], T));
append(right, T);
writeln('left > right: ', T:4, ' time = ', path);
{#3}
inc(path, get_two(step_three[min3], mp));
append(left, mp[1]); append(left, mp[2]);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
{#4}
inc(path, get_one(step_four[min4], T));
append(right, T);
writeln('left > right: ', T:4, ' time = ', path);
{#5}
inc(path, get_two(step_five[min5], mp));
append(left, mp[1]); append(left, mp[2]);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
end.
size = 4;
type
all_type = array[1 .. size] of integer;
pair = array[1 .. 2] of word;
const
s1_len = 6;
step_one: array[1 .. s1_len] of pair =
((1, 2), (1, 3), (1, 4), (2, 3), (2, 4), (3, 4));
s2_len = 2;
step_two: array[1 .. s2_len] of word =
(1, 2);
s3_len = 3;
step_three: array[1 .. s3_len] of pair =
((1, 2), (2, 3), (1, 3));
s4_len = 3;
step_four: array[1 .. s4_len] of word =
(1, 2, 3);
s5_len = 1;
step_five: array[1 .. s5_len] of pair =
((1, 2));
const
right: all_type = (1, 2, 5, 10);
left: all_type = (-1, -1, -1, -1);
procedure compact(var x: all_type);
var T: all_type;
i, next: byte;
begin
move(x, T, sizeof(x));
next := 0;
for i := 1 to size do
if T[i] <> -1 then
begin
inc(next);
x[next] := T[i]
end;
for i := succ(next) to size do
x[i] := -1;
end;
procedure append(var x: all_type; a: word);
var i: integer;
begin
i := 1;
while x[i] <> -1 do inc(i);
x[i] := a;
end;
function max(a, b: word): word;
begin
max := a;
if b > a then max := b
end;
function get_two(by: pair; var x: pair): word;
begin { from right }
x[1] := right[by[1]]; right[by[1]] := -1;
x[2] := right[by[2]]; right[by[2]] := -1;
compact(right);
get_two := max(x[1], x[2])
end;
function get_one(by: word; var x: word): word;
begin { from left }
x := left[by]; left[by] := -1;
compact(left);
get_one := x
end;
procedure print_array(x: all_type);
var i: byte;
begin
for i := 1 to size do
if x[i] <> -1 then write(x[i]:4);
writeln
end;
var
min1, min2, min3, min4, min5: byte;
mp: pair; path, T: word;
procedure create_path;
var
right0, right1, right2, right3, right4,
left0, left1, left2, left3, left4: all_type;
s1, s2, s3, s4: word;
p1, p2, p3, p4, p5: byte;
min_path: word;
begin
path := 0; min_path := maxInt;
move(left, left0, sizeof(left));
move(right, right0, sizeof(right));
for p1 := 1 to s1_len do
begin
move(left0, left, sizeof(left));
move(right0, right, sizeof(right));
path := get_two(step_one[p1], mp);
append(left, mp[1]); append(left, mp[2]);
s1 := path;
move(left, left1, sizeof(left));
move(right, right1, sizeof(right));
for p2 := 1 to s2_len do
begin
path := s1;
move(left1, left, sizeof(left));
move(right1, right, sizeof(right));
inc(path, get_one(step_two[p2], T));
append(right, T);
s2 := path;
move(left, left2, sizeof(left));
move(right, right2, sizeof(right));
for p3 := 1 to s3_len do
begin
path := s2;
move(left2, left, sizeof(left));
move(right2, right, sizeof(right));
inc(path, get_two(step_three[p3], mp));
append(left, mp[1]); append(left, mp[2]);
s3 := path;
move(left, left3, sizeof(left));
move(right, right3, sizeof(right));
for p4 := 1 to s4_len do
begin
path := s3;
move(left3, left, sizeof(left));
move(right3, right, sizeof(right));
inc(path, get_one(step_four[p4], T));
append(right, T);
s4 := path;
move(left, left4, sizeof(left));
move(right, right4, sizeof(right));
for p5 := 1 to s5_len do
begin
path := s4;
move(left4, left, sizeof(left));
move(right4, right, sizeof(right));
inc(path, get_two(step_five[p5], mp));
append(left, mp[1]); append(left, mp[2]);
if min_path > path then
begin
min1 := p1; min2 := p2; min3 := p3;
min4 := p4; min5 := p5;
min_path := path;
end;
end;
end;
end;
end;
end;
writeln('min path len = ', min_path);
move(left0, left, sizeof(left));
move(right0, right, sizeof(right));
end;
begin
write('right'); print_array(right);
write('left'); print_array(left);
writeln('starting...');
create_path;
{#1}
path := get_two(step_one[min1], mp);
append(left, mp[1]); append(left, mp[2]);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
{#2}
inc(path, get_one(step_two[min2], T));
append(right, T);
writeln('left > right: ', T:4, ' time = ', path);
{#3}
inc(path, get_two(step_three[min3], mp));
append(left, mp[1]); append(left, mp[2]);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
{#4}
inc(path, get_one(step_four[min4], T));
append(right, T);
writeln('left > right: ', T:4, ' time = ', path);
{#5}
inc(path, get_two(step_five[min5], mp));
append(left, mp[1]); append(left, mp[2]);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
end.
2. Самое короткое-оптимальное решение.
Jahnerus
Jahnerus
Исходный код
{© by Jahnerus}
type
ma3x=array[1..4] of byte;
ma3x_moves=array[1..5,1..2] of byte;
ma3x_bool=array[1..4] of boolean;
const
time:ma3x=(1,2,5,10);
var
ident:ma3x_bool;
moves:ma3x_moves;
f:text;
{------------ Podschet vremeni --------------}
function get_time(moves:ma3x_moves):byte;
var
i,tmp:byte;
begin
tmp:=0;
for i:=1 to 5 do begin
if time[moves[i,1]]>time[moves[i,2]] then tmp:=tmp+time[moves[i,1]]
else tmp:=tmp+time[moves[i,2]];
end;
get_time:=tmp;
end;
{------- Proverka vremeni i vivod dannih ---------}
procedure check(moves:ma3x_moves);
var
i:byte;
begin
if get_time(moves)<=18 then begin
for i:=1 to 5 do begin
if i mod 2 = 0 then write(f,' ',time[moves[i,1]],' ')
else write(f,time[moves[i,1]],'-',time[moves[i,2]]);
end;
writeln(f,' za ',get_time(moves),' chasov');
end;
end;
{------------- Peredvijeniya lodki ------------}
procedure boat_moves(moves:ma3x_moves; n:byte; ident:ma3x_bool; flag:boolean);
var
i,j:byte;
begin
if n<=5 then begin
for i:=1 to 4 do begin
if (ident[i]) xor (flag) then begin
moves[n,1]:=i;
ident[i]:=flag;
if flag then begin
for j:=i+1 to 4 do begin
if not(ident[j]) then begin
moves[n,2]:=j;
ident[j]:=flag;
boat_moves(moves,n+1,ident,not(flag));
ident[j]:=not(flag);
end;
end;
end
else begin
moves[n,2]:=i;
boat_moves(moves,n+1,ident,not(flag));
end;
ident[i]:=not(flag);
end;
end;
end
else check(moves);
end;
{------------ Osnovnoy blok
--------------}
begin
assign(f,'out.txt');
rewrite(f);
boat_moves(moves,1,ident,true);
close(f);
end.
type
ma3x=array[1..4] of byte;
ma3x_moves=array[1..5,1..2] of byte;
ma3x_bool=array[1..4] of boolean;
const
time:ma3x=(1,2,5,10);
var
ident:ma3x_bool;
moves:ma3x_moves;
f:text;
{------------ Podschet vremeni --------------}
function get_time(moves:ma3x_moves):byte;
var
i,tmp:byte;
begin
tmp:=0;
for i:=1 to 5 do begin
if time[moves[i,1]]>time[moves[i,2]] then tmp:=tmp+time[moves[i,1]]
else tmp:=tmp+time[moves[i,2]];
end;
get_time:=tmp;
end;
{------- Proverka vremeni i vivod dannih ---------}
procedure check(moves:ma3x_moves);
var
i:byte;
begin
if get_time(moves)<=18 then begin
for i:=1 to 5 do begin
if i mod 2 = 0 then write(f,' ',time[moves[i,1]],' ')
else write(f,time[moves[i,1]],'-',time[moves[i,2]]);
end;
writeln(f,' za ',get_time(moves),' chasov');
end;
end;
{------------- Peredvijeniya lodki ------------}
procedure boat_moves(moves:ma3x_moves; n:byte; ident:ma3x_bool; flag:boolean);
var
i,j:byte;
begin
if n<=5 then begin
for i:=1 to 4 do begin
if (ident[i]) xor (flag) then begin
moves[n,1]:=i;
ident[i]:=flag;
if flag then begin
for j:=i+1 to 4 do begin
if not(ident[j]) then begin
moves[n,2]:=j;
ident[j]:=flag;
boat_moves(moves,n+1,ident,not(flag));
ident[j]:=not(flag);
end;
end;
end
else begin
moves[n,2]:=i;
boat_moves(moves,n+1,ident,not(flag));
end;
ident[i]:=not(flag);
end;
end;
end
else check(moves);
end;
{------------ Osnovnoy blok
--------------}begin
assign(f,'out.txt');
rewrite(f);
boat_moves(moves,1,ident,true);
close(f);
end.
3. Самое изощренное решение.
VOLVO
VOLVO
Исходный код
uses crt;
const
players = 4;
{
players = 6;
}
type
all_type = array[1 .. players] of integer;
pair = array[1 .. 2] of word;
const
right: all_type = (1, 10, 5, 2);
{
(1, 10, 5, 2, 11, 3);
}
left: all_type = (-1, -1, -1, -1);
{
(-1, -1, -1, -1, -1, -1);
}
type
PTForward = ^step_forward;
step_forward = array[1 .. maxInt div sizeof(pair)] of pair;
PTBackward = ^step_backward;
step_backward = array[1 .. maxint div sizeof(word)] of word;
type
TDirection =
(drForward, drBackward);
TOptimized =
Record
save_left, save_right: all_type;
save_path: integer;
len: word;
case going: TDirection of
drForward : (arr_f: PTForward);
drBackward: (arr_b: PTBackward);
End;
TArrOptimized = ^arrOptimized;
arrOptimized =
array[0 .. pred(maxint) div sizeof(TOptimized)] of TOptimized;
var
opt_arr_index: integer;
opt_arr: TArrOptimized;
function count_forward(n: byte): byte;
begin
if n <= 1 then count_forward := 0
else count_forward :=
count_forward(pred(n)) + pred(n)
end;
function moves(n: byte): byte;
begin
moves := succ((n - 2) shl 1)
end;
procedure generate;
function generate_forward(right: integer;
var arr: PTForward): integer;
var
i, j, count: integer;
begin
count := count_forward(right);
getmem(arr, count*sizeof(pair));
count := 0;
for i := 1 to pred(right) do
for j := succ(i) to right do
begin
inc(count);
arr^[count][1] := i;
arr^[count][2] := j;
end;
generate_forward := count;
end;
function generate_backward(left: integer;
var arr: PTBackward): integer;
var count: integer;
begin
getmem(arr, left*sizeof(word));
for count := 1 to left do
arr^[count] := count;
generate_backward := count;
end;
var
on_right: integer;
begin
getmem( opt_arr,
succ(moves(players)) * sizeof(TOptimized) );
opt_arr_index := 0;
move(left, opt_arr^[0].save_left, sizeof(left));
move(right, opt_arr^[0].save_right, sizeof(right));
opt_arr^[0].save_path := 0;
on_right := players;
while on_right > 0 do
begin
inc(opt_arr_index);
with opt_arr^[opt_arr_index] do
begin
going := drForward;
len := generate_forward(on_right, arr_f);
end;
dec(on_right, 2);
if on_right = 0 then break;
inc(opt_arr_index);
with opt_arr^[opt_arr_index] do
begin
going := drBackward;
len := generate_backward(players-on_right, arr_b);
end;
inc(on_right)
end;
end;
procedure compact_array(var x: all_type);
var T: all_type;
i, next: byte;
begin
move(x, T, sizeof(x));
next := 0;
for i := 1 to players do
if T[i] <> -1 then
begin
inc(next);
x[next] := T[i]
end;
for i := succ(next) to players do
x[i] := -1;
end;
procedure append_array(var x: all_type;
const n: byte; var avar);
var
a: pair absolute avar;
i, j: integer;
begin
i := 1;
while x[i] <> -1 do inc(i);
for j := 0 to pred(n) do
x[i + j] := a[succ(j)]
end;
procedure print_array(x: all_type);
var i: byte;
begin
for i := 1 to players do
if x[i] <> -1 then write(x[i]:4);
writeln
end;
function get_number(var from: all_type;
const n: byte; var byvar, xvar): word;
var
x: pair absolute xvar;
by: pair absolute byvar;
i: byte;
begin
for i := 1 to n do
begin
x[i] := from[by[i]]; from[by[i]] := -1;
end;
compact_array(from);
get_number := x[1];
if (n = 2) and (x[2] > x[1])
then get_number := x[2]
end;
var
mins, ps: PTBackward;
mp: pair; path, T: word;
const
min_path: integer = maxInt;
procedure go_for_it(n: integer);
var p, i: integer;
begin
move(left, opt_arr^[n].save_left, sizeof(left));
move(right, opt_arr^[n].save_right, sizeof(right));
for p := 1 to opt_arr^[n].len do
begin
path := opt_arr^[pred(n)].save_path;
move(opt_arr^[pred(n)].save_left, left, sizeof(left));
move(opt_arr^[pred(n)].save_right, right, sizeof(right));
ps^[n] := p;
with opt_arr^[n] do
case going of
drForward:
begin
inc(path, get_number(right, 2, arr_f^[p], mp));
append_array(left, 2, mp)
end;
drBackward:
begin
inc(path, get_number(left, 1, arr_b^[p], T));
append_array(right, 1, T)
end;
end;
if n = opt_arr_index then
begin
if min_path > path then
begin
move(ps^[1], mins^[1], n * sizeof(word));
min_path := path
end;
move(opt_arr^[n].save_left, left, sizeof(left));
move(opt_arr^[n].save_right, right, sizeof(right));
end
else
begin
opt_arr^[n].save_path := path;
move(left, opt_arr^[n].save_left, sizeof(left));
move(right, opt_arr^[n].save_right, sizeof(right));
go_for_it(succ(n))
end;
end;
end;
var
i: integer;
begin
clrscr;
write('right'); print_array(right);
write('left'); print_array(left);
writeln;
generate;
getmem(mins, opt_arr_index*sizeof(word));
getmem(ps, opt_arr_index*sizeof(word));
go_for_it(1);
move(opt_arr^[0].save_left, left, sizeof(left));
move(opt_arr^[0].save_right, right, sizeof(right));
path := 0;
for i := 1 to opt_arr_index do
with opt_arr^[i] do
begin
case going of
drForward:
begin
inc(path, get_number(right, 2, arr_f^[mins^[i]], mp));
append_array(left, 2, mp);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
freemem(arr_f, len*sizeof(pair))
end;
drBackward:
begin
inc(path, get_number(left, 1, arr_b^[mins^[i]], T));
append_array(right, 1, T);
writeln('left > right: ', T:4, ' time = ', path);
freemem(arr_b, len*sizeof(word))
end;
end
end;
freemem(ps, opt_arr_index*sizeof(word));
freemem(mins, opt_arr_index*sizeof(word));
freemem( opt_arr,
succ(moves(players)) * sizeof(TOptimized) );
end.
const
players = 4;
{
players = 6;
}
type
all_type = array[1 .. players] of integer;
pair = array[1 .. 2] of word;
const
right: all_type = (1, 10, 5, 2);
{
(1, 10, 5, 2, 11, 3);
}
left: all_type = (-1, -1, -1, -1);
{
(-1, -1, -1, -1, -1, -1);
}
type
PTForward = ^step_forward;
step_forward = array[1 .. maxInt div sizeof(pair)] of pair;
PTBackward = ^step_backward;
step_backward = array[1 .. maxint div sizeof(word)] of word;
type
TDirection =
(drForward, drBackward);
TOptimized =
Record
save_left, save_right: all_type;
save_path: integer;
len: word;
case going: TDirection of
drForward : (arr_f: PTForward);
drBackward: (arr_b: PTBackward);
End;
TArrOptimized = ^arrOptimized;
arrOptimized =
array[0 .. pred(maxint) div sizeof(TOptimized)] of TOptimized;
var
opt_arr_index: integer;
opt_arr: TArrOptimized;
function count_forward(n: byte): byte;
begin
if n <= 1 then count_forward := 0
else count_forward :=
count_forward(pred(n)) + pred(n)
end;
function moves(n: byte): byte;
begin
moves := succ((n - 2) shl 1)
end;
procedure generate;
function generate_forward(right: integer;
var arr: PTForward): integer;
var
i, j, count: integer;
begin
count := count_forward(right);
getmem(arr, count*sizeof(pair));
count := 0;
for i := 1 to pred(right) do
for j := succ(i) to right do
begin
inc(count);
arr^[count][1] := i;
arr^[count][2] := j;
end;
generate_forward := count;
end;
function generate_backward(left: integer;
var arr: PTBackward): integer;
var count: integer;
begin
getmem(arr, left*sizeof(word));
for count := 1 to left do
arr^[count] := count;
generate_backward := count;
end;
var
on_right: integer;
begin
getmem( opt_arr,
succ(moves(players)) * sizeof(TOptimized) );
opt_arr_index := 0;
move(left, opt_arr^[0].save_left, sizeof(left));
move(right, opt_arr^[0].save_right, sizeof(right));
opt_arr^[0].save_path := 0;
on_right := players;
while on_right > 0 do
begin
inc(opt_arr_index);
with opt_arr^[opt_arr_index] do
begin
going := drForward;
len := generate_forward(on_right, arr_f);
end;
dec(on_right, 2);
if on_right = 0 then break;
inc(opt_arr_index);
with opt_arr^[opt_arr_index] do
begin
going := drBackward;
len := generate_backward(players-on_right, arr_b);
end;
inc(on_right)
end;
end;
procedure compact_array(var x: all_type);
var T: all_type;
i, next: byte;
begin
move(x, T, sizeof(x));
next := 0;
for i := 1 to players do
if T[i] <> -1 then
begin
inc(next);
x[next] := T[i]
end;
for i := succ(next) to players do
x[i] := -1;
end;
procedure append_array(var x: all_type;
const n: byte; var avar);
var
a: pair absolute avar;
i, j: integer;
begin
i := 1;
while x[i] <> -1 do inc(i);
for j := 0 to pred(n) do
x[i + j] := a[succ(j)]
end;
procedure print_array(x: all_type);
var i: byte;
begin
for i := 1 to players do
if x[i] <> -1 then write(x[i]:4);
writeln
end;
function get_number(var from: all_type;
const n: byte; var byvar, xvar): word;
var
x: pair absolute xvar;
by: pair absolute byvar;
i: byte;
begin
for i := 1 to n do
begin
x[i] := from[by[i]]; from[by[i]] := -1;
end;
compact_array(from);
get_number := x[1];
if (n = 2) and (x[2] > x[1])
then get_number := x[2]
end;
var
mins, ps: PTBackward;
mp: pair; path, T: word;
const
min_path: integer = maxInt;
procedure go_for_it(n: integer);
var p, i: integer;
begin
move(left, opt_arr^[n].save_left, sizeof(left));
move(right, opt_arr^[n].save_right, sizeof(right));
for p := 1 to opt_arr^[n].len do
begin
path := opt_arr^[pred(n)].save_path;
move(opt_arr^[pred(n)].save_left, left, sizeof(left));
move(opt_arr^[pred(n)].save_right, right, sizeof(right));
ps^[n] := p;
with opt_arr^[n] do
case going of
drForward:
begin
inc(path, get_number(right, 2, arr_f^[p], mp));
append_array(left, 2, mp)
end;
drBackward:
begin
inc(path, get_number(left, 1, arr_b^[p], T));
append_array(right, 1, T)
end;
end;
if n = opt_arr_index then
begin
if min_path > path then
begin
move(ps^[1], mins^[1], n * sizeof(word));
min_path := path
end;
move(opt_arr^[n].save_left, left, sizeof(left));
move(opt_arr^[n].save_right, right, sizeof(right));
end
else
begin
opt_arr^[n].save_path := path;
move(left, opt_arr^[n].save_left, sizeof(left));
move(right, opt_arr^[n].save_right, sizeof(right));
go_for_it(succ(n))
end;
end;
end;
var
i: integer;
begin
clrscr;
write('right'); print_array(right);
write('left'); print_array(left);
writeln;
generate;
getmem(mins, opt_arr_index*sizeof(word));
getmem(ps, opt_arr_index*sizeof(word));
go_for_it(1);
move(opt_arr^[0].save_left, left, sizeof(left));
move(opt_arr^[0].save_right, right, sizeof(right));
path := 0;
for i := 1 to opt_arr_index do
with opt_arr^[i] do
begin
case going of
drForward:
begin
inc(path, get_number(right, 2, arr_f^[mins^[i]], mp));
append_array(left, 2, mp);
writeln('right > left: ', mp[1]:4, mp[2]:4, ' time = ', path);
freemem(arr_f, len*sizeof(pair))
end;
drBackward:
begin
inc(path, get_number(left, 1, arr_b^[mins^[i]], T));
append_array(right, 1, T);
writeln('left > right: ', T:4, ' time = ', path);
freemem(arr_b, len*sizeof(word))
end;
end
end;
freemem(ps, opt_arr_index*sizeof(word));
freemem(mins, opt_arr_index*sizeof(word));
freemem( opt_arr,
succ(moves(players)) * sizeof(TOptimized) );
end.
И наконец мой вариант:
Uses MyServis {из этого модуля используется только функция IntToStr - преобразование числа в строку};
Type
tm = Array[1..4,1..2] of Byte;
tr = Record
mm : tm; {kto gde}
n {proshlo chasov},
k {kakoy bereg 1-Left,2-Right} : Byte;
S : String; {LOG}
End;
Var
m : tr;
Function CheckEnd(vv : tr) : Boolean;
Var jj : Byte;
Begin
CheckEnd:=True;
For jj:=1 to 4 do
If (vv.mm[jj,1]<>0) then CheckEnd:=False;
End;
Function Revers(r : Byte) : Byte;
Begin
If r=1 then Revers:=2 else Revers:=1;
End;
Function Compare(a,b : Byte) : Byte;
Begin
If a>b then Compare:=a else Compare:=b;
End;
Function NumSide(vv : tr) : Byte;
Var jj,kk : Byte;
Begin
kk:=0;
For jj:=1 to 4 do If vv.mm[jj,vv.k]<>0 then Inc(kk);
NumSide:=kk;
End;
Procedure Sortmm(Var vv : tr);
Var ii,jj,tmp,q : Byte;
Begin
For q:=1 to 2 do
For ii:=1 to 3 do
For jj:=ii+1 to 4 do
Begin
If vv.mm[ii,q]<vv.mm[jj,q] then
Begin
tmp:=vv.mm[ii,q];
vv.mm[ii,q]:=vv.mm[jj,q];
vv.mm[jj,q]:=tmp;
End;
End;
End;
Procedure Go(v : tr);
Var i,j : Byte;
v0 : tr;
Begin
Case v.k of
2 : Begin
For i:=1 to NumSide(v) do
Begin
v0:=v;
v0.S:=v0.S+' '+IntToStr(v0.mm[i,2])+' ';
v0.k:=1;
v0.mm[NumSide(v0)+1,1]:=v0.mm[i,2];
Inc(v0.n,v0.mm[i,2]);
v0.mm[i,2]:=0;
Sortmm(v0);
Go(v0);
End;
End;
1 : Begin
For i:=1 to NumSide(v)-1 do
For j:=i+1 to NumSide(v) do
Begin
v0:=v;
v0.S:=v0.S+IntToStr(v0.mm[i,1])+'-'+IntToStr(v0.mm[j,1]);
v0.k:=2;
v0.mm[NumSide(v0)+1,2]:=v0.mm[i,1];
v0.mm[NumSide(v0)+2,2]:=v0.mm[j,1];
Inc(v0.n,Compare(v0.mm[i,1],v0.mm[j,1]));
v0.mm[i,1]:=0;
v0.mm[j,1]:=0;
Sortmm(v0);
If CheckEnd(v0) and (v0.n<=18) then
Begin
Writeln(v0.S);
{Halt(0);}Exit;
End;
Go(v0);
End;
End;
End;
End;
Begin
m.mm[1,1]:=1; m.mm[2,1]:=2; m.mm[3,1]:=5; m.mm[4,1]:=10;
m.mm[1,2]:=0; m.mm[2,2]:=0; m.mm[3,2]:=0; m.mm[4,2]:=0;
m.n:=0; m.S:=''; m.k:=1;
Go(m);
End.
Итого:
Volvo +2
Jahnerus +1
Поздравляем победителей конкурса! :flowers: :thanks:
:yes:
Volvo +2
Jahnerus +1
Поздравляем победителей конкурса! :flowers: :thanks:
:yes:
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.