Серый форум — AHK: Нахождения кратчайшего пути

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Tue, 17 May 2016 16:52:55 +0000

Вот ещё быстрее и проще.

Сравнение на вычислениях более 2 секунд.


#SingleInstance Force
#NoEnv

 
SetBatchLines, -1
length := 2000
MaxLinks := 111

start:
Map := CreateMap(length, MaxLinks)
p := GetRandomNumbers(length, 2)

start := A_TickCount
text1 := GetWaysText(GetShortWays(Map, p[1], p[2]))
time1 := A_TickCount - start
RegExReplace(text1, "m`a)$", "", Count1)
SoundBeep
if !(time1 > 2000)
	goto start
SoundBeep
start := A_TickCount
text2 := AllShortPath(p[1], p[2], Map, 1)
time2 := A_TickCount - start
RegExReplace(text2, "m`a)$", "", Count2)

MsgBox, % "teadrinker:`nTime = " time1 "`nCount = " Count1 "`n`n" text1 "`n`nserzh82saratov:`nTime = " time2 "`nCount = " Count2 "`n`n" text2
Return

GetShortWays(points, start, end)
{
	max := 4
	Loop  {
		if !IsObject(jumps := GetJumps(points, start, end, [start]))
			Return [[start, end]]
		ways := [], CurrentNode := {way: [start], jumps: jumps, PrevNode: ""}, max *= 2
		while CurrentNode  {
			m := ways.1.MaxIndex(), c := CurrentNode.way.MaxIndex()
			if ( c + 1 = m || c > max || !(NextPoint := CurrentNode.jumps.Pop()) )  {
				CurrentNode := CurrentNode.PrevNode
				continue
			}
			way := CurrentNode.way.Clone()
			if jumps := GetJumps(points, NextPoint, end, way)  {
				if IsObject(jumps) && way.Push(NextPoint)
					CurrentNode := {way: way, jumps: jumps, PrevNode: CurrentNode}
				else
					way.Push(NextPoint, jumps), (way.MaxIndex() < m && ways := []), ways.Push(way)
			}
		}
	} until ways.1.1 || max > points.MaxIndex()
	Return ways
}
	
GetJumps(points, p, end, way)
{
	jumps := []
	for k, v in points[p]  {
		if (v = end)
			Return v
		
		for i, c in way
			if (v = c)
				continue 2
		
		jumps.Push(v)
	}
	Return jumps
}

GetWaysText(ways)
{
	for k, v in ways  {
		text .= A_Index = 1 ? "" : "`n"
		for k, v in v
			text .= (A_Index = 1 ? "" : ", ") . v
	}
	Return text
}

;***********************************************************************************************************

AllShortPath(From, To, Map, RetText = 0) {
	Bridge := [[From]], Find := [], Exist := []
	While !Find.MaxIndex() && Bridge.MaxIndex() {
		For k, v in Bridge
			Exist[v[v.MaxIndex()]] := 1
		For k, b in Bridge.Clone(), Bridge := []
			For k, p in Map[b[b.MaxIndex()]]
				If !Exist[p] && (a := b.Clone(), a.Push(p))
					If (p = To && Find.Push(a)) || !Bridge.Push(a)
						Break
	} If RetText
		For k, v in Find
			For k, v in v, Find .= A_Index = 1 ? "" : "`n"
				Find .= (A_Index = 1 ? "" : ", ") . v
	Return Find
}

;********************************************************************************************************************

CreateMap(len, max)
{
	arr := []
	Loop % len
		arr[A_Index] := []
	IndexArr := []
	Loop % len
		IndexArr[A_Index] := A_Index
	
	Loop % len  {
		i := A_Index
		m := arr[i].MaxIndex(), (!m && m := 0)
		rest := max - m
		if (rest = 0)
			continue
		
		WithoutCurrent := IndexArr.Clone()
		RemoveFromIdx(i, WithoutCurrent)
		
		Random, rand, 1, rest
		for k, v in keys := GetRandomNumbers(WithoutCurrent.MaxIndex(), rand)  {
			idx := WithoutCurrent[v]
			arr[idx].Push(i)
			( arr[idx].MaxIndex() >= max && RemoveFromIdx(idx, IndexArr) )
			arr[i].Push(idx)
		}
		( arr[i].MaxIndex() >= max && RemoveFromIdx(i, IndexArr) )
	}
	Return arr
}

