#167858 - 2006-09-16 02:24 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
RemcovC
Starting to like KiXtart
Registered: 2006-09-13
Posts: 174
Loc: Holland
|
ok ok..... removed some qoutes, 275 now
Code:
Function s($)
Dim $a,$b,$c,$d,$e,$f,$g
$d=" "
For $b=1 to $
$d=W+$d+B
$a=$a+$+2
Next
Redim $s[$a]
$=2
For $c=0 to $a
$s[$c]=$d
$d=Join(Split($d),SubStr($d,$b-1,1))
$d=Left($d,$b-2)+" "+Substr($d,$b)
$b=$b+$
$e=Iif($a/2>$c+1,1,~)
If Abs($)=1
$=-2*$e*$
Else
If $f
$f=$f-1
Else
$=$*$e/2
$g=$g+$e
$f=$g
EndFunction
|
|
Top
|
|
|
|
|
#167859 - 2006-09-16 02:46 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
remco, here's 272 of your code:
Code:
Function s($)
Dim $a,$b,$c,$d,$e,$f,$g
$d=" "
For $b=1 to $
$d=W+$d+B
$a=$a+$+2
Next
Redim $s[$a]
$=2
For $c=0 to $a
$s[$c]=$d
$d=Join(Split($d),SubStr($d,$b-1,1))
$d=Left($d,$b-2)+" "+Substr($d,$b)
$b=$b+$
$e=2*($a/2>$c+1)-1
If Abs($)=1
$=-2*$e*$
Else
If $f
$f=$f-1
Else
$=$*$e/2
$g=$g+$e
$f=$g
EndFunction
|
|
Top
|
|
|
|
|
#167860 - 2006-09-16 02:49 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
DrillSergeant
MM club member
Registered: 2004-07-09
Posts: 1164
Loc: Eijsden, the Netherlands
|
Here's my 360:
Code:
Function s($n)
ReDim $s[$n*($n+2)], $, $a, $b, $r
; get directions
$ = " "
For $a = -$n+1 to $n-1
If $a < 1
$r = $r + $ + 1
$ = iif($ = "-", " ", "-")
EndIf
For $b = 1 to $n-abs($a)
$r = $r + $ + 2
Next
If $a > -1
$ = iif($ = "-", " ", "-")
$r = $r + $ + 1
EndIf
Next
; build first line
For $a = 1 to $n
$ = "W" + $ + "B"
Next
$s[0] = $
; build result
For $a = 1 to Len($r) step 2
$ = $s[$a/2]
$b = InStr($," ") + Substr($r, $a, 2)
$ = join(Split($), Substr($, $b, 1))
$s[$a/2 + 1] = Left($, $b - 1) + " " + Substr($, $b + 1)
EndFunction
Damn... I should have googled more for that algorithm 
|
|
Top
|
|
|
|
|
#167862 - 2006-09-16 03:18 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
244
Code:
function s($a)
dim $,$i,$c,$n,$t
$=' '
for $c = 1 to $a
$ = Wa + $ + aB
next
$ = split($,a)
$t=join($,'')
$n=1
for $i = 1 to $a*2
for $c=$n*($i-2*($i-$a)*($i>$a))*($i<$a*2) to -$c step -2*$n
$[ascan($,' ')] = $[$c+$a]
$[$c+$a]=' '
$t=$t+a+join($,'')
$s=split($t,a)
next
$n=-$n
endfunction
|
|
Top
|
|
|
|
|
#167863 - 2006-09-16 03:21 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
DrillSergeant
MM club member
Registered: 2004-07-09
Posts: 1164
Loc: Eijsden, the Netherlands
|
Quote:
By the way, i didn't read the link jens posted, but if you look at the position of the space ' ' with regards to the center of board, a pretty clear pattern appears. Here are those positions for $=1 to 5
Quote:
--------------------------------------------------------------------------------
1 -1 0
1 -1 -2 0 2 1 -1 0
1 -1 -2 0 2 3 1 -1 -3 -2 0 2 1 -1 0
1 -1 -2 0 2 3 1 -1 -3 -4 -2 0 2 4 3 1 -1 -3 -2 0 2 1 -1 0
1 -1 -2 0 2 3 1 -1 -3 -4 -2 0 2 4 5 3 1 -1 -3 -5 -4 -2 0 2 4 3 1 -1 -3 -2 0 2 1 -1 0
pretty clear??? to me this is about as logical as a RND() 
|
|
Top
|
|
|
|
|
#167864 - 2006-09-16 03:23 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
DrillSergeant
MM club member
Registered: 2004-07-09
Posts: 1164
Loc: Eijsden, the Netherlands
|
240:
Code:
function s($a)
dim $,$i,$c,$n,$t
$=' '
for $c = 1 to $a
$ = Wa + $ + aB
next
$ = split($,a)
$t=join($,'')
$n=1
for $i = 1 to $a*2
$n=-$n
for $c=$n*($i-2*($i-$a)*($i>$a))*($i<$a*2) to -$c step -2*$n
$[ascan($,' ')] = $[$c+$a]
$[$c+$a]=' '
$t=$t+a+join($,'')
$s=split($t,a)
EndFunction
|
|
Top
|
|
|
|
|
#167865 - 2006-09-16 03:27 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
239
Code:
function s($a)
dim $,$i,$c,$n,$t
$=' '
for $n = -$a+1 to 0
$ = Wa + $ + aB
next
$ = split($,a)
$t=join($,'')
for $i = 1 to $a*2
$n=-$n
for $c=$n*($i-2*($i-$a)*($i>$a))*($i<$a*2) to -$c step -2*$n
$[ascan($,' ')] = $[$c+$a]
$[$c+$a]=' '
$t=$t+a+join($,'')
$s=split($t,a)
endfunction
|
|
Top
|
|
|
|
#167866 - 2006-09-16 03:50 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Jochen
KiX Supporter
Registered: 2000-03-17
Posts: 6380
Loc: Stuttgart, Germany
|
Right Gentlemen,
for what's it worth anyway, I'll just post, beyond competition,
my 472(changed last case condition to case 1 )
Code:
function s($)
dim $![$+$*($+1)], $_, $0, $1
$![0] = " "
for $_ = 1 to $
$![0] = "W" + $![0] + "B"
next
for $_ = 1 to ubound($!)
$ = split($![$_-1]," ")
$0 = right($[0],1)
$1 = left($[1],1)
select
case instr($[1],"B")=2 and $1 = "W" ;^B
$![$_] = $[0] + "B" + $1 + " " + right($[1],-2)
case ($0 = "B" and $1 = "B" and instr($[0],'W')) or ($0 = "B" and instr($[1],'B') = 0) ;W^
$![$_] = left($[0],-2) + " " + $0 + "W" + $[1]
case $0 = "W" and ( instr($[0],"B")=0 or instr($[1],"B")=0 ) ;W->
$![$_] = left($[0],~) + " W" + $[1]
case 1 ;<-B
$![$_] = $[0] + "B " + right($[1],~)
endselect
next
$s = $!
endfunction
that is :
Code:
Shuttle Puzzle passed all 10 tests (100% correct)
KiXtart
KiXtart Version = 4.52
KiXforms Version =
KiXGolf Script = KIXGOL~1.KIX
Computer
OS = Windows XP Professional
CPU = Intel Pentium Model 13
Speed = 1698 MHz
Memory = 1022 MB
KiXGolf Scoring Engine
Scoring Engine = 3.2
KiXtart Golf Score
Tournament = KiXtart Golf: Shuttle Puzzle
Processing Start = 2006/09/16 15:42:24.625
Processing End = 2006/09/16 15:42:24.665
Duration = 0000/00/00 00:00:00.040
KiXGolf Score = 472
Thank you for participating in KiXtart Golf!
Having said that, I wish y'all a superb weekend and
successful golfing 
_________________________
|
|
Top
|
|
|
|
|
#167867 - 2006-09-16 03:51 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Benny69
Moderator
Registered: 2003-10-29
Posts: 1036
Loc: Lincoln, Ne
|
Ok, here is the code I started with (652), the first 3 'For' loops create the 'Key' to shifting the marbles then the rest shifts them around.
The 'Key' that is created for the input of 1, 2 and 3 is:
W1 B2 W1
W1 B2 B1 W2 W2 B1 B2 W1
W1 B2 B1 W2 W2 W1 B2 B2 B2 W1 W2 W2 B1 B2 W1
The W and B refer to the color to be moved and the number 1 means move the marble 1 space and 2 means jump the marble next to it (move 2 spaces).
White marbles will always move right and Black will always move left, so no need for a direction.
Code:
Function s($z)
Dim $a,$b,$c,$d,$e,$f,$g,$h,$i
$b=' '
$c=$z
$d=$c
For $a=1 to $z
$b='W'+$b+'B'
$d=''+$c+' '+$d+' '+$c+''
$c=$c-1
$h=$h+'2 '
Next
$d=Split($d)
$c=$z-1
For $a=1 to $z
$h='1 '+$h+'1 '
For $f = 1 to $c
$h='2 '+$h+'2 '
Next
$c=$c-1
Next
$h=Split(Trim($h))
$a=1
For Each $c in $d
For $f = 1 to $c
$e=IIf($a mod 2,'B','W')
$g=$g+$e+$h[$i]+' '
$i=$i+1
Next
$a=$a+1
Next
$d=Split(Trim($g))
ReDim $g[UBound($d)+1]
$g[0]=$b
$a=1
For Each $c in $d
$f=Split($b)[0]
$h=Split($b)[1]
$e=Right($c,1)
$b=IIf(Left($c,1)='W',
IIf($e=1,SubStr($f,1,Len($f)-1)+' W',SubStr($f,1,Len($f)-2)+
' '+Right($f,1)+'W')+$h,$f+
IIf($e=1,'B '+SubStr($h,2,Len($h)-1),'B'+Left($h,1)
+' '+SubStr($h,3,Len($h)-2)))
$g[$a]=$b
$a=$a+1
;Next
$s=$g
EndFunction
Then I changed the to this process (412), the idea is to shift marbles based on the color of the two marbles to the left and right of the center space.
Code:
Function s($z)
Dim $a,$,$c,$d,$e,$f,$g,$h[1],$i
$=' '
$c=' '
For $a=1 to $z
$='W'+$+'B'
$c='B'+$c+'W'
Next
$h[0]=$
Do
$=Split($)
$d=$[0] ;Left
$e=$[1] ;Right
$f=Right($d,2) ;Right chrs of Left Half
$g=Left($e,2) ;Left chrs of Right Half
Select
Case $f='WB'
$=Left($d,Len($d)-2)+' BW'+$e
Case $g='WB'
$=$d+'BW '+Right($e,Len($e)-2)
Case Not($f='W' Or $f='WW') And Left($g,1)='B'
$=$d+'B '+Right($e,Len($e)-1)
Case 1
$=Left($d,Len($d)-1)+' W'+$e
EndSelect
$i=$i+1
ReDim preserve $h[$i]
$h[$i]=$
Until $=$c
$s=$h
EndFunction
|
|
Top
|
|
|
|
|
#167869 - 2006-09-16 04:18 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
DrillSergeant
MM club member
Registered: 2004-07-09
Posts: 1164
Loc: Eijsden, the Netherlands
|
Jochen, this is shorter: $*($+2)
|
|
Top
|
|
|
|
|
#167870 - 2006-09-16 07:43 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Benny69
Moderator
Registered: 2003-10-29
Posts: 1036
Loc: Lincoln, Ne
|
here is my code trimed down to 368:
Code:
Function s($z)
Dim $a,$,$c,$d,$e,$f,$g,$h[$z*($z+2)]
$=' '
$c=' '
For $a=1 to $z
$=W+$+B
Next
For $a = 0 to $z*($z+2)
$h[$a]=$
$=Split($)
$d=$[0] ;Left
$e=$[1] ;Right
$f=Right($d,2) ;Right chrs of Left Half
$g=Left($e,2) ;Left chrs of Right Half
Select
Case $f=WB
$=Left($d,Len($d)-2)+' BW'+$e
Case $g=WB
$=$d+'BW '+Right($e,Len($e)-2)
Case Not($f=W Or $f=WW) And Left($g,1)=B
$=$d+'B '+Right($e,Len($e)-1)
Case 1
$=Left($d,Len($d)-1)+' W'+$e
EndSelect
Next
$s=$h
EndFunction
Edited by benny69 (2006-09-16 07:44 PM)
|
|
Top
|
|
|
|
|
#167871 - 2006-09-16 07:48 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Witto
MM club member
Registered: 2004-09-29
Posts: 1828
Loc: Belgium
|
Here is my code. I do not think someone wants to reuse it.
My logic was:
example
if input is 3
starting position = -3 -2 -1 0 1 2 3
Then some code to get to the
ending position = 1 2 3 0 -3 -2 -1
Then swap numbers
0 = ' '
<0 = 'W'
>0 = 'B'
Code:
Function s($)
Dim $j, $k, $b, $v
Dim $a[$+$]
For $j = 0 to $+$
$a[$j] = ~$+1+$j
Next
$s = d($s,$a)
For $k = 1 to $
For $j = 1 to $k
$a = c($j,$a)
$s = d($s,$a)
Next
If $ > $k
$k=$k+1
EndIf
For $j = -1 to ~$k+1 step -1
$a = c($j,$a)
$s = d($s,$a)
Next
Next
If NOT $ MOD 2
For $j = 1 to $
$a = c($j,$a)
$s = d($s,$a)
Next
EndIf
If $ MOD 2
For $k = -1 to ~$+1 step -1
For $j = ~$k+1 to $
$a = c($j,$a)
$s = d($s,$a)
Next
If ~$+1 < $k
$k=$k-1
EndIf
If NOT $k = ~$+1
For $j = $k to ~$+1 step -1
$a = c($j,$a)
$s = d($s,$a)
Next
EndIf
Next
Else
For $k = -1 to ~$+1 step -1
For $j = $k to ~$+1 step -1
$a = c($j,$a)
$s = d($s,$a)
Next
If ~$+1 < $k
$k=$k-1
EndIf
For $j = ~$k+1 to $
$a = c($j,$a)
$s = d($s,$a)
Next
Next
EndIf
$s=Split($s,"-")
EndFunction
Function c($j,$a)
Dim $b,$v
$b = AScan($a,0)
$v = AScan($a,$j)
$a[$b]=$j
$a[$v]=0
$c = $a
EndFunction
Function d($s,$a)
Dim $j
If $s
$s = $s + "-"
EndIf
For Each $j In $a
Select
Case $j < 0
$s = $s + "W"
Case $j = 0
$s = $s + " "
Case $j > 0
$s = $s + "B"
EndSelect
Next
$d = $s
EndFunction
If you would change
<0 = 'B'
>0 = 'A'
all of the tests will fail...
For one or another reason, I was also looking at the Demlo Number...
But at the end found nothing that could help me.
|
|
Top
|
|
|
|
|
#167873 - 2006-09-16 08:46 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
lol!!!
how NOBODY saw this?!?!?
238
Code:
function s($a)
dim $,$i,$c,$n,$t
$=' '
for $n = 1-$a to 0
$ = Wa + $ + aB
next
$ = split($,a)
$t=join($,'')
for $i = 1 to $a*2
$n=-$n
for $c=$n*($i-2*($i-$a)*($i>$a))*($i<$a*2) to -$c step -2*$n
$[ascan($,' ')] = $[$c+$a]
$[$c+$a]=' '
$t=$t+a+join($,'')
$s=split($t,a)
endfunction
|
|
Top
|
|
|
|
|
#167875 - 2006-09-16 09:42 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
anyways, now I'm proud of myself. didn't like the cryptic line of maciep's code, so shrank it:
Code:
Shuttle Puzzle passed all 10 tests (100% correct)
KiXtart
KiXtart Version = 4.53 Release Candidate 1
KiXforms Version =
KiXGolf Script = kixgolf_shuttle.kix
Computer
OS = Windows XP Professional
CPU = Intel Pentium Model 13
Speed = 800 MHz
Memory = 760 MB
KiXGolf Scoring Engine
Scoring Engine = 3.2
KiXtart Golf Score
Tournament = KiXtart Golf: Shuttle Puzzle
Processing Start = 2006/09/16 22:39:56.031
Processing End = 2006/09/16 22:39:56.265
Duration = 0000/00/00 00:00:00.233
KiXGolf Score = 220
Code:
function s($a)
dim $,$i,$c,$n,$t
$=' '
for $n = 1-$a to 0
$ = Wa + $ + aB
next
$ = split($,a)
$t=join($,'')
for $i = -$a+1 to $a
$n=-$n
for $c=$n*($a-abs($i)) to -$c step -2*$n
$[ascan($,' ')] = $[$c+$a]
$[$c+$a]=' '
$t=$t+a+join($,'')
$s=split($t,a)
endfunction
|
|
Top
|
|
|
|
|
#167876 - 2006-09-16 09:44 PM
Re: KiXgolf: Shuttle Puzzle - Public Round
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
damn, same mistake again!!! my luck that nobody else is watching this thread
Code:
KiXGolf Score = 219
Code:
function s($a)
dim $,$i,$c,$n,$t
$=' '
for $n = 1-$a to 0
$ = Wa + $ + aB
next
$ = split($,a)
$t=join($,'')
for $i = 1-$a to $a
$n=-$n
for $c=$n*($a-abs($i)) to -$c step -2*$n
$[ascan($,' ')] = $[$c+$a]
$[$c+$a]=' '
$t=$t+a+join($,'')
$s=split($t,a)
endfunction
|
|
Top
|
|
|
|
Moderator: Arend_, Allen, Jochen, Radimus, Glenn Barnas, ShaneEP, Ruud van Velsen, Mart
|
0 registered
and 668 anonymous users online.
|
|
|
