Solve spiderette solitaire game

[Michael Vogel]

From time to time I am playing some puzzles or solitaire games on my android tablet, actually spiderette (from the app solitaire 250+, rules for the game can be found easily). All games could be solved so far, but now I have a constellation which seems to be "unsolvable"...

These cards are seen at the begin of the game:
´K♠` ´2♥` ´A♣` ´D♥` ´2♣` ´2♠` ´K♦`



I have written a program to get the right moves to detect the values of the hidden cards or even to solve this game, the cards above are stored in the variable CardDeck="kp2haxdh2x2pkk".
Under each card there are some hidden cards, starting at column 2 with one card, column 3 with two cards and son on (saved in CardHidden="6k, 9hdk, 3xxk6h, 7h2k????, 6p8k6xbp??, 5k3kApAh4h7p" where ?? defines an unknown value). At last there is a card deck wich contains all other cards (CardPile="9xbkxx5xkhkxbh,9p7x9kbxak5p7k,8h4x4kxpdpdx8x,xh4p8p")



The target is to find a program which is able to show the correct moves to detect all hidden card values (so I am able to eliminate all the ??). Even better would be a possibility to solve that solitaire game, but this seems to be even more complicate...

Code: Select all

; #################
; # Enable Unicode ! #
; #################

#File=0
#Full=1
#Break=15;500000

; Define

	EnableExplicit

	Structure CardPileType
		Card.b[52]
		Count.i
		Serie.i
	EndStructure

	Structure CardSetType
		Pile.CardPileType[7]
		Turns.s
	EndStructure

	Structure TurnType
		Off.i
		On.i
		Cards.i
	EndStructure

	#CardVal="A23456789XBDK"
	#CardCol=Chr($2665)+Chr($2666)+Chr($2660)+Chr($2663)
	#CardAlt="hkpx"

	Global CardDeck.s="kp2haxdh2x2pkk";										
	Global CardPile.s="9xbkxx5xkhkxbh,9p7x9kbxak5p7k,8h4x4kxpdpdx8x,xh4p8p";	
	Global CardHidden.s="6k,9hdk,3xxk6h,7h2k????,6p8k6xbp??,5k3kApAh4h7p"; 
	
	Global Turn.TurnType
	Global Dim CardSet.CardSetType(500000)
	Global Mem
	Global Lines

; EndDefine

Procedure.s StrCard(n)

	If n<52
		ProcedureReturn Mid(#CardVal,n%13+1,1)+Mid(#CardCol,n/13+1,1)
	ElseIf n=99
		ProcedureReturn "--"
	Else
		ProcedureReturn "**"
	EndIf

EndProcedure
Procedure ValCard(c.s)

	Protected col,val

	val=FindString(#CardVal,UCase(Mid(c,1,1)))
	col=FindString(#CardAlt,LCase(Mid(c,2,1)))
	If val And col
		ProcedureReturn val+col*13-14
	Else
		ProcedureReturn 52
	EndIf

EndProcedure
Procedure Error(s.s)
	Debug s
	End
EndProcedure
Procedure CardSeries(n,level=0)

	Protected z,card,check

	With CardSet(level)\Pile[n]
		\Serie=0
		If \Count
			z=\Count
			z-1
			card=\Card[z]
			Repeat
				check=card+\Count-z
				z-1
				;If z>=0
				;	Debug StrCard(card)+">"+StrCard(check)+"="+StrCard(z)+" ... "+Str(\Card[z])+"="+Str(check)
				;EndIf
			Until z<0 Or \Card[z]<>check Or \Card[z]/13<>card/13
			\Serie=\Count-z-1
		EndIf
	EndWith

EndProcedure
Procedure Init()

	Protected i,j,n
	Protected s.s

	For i=1 To 6
		s=StringField(CardHidden,i,",")
		If Len(s)<>i*2
			Error("Illegal content in hidden card deck (#"+Str(i+1)+")")
		EndIf
		For j=1 To i
			With CardSet(0)\Pile[i]
				\Card[\Count]=ValCard(Mid(s,(i-j)*2+1,2))
				\Count+1
			EndWith
		Next
	Next i

	s=CardDeck
	If Len(s)<>14
		Error("Illegal number on starting card deck.")
	EndIf
	For i=0 To 6
		With CardSet(0)\Pile[i]
			\Card[\Count]=ValCard(Mid(s,i*2+1,2))
			\Count+1
		EndWith
	Next i

	For i=0 To 6
		CardSeries(i,0)
	Next i

	CompilerIf #File
		CreateFile(0,"Spiderette.txt",#PB_File_SharedRead|#PB_File_NoBuffering)
	CompilerEndIf

EndProcedure
Procedure Show(active=0,all=0)

	Protected min,max,d
	Protected i,j
	Protected s.s

	Lines+1

	For i=0 To 6
		If CardSet(active)\Pile[i]\Count>max
			max=CardSet(active)\Pile[i]\Count
		EndIf
	Next i

	If all
		min=1
	Else
		min=max
	EndIf

	For i=min To max
		s=""
		For j=0 To 6
			With CardSet(active)\Pile[j]
				d=\Count-max+i-1
				If max-i+1=\Serie
					s+"´"
				Else
					s+" "
				EndIf
				If d<0
					s+"  "
				Else
					s+StrCard(\Card[d])
				EndIf
				If max-i+1=\Serie
					s+"`"
				Else
					s+" "
				EndIf
				;s+" "
			EndWith
		Next j
		If all=0
			s+": "+Mid(CardSet(active)\Turns,2)
		EndIf
		CompilerIf #File
			If Lines%1000=0 : Debug lines : WriteStringN(0,Str(Lines)) : EndIf
			If FindString(s,"**")
				WriteStringN(0,s)
			EndIf
		CompilerElse
			Debug s
		CompilerEndIf
	Next i

	If all
		CompilerIf #File
			WriteStringN(0,"------------------------------------- "+Mid(CardSet(active)\Turns,2))
		CompilerElse
			; Debug Mid(CardSet(active)\Turns,3)
			Debug "------------------------------------- "+Mid(CardSet(active)\Turns,2)
		CompilerEndIf
	EndIf

	If Lines=#Break
		Error("Stopped")
	EndIf