RemoveFromIdx(n, arr)
{
	for k, v in arr
		if (v = n)
			break
	arr.RemoveAt(k)
}

GetRandomNumbers(len, num)
{
	arr := []
	Loop % len
		arr[A_Index] := A_Index
	RetArr := []
	Loop % num  {
		Random, rand, 1, arr.MaxIndex()
		RetArr.Push(arr.RemoveAt(rand))
	}
	Return RetArr
}

Функция.

AllShortPath(From, To, Map, RetText = 0) {
	Bridge := [[From]], Find := [], Exist := []
	While !Find.MaxIndex() && Bridge.MaxIndex() {
		For k, v in Bridge
			Exist[v[v.MaxIndex()]] := 1
		For k, b in Bridge.Clone(), Bridge := []
			For k, p in Map[b[b.MaxIndex()]]
				If !Exist[p] && (a := b.Clone(), a.Push(p))
					If (p = To && Find.Push(a)) || !Bridge.Push(a)
						Break
	} If RetText
		For k, v in Find
			For k, v in v, Find .= A_Index = 1 ? "" : "`n"
				Find .= (A_Index = 1 ? "" : ", ") . v
	Return Find
}

Или вариант пошустрее, если нужен только один путь.

ShortPath(From, To, Map, RetText = 0) {
	Bridge := [[From]], Exist := [], Exist[From] := 1
	While Bridge.MaxIndex()
		For k, b in Bridge.Clone(), Bridge := [] 
			For k, p in Map[b[b.MaxIndex()]]
				If !Exist[p] && (a := b.Clone(), a.Push(p))
					If (p = To && Find := a) || !(Bridge.Push(a) && Exist[p] := 1)
						Break 3
	If RetText
		For k, v in Find
			Find .= (k = 1 ? "" : ", ") . v
	Return Find
}

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Sun, 15 May 2016 19:25:46 +0000

Понял теперь, тоже думал про такой же вариант но почему то решил что разницы не будет, а оно вон как.

Re: AHK: Нахождения кратчайшего пути

null@example.com (teadrinker) — Sun, 15 May 2016 19:21:28 +0000

Я твой не разбирал. А у меня небольшой хак применён. Вначале ищутся короткие пути, если путь длиннее определённого значения, он бросается и ищется новый. Если ничего не найдено, значение увеличивается вдвое.

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Sun, 15 May 2016 08:43:50 +0000

teadrinker пишет:

Можно посоревноваться:

Да результаты впечатляют, было даже 250 против моих 16000. Так и не осилил, в чём заключается принципиальная разница?

Re: AHK: Нахождения кратчайшего пути

null@example.com (teadrinker) — Wed, 11 May 2016 06:17:24 +0000

У меня пока так вышло:

Points := { 1: [9,10], 2: [3,9], 3: [2,8], 4: [5,8,16], 5: [4,7,12], 6: [7,20], 7: [5,6], 8: [3,4,14,20], 9: [1,2,10,12,14], 10: [1,9,11], 11: [10,12]
			, 12: [5,9,11,13], 13: [12,14,15], 14: [8,9,13,15], 15: [13,14,16], 16: [4,15,17,20], 17: [16,18], 18: [17,19], 19: [18,20], 20: [6,8,16,19] }
			
ways := GetShortWays(Points, 11, 20)

for k, v in ways  {
	text .= A_Index = 1 ? "" : "`n"
	for k, v in v
		text .= (A_Index = 1 ? "" : " —> ") . v
}
MsgBox, % text

GetShortWays(points, start, end)
{
	max := 4
	Loop  {
		if !IsObject(jumps := GetJumps(points, start, end, [start]))
			Return [[start, end]]
		ways := [], CurrentNode := {way: [start], jumps: jumps, PrevNode: ""}, max *= 2
		while CurrentNode  {
			m := ways.1.MaxIndex(), c := CurrentNode.way.MaxIndex()
			if ( c + 1 = m || c > max || !(NextPoint := CurrentNode.jumps.Pop()) )  {
				CurrentNode := CurrentNode.PrevNode
				continue
			}
			way := CurrentNode.way.Clone()
			if jumps := GetJumps(points, NextPoint, end, way)  {
				if IsObject(jumps) && way.Push(NextPoint)
					CurrentNode := {way: way, jumps: jumps, PrevNode: CurrentNode}
				else
					way.Push(NextPoint, jumps), (way.MaxIndex() < m && ways := []), ways.Push(way)
			}
		}
	} until ways.1.1 || max > points.MaxIndex()
	Return ways
}
	
GetJumps(points, p, end, way)
{
	jumps := []
	for k, v in points[p]  {
		if (v = end)
			Return v
		
		for i, c in way
			if (v = c)
				continue 2
		
		jumps.Push(v)
	}
	Return jumps
}

Можно посоревноваться:

SetBatchLines, -1
length := 1000
MaxLinks := 5

Map := CreateMap(length, MaxLinks)
p := GetRandomNumbers(length, 2)

start := A_TickCount
text1 := GetWaysText(GetShortWays(Map, p[1], p[2]))
time1 := A_TickCount - start
SoundBeep
start := A_TickCount
text2 := ShortPath(p[1], p[2], Map, 1)
time2 := A_TickCount - start

MsgBox, % "teadrinker:`n`nTime = " time1 "`n" text1 "`n`nserzh82saratov:`n`nTime = " time2 "`n" text2

GetShortWays(points, start, end)
{
	max := 4
	Loop  {
		if !IsObject(jumps := GetJumps(points, start, end, [start]))
			Return [[start, end]]
		ways := [], CurrentNode := {way: [start], jumps: jumps, PrevNode: ""}, max *= 2
		while CurrentNode  {
			m := ways.1.MaxIndex(), c := CurrentNode.way.MaxIndex()
			if ( c + 1 = m || c > max || !(NextPoint := CurrentNode.jumps.Pop()) )  {
				CurrentNode := CurrentNode.PrevNode
				continue
			}
			way := CurrentNode.way.Clone()
			if jumps := GetJumps(points, NextPoint, end, way)  {
				if IsObject(jumps) && way.Push(NextPoint)
					CurrentNode := {way: way, jumps: jumps, PrevNode: CurrentNode}
				else
					way.Push(NextPoint, jumps), (way.MaxIndex() < m && ways := []), ways.Push(way)
			}
		}
	} until ways.1.1 || max > points.MaxIndex()
	Return ways
}
	
GetJumps(points, p, end, way)
{
	jumps := []
	for k, v in points[p]  {
		if (v = end)
			Return v
		
		for i, c in way
			if (v = c)
				continue 2
		
		jumps.Push(v)
	}
	Return jumps
}

GetWaysText(ways)
{
	for k, v in ways  {
		text .= A_Index = 1 ? "" : "`n"
		for k, v in v
			text .= (A_Index = 1 ? "" : ", ") . v
	}
	Return text
}

;***********************************************************************************************************

ShortPath(From, To, Map, RetText = 0) {
	Bridge := [From], Index := [1], Exist := [], Finds := []
	Loop
	{
		M := Bridge.MaxIndex(), B := Bridge[M], I := Index[M], N := Map[b][i], Exist[b] := 1
		If (M = 1 && !N)
			Break
		If (!N || Min && M > Min)
		{
			Exist[Bridge.Pop()] := 0, Index.Pop(), ++Index[Bridge.MaxIndex()]
			Continue
		}
		 ; If (I = 1 && (From = To ? M > 2 : 1))  ; для кольцевых маршрутов
		If (I = 1) 
			For k, v in Map[b]
				If (v = To)
				{  
					Find := Bridge.Clone(), Find.Push(To), Finds.Push(Find), Min := M 
					If (M = 1)
						Break 2
					Exist[Bridge.Pop()] := 0, Index.Pop(), ++Index[Bridge.MaxIndex()]
					Continue 2
				}
		If Exist[N]
			++Index[M]
		Else
			Bridge.Push(N), Index.Push(1)
	}
	For k, v in Finds, Ret := []
		v.MaxIndex() = Min + 1 ? Ret.Push(v) : 0
	If RetText
		For k, v in Ret 
			For k, v in v, Ret .= A_Index = 1 ? "" : "`n"
				Ret .= (A_Index = 1 ? "" : ", ") . v
	Return Ret 
}