EndProcedure
Procedure Eliminate()

	Protected i,j,k,n
	Protected treffer
	n=mem

	While n
		n-1
		i=7
		treffer=1
		While i
			i-1
			j=CardSet(n)\Pile[i]\Count
			If j=CardSet(Mem)\Pile[i]\Count
				While j
					j-1
					If CardSet(n)\Pile[i]\Card[j]<>CardSet(Mem)\Pile[i]\Card[j]
						j=0
						i=0
						Treffer=0
					EndIf
				Wend
			Else
				i=0
				Treffer=0
			EndIf
		Wend
		If Treffer
			n=0
		EndIf
	Wend

	ProcedureReturn Treffer

EndProcedure

Procedure Turn(cards,off,on,active=0)

	Protected size
	Protected new

	Mem+1
	new=Mem
	CardSet(new)=CardSet(active)

	size=CardSet(new)\Pile[off]\Count

	If size<cards
		Error("Not enough cards to move...")
	EndIf

	CardSet(new)\Pile[off]\Count-cards
	size=0
	While cards
		;CardSet(new)\Pile[off]\Count-1
		; Debug StrCard(CardSet(new)\Pile[off]\Card[CardSet(new)\Pile[off]\Count+size])+" from "+Str(off)+"/"+Str(CardSet(new)\Pile[off]\Count+size)+" To "+Str(on)+"/"+Str(CardSet(new)\Pile[on]\Count)
		CardSet(new)\Pile[on]\Card[CardSet(new)\Pile[on]\Count]=CardSet(new)\Pile[off]\Card[CardSet(new)\Pile[off]\Count+size]
		CardSet(new)\Pile[on]\Count+1
		cards-1
		size+1
	Wend

	CardSeries(off,new)
	CardSeries(on,new)

	new=Eliminate()
	Mem-new
	ProcedureReturn new!1