;********************************************************************************************************************

CreateMap(len, max)
{
	arr := []
	Loop % len
		arr[A_Index] := []
	IndexArr := []
	Loop % len
		IndexArr[A_Index] := A_Index
	
	Loop % len  {
		i := A_Index
		m := arr[i].MaxIndex(), (!m && m := 0)
		rest := max - m
		if (rest = 0)
			continue
		
		WithoutCurrent := IndexArr.Clone()
		RemoveFromIdx(i, WithoutCurrent)
		
		Random, rand, 1, rest
		for k, v in keys := GetRandomNumbers(WithoutCurrent.MaxIndex(), rand)  {
			idx := WithoutCurrent[v]
			arr[idx].Push(i)
			( arr[idx].MaxIndex() >= max && RemoveFromIdx(idx, IndexArr) )
			arr[i].Push(idx)
		}
		( arr[i].MaxIndex() >= max && RemoveFromIdx(i, IndexArr) )
	}
	Return arr
}

RemoveFromIdx(n, arr)
{
	for k, v in arr
		if (v = n)
			break
	arr.RemoveAt(k)
}

GetRandomNumbers(len, num)
{
	arr := []
	Loop % len
		arr[A_Index] := A_Index
	RetArr := []
	Loop % num  {
		Random, rand, 1, arr.MaxIndex()
		RetArr.Push(arr.RemoveAt(rand))
	}
	Return RetArr
}

Re: AHK: Нахождения кратчайшего пути

null@example.com (teadrinker) — Mon, 09 May 2016 12:51:20 +0000

А у меня пока не было времени, завтра тоже попробую.

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Mon, 09 May 2016 11:38:05 +0000

teadrinker пишет:

Но если точек больше, иногда крашится. Похоже, по-хорошему надо заменять рекурсию на цикл.

Вроде так, проверил на больших значениях. Постарался максимально оптимизировать, перебора всех возможных путей нет, как в прошлом варианте. Возвращает один путь (первый найденный с минимальными номерами точек), это заметно ускоряет вычисления.
Результат можно вернуть в виде текста а не массива, указав 4 параметр в true.


Map := { 1: [9,10], 2: [3,9], 3: [2,8], 4: [5,8,16], 5: [4,7,12], 6: [7,20], 7: [5,6], 8: [3,4,14,20], 9: [1,2,10,12,14], 10: [1,9,11], 11: [10,12]
		, 12: [5,9,11,13], 13: [12,14,15], 14: [8,9,13,15], 15: [13,14,16], 16: [4,15,17,20], 17: [16,18], 18: [17,19], 19: [18,20], 20: [6,8,16,19] }

From := 1
To := 19
MsgBox % ShortPath(From, To, Map, 1) 
Return

ShortPath(From, To, Map, RetText = 0) {
	Bridge := [From], Index := [1], Exist := []
	Loop
	{
		M := Bridge.MaxIndex(), B := Bridge[M], I := Index[M], N := Map[b][i], Exist[b] := 1
		If (M = 1 && !N)
			Break
		If (!N || Min && M >= Min)
		{
			Exist[Bridge.Pop()] := 0, Index.Pop(), ++Index[Bridge.MaxIndex()]
			Continue
		}
 		; If (I = 1 && (From = To ? M > 2 : 1))  ; для кольцевых маршрутов
		If (I = 1) 
			For k, v in Map[b]
				If (v = To)
				{ 
					Finds := Bridge.Clone(), Finds.Push(To), Min := M
					If (M < 3)
						Break 2
					Exist[Bridge.Pop()] := 0, Exist[Bridge.Pop()] := 0
					Index.Pop(), Index.Pop(), ++Index[Bridge.MaxIndex()]
					Continue 2
				}
		If Exist[N]
			++Index[M]
		Else
			Bridge.Push(N), Index.Push(1)
	}
	If RetText
		For k, v in Finds
			Finds .= (A_Index = 1 ? "" : ", ") . v
	Return Finds 
}

Вариант под спойлером возвращает все короткие пути, но само собой на больших картах будет искать заметно дольше.

+ открыть спойлер


Map := { 1: [9,10], 2: [3,9], 3: [2,8], 4: [5,8,16], 5: [4,7,12], 6: [7,20], 7: [5,6], 8: [3,4,14,20], 9: [1,2,10,12,14], 10: [1,9,11], 11: [10,12]
		, 12: [5,9,11,13], 13: [12,14,15], 14: [8,9,13,15], 15: [13,14,16], 16: [4,15,17,20], 17: [16,18], 18: [17,19], 19: [18,20], 20: [6,8,16,19] }

From := 2
To := 13 

MsgBox % ShortPath(From, To, Map, 1) 
Return


ShortPath(From, To, Map, RetText = 0) {
	Bridge := [From], Index := [1], Exist := [], Finds := []
	Loop
	{
		M := Bridge.MaxIndex(), B := Bridge[M], I := Index[M], N := Map[b][i], Exist[b] := 1
		If (M = 1 && !N)
			Break
		If (!N || Min && M > Min)
		{
			Exist[Bridge.Pop()] := 0, Index.Pop(), ++Index[Bridge.MaxIndex()]
			Continue
		}
		 ; If (I = 1 && (From = To ? M > 2 : 1))  ; для кольцевых маршрутов
		If (I = 1) 
			For k, v in Map[b]
				If (v = To)
				{  
					Find := Bridge.Clone(), Find.Push(To), Finds.Push(Find), Min := M 
					If (M = 1)
						Break 2
					Exist[Bridge.Pop()] := 0, Index.Pop(), ++Index[Bridge.MaxIndex()]
					Continue 2
				}
		If Exist[N]
			++Index[M]
		Else
			Bridge.Push(N), Index.Push(1)
	}
	For k, v in Finds, Ret := []
		v.MaxIndex() = Min + 1 ? Ret.Push(v) : 0
	If RetText
		For k, v in Ret 
			For k, v in v, Ret .= A_Index = 1 ? "" : "`n"
				Ret .= (A_Index = 1 ? "" : ", ") . v
	Return Ret 
}

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Sat, 07 May 2016 22:31:29 +0000

Ясно. Я с уходом в даун разобрался, но пути теперь возвращает не оптимальные, буду думать. А так, спасибо.

Re: AHK: Нахождения кратчайшего пути

null@example.com (teadrinker) — Sat, 07 May 2016 22:28:41 +0000

Нет, не должно помочь, это для переменных, но не для стека.

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Sat, 07 May 2016 22:27:31 +0000

wikipedia пишет:

Эта ошибка случается по трём причинам.

Тут не осилил, может #MaxMem?

Re: AHK: Нахождения кратчайшего пути

null@example.com (teadrinker) — Sat, 07 May 2016 22:25:19 +0000

При рекурсивном вызове функции может случиться переполнение стека. При циклическом решении подобных задач тоже может случиться переполнение памяти, но запас в этом случае больше.

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Sat, 07 May 2016 22:15:08 +0000

teadrinker пишет:

Похоже, по-хорошему надо заменять рекурсию на цикл.

Так и знал что теперь спрошу, а в чём отличие по твоему?

Re: AHK: Нахождения кратчайшего пути

null@example.com (teadrinker) — Sat, 07 May 2016 21:47:29 +0000

Вот, собственно, виртуальная карта точек длиной length и количеством связей между точками от 1 до MaxLinks:

Map := CreateMap(length, MaxLinks)

CreateMap(len, max)
{
	arr := []
	Loop % len
		arr[A_Index] := []
	IndexArr := []
	Loop % len
		IndexArr[A_Index] := A_Index
	
	Loop % len  {
		i := A_Index
		m := arr[i].MaxIndex(), (!m && m := 0)
		rest := max - m
		if (rest = 0)
			continue
		
		WithoutCurrent := IndexArr.Clone()
		RemoveFromIdx(i, WithoutCurrent)
		
		Random, rand, 1, rest
		for k, v in keys := GetRandomNumbers(WithoutCurrent.MaxIndex(), rand)  {
			idx := WithoutCurrent[v]
			arr[idx].Push(i)
			( arr[idx].MaxIndex() >= max && RemoveFromIdx(idx, IndexArr) )
			arr[i].Push(idx)
		}
		( arr[i].MaxIndex() >= max && RemoveFromIdx(i, IndexArr) )
	}
	Return arr
}