EndProcedure
Procedure FindCard(n,column,active=0)

	Protected size,count,found

	size=CardSet(active)\Pile[column]\Count
	;Debug "Search "+StrCard(n)

	While size
		size-1
		count+1
		If CardSet(active)\Pile[column]\Card[size]=n
			found=1
			size=0
		EndIf
	Wend

	If found
		ProcedureReturn count
	Else
		ProcedureReturn #Null
	EndIf

EndProcedure
Procedure GetFromPile(number,active=0)

	Protected i,z
	Protected s.s

	s=StringField(CardPile,number,",")
	z=Len(s)
	If (number<4 And z<>14) Or (number=4 And z<>6)
		Error("Illegal number of cards in pile '"+s+"'")
	EndIf

	For i=0 To z>>1-1
		CardSet(active)\Pile[i]\Card[CardSet(active)\Pile[i]\Count]=ValCard(Mid(s,i*2+1,2))
		CardSet(active)\Pile[i]\Count+1
		CardSeries(i,active)
	Next i
	CardSet(active)\Turns+"|GetPile"; SHORT

EndProcedure
Procedure Test(active=0)

	Protected i,j,k,n
	Protected card,top,check,count

	For i=0 To 6; 							Stapel 1-7 bewegen...
		With CardSet(active)\Pile[i]
			j=\Serie
			While j;							Zusammenhängende Serien berücksichtigen...
				card=\Card[\Count-j]
				; Debug StrCard(card)
				For k=0 To 6
					If k<>i
						top=CardSet(active)\Pile[k]\Count
						If top
							check=CardSet(active)\Pile[k]\Card[top-1]
							If check%13=(card+1)%13
								top=0
							EndIf
						Else
							check=99;		leerer Stapel, geht also
						EndIf
						If top=0
							count+1
							If Turn(j,i,k,active)
								CardSet(Mem)\Turns+"|"+StrCard(card)+Str(i+1)+">"+StrCard(check)+Str(k+1)
								Show(Mem,#Full)
							EndIf
						EndIf
					EndIf
				Next k
				j-1
			Wend
		EndWith
	Next i

EndProcedure

Procedure Iterate(start,stop)

	Protected i,a,b

	For i=start To stop
		a=Mem+1
		Test(i)
		b=Mem
		If b>=a
			Iterate(a,b)
		EndIf
	Next i

EndProcedure
Procedure Done()

	CompilerIf #File
		CloseFile(0)
	CompilerElse
		Debug "Done."
	CompilerEndIf
	End

EndProcedure
Procedure DoCardCheck()

	Protected s.s
	Protected z,i,o

	For i=1 To 4
		GetFromPile(i,0)
	Next i
	Show(0,1)

	For z=0 To 51
		s=StrCard(z)+": "
		For o=0 To 6
			i=CardSet(0)\Pile[o]\Count
			While i
				i-1
				If CardSet(0)\Pile[o]\Card[i]=z
					s+Str(o)+"/"+Str(i)+"  "
				EndIf
			Wend
		Next o
		Debug s
	Next z
	End

EndProcedure

Global z,i,o

Init()
Show(#Null,#True)

Iterate(0,0)

For o=1 To 4
	CompilerIf #File
		WriteStringN(0,"=====================================")
	CompilerElse
		Debug "====================================="
	CompilerEndIf
	z=Mem
	For i=0 To z
		GetFromPile(o,i)
	Next i
	Iterate(0,z)
Next o

Done()

[Michael Vogel]

My program above did already find the first steps of the solution of this tricky game...
...just needed to run it on a computer with more main memory

These are the first 350 moves (of more than 2000) to solve the puzzle:

Code: Select all

K♠1>A♣3 2♥2>--1 D♥4>K♠3 2♥1>3♣4 6♦2>--1 D♥3>K♦7 K♠3>--2 A♣3>2♥4 K♠2>A♣4 6♦1>--2 
K♠4>--1 A♣4>2♣5 D♥7>K♠1 A♣5>2♠6 K♦7>A♣6 D♥1>K♦6 5♦7>6♦2 2♥4>3♦7 2♣5>3♣4 6♦2>7♥5 
D♥6>--2 <Piles> X♣3>B♦2 9♥3>X♣2 D♦3>K♥5 9♥2>--3 X♣2>B♥7 B♦2>D♦5 D♥2>K♣6 9♥3>--2 
D♦5>--3 9♥2>X♣7 D♦3>--2 B♦2>--3 D♦2>K♥5 B♦3>--2 D♥6>--3 B♦2>D♥3 D♦5>K♣6 B♦3>D♦6 
D♥3>--2 B♦6>--3 D♥2>K♥5 B♦3>--2 D♦6>--3 B♦2>D♥5 D♦3>--2 9♥7>--3 D♦2>K♣6 9♥3>--2 
B♦5>D♦6 X♣7>--3 9♥2>X♣3 D♥5>--2 D♦6>K♥5 D♥2>K♣6 B♦5>--2 B♥7>D♦5 B♦2>D♥6 9♥3>--2 
X♣3>B♥5 9♥2>--3 X♣5>--2 9♥3>X♣2 B♥5>--3 B♦6>D♦5 B♥3>D♥6 9♥2>--3 X♣2>B♦5 9♥3>--2 
X♣5>B♥6 9♥2>X♣6 D♦5>--2 9♥6>--3 X♣6>B♦2 D♥6>K♥5 X♣2>B♥5 D♦2>K♣6 9♥3>--2 X♣5>B♦6 
9♥2>X♣6 2♥7>--2 3♦7>--3 2♥2>3♦3 9♥6>--2 X♣6>B♥5 9♥2>X♣5 D♦6>--2 K♣6>A♠7 D♦2>K♦6
9♥5>--2 X♣5>B♦6 9♥2>X♣6 K♣7>--2 A♠7>2♥3 K♣2>A♠3 D♥5>--2 K♣3>A♥7 D♥2>K♣7 9♥6>--2
X♣6>B♥7 9♥2>X♣7 A♠3>--2 K♦6>A♠2 D♦2>K♥5 A♣6>2♥3 K♦2>A♣3 A♠2>2♠6 K♦3>--2 D♦5>K♦2
K♦2>A♠6 A♣3>--2 K♦6>A♣2 D♦2>K♥5 A♠6>2♥3 K♦2>A♠3 A♣2>2♠6 9♥7>--2 X♣7>B♦5 9♥2>X♣5
K♦3>--2 D♥7>K♦2 K♣7>A♠3 D♥2>K♣3 K♦2>A♣6 D♥3>--2 K♣3>A♥7 D♥2>K♦6 A♠3>--2 D♥6>K♣7
K♦6>A♠2 A♣6>2♥3 K♦2>A♣3 A♠2>2♠6 K♦3>--2 D♥7>K♦2 K♣7>A♣3 D♥2>K♣3 K♦2>A♠6 D♥3>--2
K♣3>A♥7 D♥2>K♦6 A♣3>--2 D♥6>K♣7 K♦6>A♣2 A♠6>2♥3 D♥7>K♦2 K♣7>A♠3 D♥2>K♣3 K♦2>A♥7
D♥3>K♦7 A♣2>2♠6 K♣3>--2 D♥7>K♣2 K♦7>A♠3 D♥2>K♦3 K♣2>A♣6 D♥3>--2 K♦3>A♥7 D♥2>K♣6
A♠3>--2 D♥6>K♦7 K♣6>A♠2 A♣6>2♥3 K♣2>A♣3 A♠2>2♠6 K♣3>--2 D♥7>K♣2 K♦7>A♣3 D♥2>K♦3
K♣2>A♠6 D♥3>--2 K♦3>A♥7 D♥2>K♣6 5♣4>--2 A♣3>2♣4 D♥6>K♦7 K♣6>A♣4 A♠6>2♥3 K♣4>A♠3
D♥7>K♣3 K♦7>A♣4 D♥3>K♦4 K♣3>A♥7 A♠3>2♠6 D♥4>K♣7 K♦4>A♠6 D♥7>K♦6 K♣7>A♣4 D♥6>K♣4
A♥7>2♥3 K♦6>A♥3 D♥4>K♦3 K♣4>A♠6 D♥3>K♣6 K♦3>A♣4 D♥6>K♦4 K♣6>A♥3 D♥4>K♣3 K♦4>A♠6
D♥3>K♦6 3♣4>4♥7 9♣1>X♦4 K♠1>A♣7 5♣2>--1 K♣3>--2 D♥6>K♣2 K♦6>A♥3 D♥2>K♦3 K♣2>A♠6
5♣1>--2 D♥3>K♣6 K♦3>--1 D♥6>K♦1 K♣6>A♥3 D♥1>K♣3 K♠7>A♠6 K♦1>A♣7 5♣2>--1 D♥3>K♠6
K♣3>--2 D♥6>K♣2 K♠6>A♥3 D♥2>K♠3 K♣2>A♠6 5♣1>--2 D♥3>K♣6 K♠3>--1 D♥6>K♠1 K♦7>A♥3
K♣6>A♣7 D♥1>K♦3 K♠1>A♠6 5♣2>--1 D♥3>K♠6 K♦3>--2 D♥6>K♦2 K♠6>A♥3 D♥2>K♠3 K♦2>A♠6
5♣1>--2 D♥3>K♦6 9♣4>--1 X♦4>B♥6 9♣1>X♦6 5♣2>--1 K♠3>--2 5♣1>6♥4 K♠2>--1 2♥3>--2
K♠1>A♥2 3♦3>--1 K♠2>--3 2♥2>3♦1 A♥1>--2 K♠3>A♥2 9♥5>--3 9♣6>X♣5 9♥3>X♦6 K♠2>--3
A♥2>2♥1 2♥1>--2 K♠3>A♥2 3♦1>--3 K♠2>--1 2♥2>3♦3 K♠1>--2 2♥3>--1 K♠2>A♥1 3♦3>--2 
K♠1>--3 2♥1>3♦2 A♥2>--1 K♠3>A♥1 X♣5>--3 D♦5>K♠1 X♣3>B♦1 9♣1>--3 9♥6>X♣1 9♣3>X♦6
K♣7>--3 A♣7>2♥2 K♣3>A♣2 9♥1>--3 9♣6>X♣1 9♥3>X♦6 X♣1>--3 D♦1>K♣2 X♣3>B♦2 K♠1>--3 
A♥1>2♣7 X♣2>--1 D♦2>K♠3 X♣1>B♦3 K♣2>A♥7 A♣2>--1 K♣7>A♣1 A♥7>2♥2 K♣1>A♥2 A♣1>2♣7 
K♣2>A♣7 2♥2>--1 K♣7>A♥1 2♣7>3♦2 K♣1>A♣2 2♥1>3♣7 K♣2>A♥7 A♣2>--1 K♣7>A♣1 A♥7>2♣2 
K♣1>A♥2 A♣1>2♥7 K♣2>A♣7 X♣3>--1 D♦3>K♥5 X♣1>B♦5 A♥2>--1 K♠3>A♥1 X♣5>--3 D♦5>K♠1 
X♣3>B♦1 9♣1>--3 9♥6>X♣1 9♣3>X♦6 K♣7>--3 A♣7>2♣2 K♣3>A♣2 9♥1>--3 9♣6>X♣1 9♥3>X♦6
X♣1>--3 D♦1>K♣2 X♣3>B♦2 K♠1>--3 A♥1>2♥7 X♣2>--1 D♦2>K♥5 X♣1>B♦5 K♣2>--1 K♠3>A♣2 
K♣1>--3 K♠2>--1 K♣3>A♥7 2♣2>--3 K♠1>A♣3 3♦2>--1 K♠3>--2 2♣3>3♦1 A♣1>--3 K♠2>A♣3 
...