RemoveFromIdx(n, arr)
{
	for k, v in arr
		if (v = n)
			break
	arr.RemoveAt(k)
}

GetRandomNumbers(len, num)
{
	arr := []
	Loop % len
		arr[A_Index] := A_Index
	RetArr := []
	Loop % num  {
		Random, rand, 1, arr.MaxIndex()
		RetArr.Push(arr.RemoveAt(rand))
	}
	Return RetArr
}

Я слегка оптимизировал свой вариант, он легко справляется с массивом в 400 точек с количеством связей от 1 до 5:

SetBatchLines, -1
length := 400
MaxLinks := 5

Map := CreateMap(length, MaxLinks)
p := GetRandomNumbers(length, 2)

PointsObj := new ShortWay(Map)
ways := PointsObj.GetShortWays(p[1], p[2])

for k, v in ways  {
	text .= A_Index = 1 ? "" : "`n"
	for k, v in v
		text .= (A_Index = 1 ? "" : " —> ") . v
}
MsgBox, % text

CreateMap(len, max)
{
	arr := []
	Loop % len
		arr[A_Index] := []
	IndexArr := []
	Loop % len
		IndexArr[A_Index] := A_Index
	
	Loop % len  {
		i := A_Index
		m := arr[i].MaxIndex(), (!m && m := 0)
		rest := max - m
		if (rest = 0)
			continue
		
		WithoutCurrent := IndexArr.Clone()
		RemoveFromIdx(i, WithoutCurrent)
		
		Random, rand, 1, rest
		for k, v in keys := GetRandomNumbers(WithoutCurrent.MaxIndex(), rand)  {
			idx := WithoutCurrent[v]
			arr[idx].Push(i)
			( arr[idx].MaxIndex() >= max && RemoveFromIdx(idx, IndexArr) )
			arr[i].Push(idx)
		}
		( arr[i].MaxIndex() >= max && RemoveFromIdx(i, IndexArr) )
	}
	Return arr
}

RemoveFromIdx(n, arr)
{
	for k, v in arr
		if (v = n)
			break
	arr.RemoveAt(k)
}

GetRandomNumbers(len, num)
{
	arr := []
	Loop % len
		arr[A_Index] := A_Index
	RetArr := []
	Loop % num  {
		Random, rand, 1, arr.MaxIndex()
		RetArr.Push(arr.RemoveAt(rand))
	}
	Return RetArr
}

class ShortWay
{
	__New(points)  {
		this.points := points
		this.ways := []
	}
	GetShortWays(start, end)  {
		this.SearchWays(start, end, [start])
		Return this.ways
	}
	SearchWays(p1, p2, way = "", prev = "")  {
		m := this.ways.1.MaxIndex()
		if ( (m && (way.MaxIndex() > m - 1)) || !(jumps := this.GetJumps(p1, prev, p2, way)) )
			Return
		
		if !IsObject(jumps)  {
			way.Push(jumps)
			( m && way.MaxIndex() < m && this.ways := [] )
			this.ways.Push(way)
			Return
		}
		for k, v in jumps
			node := way.Clone(), node.Push(v), this.SearchWays(v, p2, node, p1)
	}
	GetJumps(p, prev, end, way)  {
		jumps := []
		for k, v in this.points[p]  {
			if (v = end)
				Return v
			
			for i, c in way
				if (v = c)
					continue 2
			
			( this.points[v].MaxIndex() > 1 && v != prev && jumps.Push(v) )
		}
		Return jumps
	}
}

Но если точек больше, иногда крашится. Похоже, по-хорошему надо заменять рекурсию на цикл.

Re: AHK: Нахождения кратчайшего пути

null@example.com (teadrinker) — Sat, 07 May 2016 11:47:25 +0000

С 1,9 — работает, с 1, 2 — нет, зацикливается.

Re: AHK: Нахождения кратчайшего пути

null@example.com (serzh82saratov) — Sat, 07 May 2016 11:43:39 +0000

С любыми точками не работает?