#69272 - 2002-08-21 09:09 PM
KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Sealeopard
KiX Master
Registered: 2001-04-25
Posts: 11164
Loc: Boston, MA, USA
|
Okay, Golf fanatics!
Time's up and you're allowed to post your code now. So take a look at the competitor and try to improve your code!
Lonkero: Must be torture for you to look at other people's code and not do anything about it
Here's my code with a KiXtart Golf score of 702
code:
; beginning of the Anagram() UDF and supporting UDFs ;! function anagram($) dim $c, $d, $e, $b, $a, $i, $o, $f
if ubound($)<0 $f='' else $=s($)
$i=ubound($)
$f=$ for $c=0 to $i $o=$[$c] redim $l[25] for $b=1 to len($o) $a=asc(substr($o,$b,1))-97 $l[$a]=$l[$a]+1 next $f[$c]=join($l) next
for $c=0 to $i-1 for $d=$c+1 to $i if $f[$c]=$f[$d] and $[$d] $[$c]=$[$c]+' '+$[$d] $[$d]='' endif next next
$o=$ for $c=0 to $i $d=split($[$c]) if ubound($d) $o[$c]=right('0'+ubound($d),2)+$d[0] endif next
$o=s($o)
$f=$ $e=0 for $c=0 to $i for $d=0 to $i $b=substr($o[$c],3) if $b=split($[$d],' ')[0] and $b $f[$e]=$[$d] $e=$e+1 endif next next if $e redim preserve $f[$e-1] else $f='' endif
endif
$anagram=$f
endfunction function s($) dim $i,$j,$k,$m,$n $k=ubound($) for $i = 0 to $k for $j = $i + 1 to $k $m = $[$i] $n = $[$j] if $n < $m $m = $n $[$j] = $[$i] $[$i] = $m endif next next $s = $ endfunction ;! ;! ; end of the Anagram() UDF and supporting UDFs
[ 21. August 2002, 21:11: Message edited by: sealeopard ]
_________________________
There are two types of vessels, submarines and targets.
|
Top
|
|
|
|
#69273 - 2002-08-21 09:20 PM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Anonymous
Anonymous
Unregistered
|
Golf Score = 487 Uses Kixtart 4.10 + (Requires JOIN)
code:
FUNCTION anagram($J) DIM $u, $,$a,$b,$c, $I,$O $u = UBound($J) $I = S($J) ; Sort the Input array ; ; Create anagram ID's for checking FOR $ = 0 TO $u DIM $t[20] ; Len($I[$]) FOR $a = 1 TO Len($I[$]) $t[$a] = Substr($I[$],$a,1) NEXT $J[$] = Join(S($t),'') NEXT ; ; Get anagrams into a new array ;$O = '' $b = '' FOR EACH $a IN $J ; for each anagram id DIM $,$d FOR $c = 0 TO $u IF $a = $J[$c] AND $a ; If matches anagram id and word not null $ = $ + ' ' + $I[$c] ; add word to line (already sorted) $d = 1 + $d ; Increment word count $J[$c] = 0 ; prevent it being selected again ENDIF NEXT IF $d > 1 ; More than 1 word in anagram line $O = $O +$b+ Chr($d)+$ ; Add <word count>+<line> $b = # ; Char to split lines on ENDIF NEXT ; $ = '' IF $O $ = S(Split($O,#)) ; Sort by Word count / Alpha FOR $a = 0 TO Ubound($) $[$a] = Substr($[$a],3) ; Remove words counter NEXT ENDIF $anagram = $ ENDFUNCTION ; ; FUNCTION S($) ;Sort routine DIM $i,$t FOR EACH $i IN $ FOR $i = 1 TO UBound($) $t = $[$i-1] IF $[$i] < $t $[$i-1] =$[$i] $[$i] =$t ENDIF NEXT NEXT $S = $ ENDFUNCTION
|
Top
|
|
|
|
#69275 - 2002-08-21 09:26 PM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Howard Bullock
KiX Supporter
Registered: 2000-09-15
Posts: 5809
Loc: Harrisburg, PA USA
|
KixGolf score = 625 code:
Function Anagram($) Dim $a, $d, $i, $j, $k, $m, $n, $o, $t, $u, $x, $y, $w
$x = ubound($) $u=$ gosub T $y=0 for $i=0 to $x-1 if $[$i] $w=0 $u[$w] = $[$i] for $j=$i+1 to $x if S($[$i])= S($[$j]) $w=$w+1 redim preserve $u[$w], preserve $k[$y], preserve $m[$y] $u[$w] = $[$j] $[$j] = 0 endif next
if $w>0 $k[$y] = $w $m[$y] = join($u," ") $y=$y+1 endif endif next
$x=$y-1 $ = $k $u = $m gosub T
$Anagram =$u
:T Do $n=0 for $a=0 to $x-1
if $[$a]>$[$a+1] $n=$[$a] $o=$U[$a]
$[$a]=$[$a+1] $U[$a]=$U[$a+1]
$[$a+1]=$n $U[$a+1]=$o endif next Until $n=0 return
Endfunction
Function S($) Dim $b, $c, $i, $y do $y=1 for $i=1 to len($)-1 $b=substr($,$i,1) $c=substr($,$i+1,1) if $b > $c $ = left($,$i-1) + $c + $b + substr($,$i+2) $y=0 endif next until $y $S=$ Endfunction
[ 21. August 2002, 21:28: Message edited by: Howard Bullock ]
|
Top
|
|
|
|
#69276 - 2002-08-21 11:50 PM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
MightyR1
MM club member
Registered: 1999-09-09
Posts: 1264
Loc: The Netherlands
|
|
Top
|
|
|
|
#69281 - 2002-08-22 11:36 AM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
ok, my 495 code:
code:
function anagram($o) dim $w,$c,$a,$l,$,$m,$b for $=1 to ubound($o) if $o[$]<$o[$-1] $c=$o[$] $o[$]=$o[$-1] $o[$-1]=$c $=0 endif next for each $w in $o $b=0 for each $ in $o $c=$ for $l=1 to len($w) $a=instr($,substr($w,$l,1)) $=left($,$a-1)+substr($,$a+1) next if 0=($|len($c)+1-$l) $b="$b $c" endif next if 1<ubound(split($b)) & 0=instr($m,$b) $m="$m$b" endif next $=split(substr($m,3),"0 ") for $m=1 to ubound($) if ubound(split($[$m]))<ubound(split($[$m-1])) $o=$[$m] $[$m]=$[$m-1] $[$m-1]=$o $m=0 endif next if 0=len($[0]) $="" endif $anagram=$ endfunction
_________________________
!download KiXnet
|
Top
|
|
|
|
#69283 - 2002-08-23 12:24 AM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Lonkero
KiX Master Guru
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
HAHAA! I said ajh has something to improve. Golf Score: 484
code:
FUNCTION anagram($J) DIM $u, $,$a,$b,$c, $I,$O $u = UBound($J) $I = S($J)
FOR $ = 0 TO $u DIM $t[20] FOR $a = 1 TO Len($I[$]) $t[$a] = Substr($I[$],$a,1) NEXT $J[$] = Join(S($t),'') NEXT
FOR EACH $ IN $J DIM $a,$d FOR $c = 0 TO $u IF $ = $J[$c] AND $ $a = '$a ' + $I[$c] $d = 1 + $d $J[$c] = 0 ENDIF NEXT IF $d > 1 $O = $O +$b+ Chr($d)+$a $b = # ENDIF NEXT
$ = '' IF $O $ = S(Split($O,#)) FOR $a = 0 TO Ubound($) $[$a] = Substr($[$a],3) NEXT ENDIF $anagram = $ ENDFUNCTION
FUNCTION S($) DIM $t FOR EACH $s IN $ FOR $s = 1 TO UBound($) $t = $[$s-1] IF $[$s] < $t $[$s-1] =$[$s] $[$s] =$t ENDIF NEXT NEXT $S = $ ENDFUNCTION
_________________________
!download KiXnet
|
Top
|
|
|
|
#69284 - 2002-08-22 01:26 PM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Richard H.
Administrator
Registered: 2000-01-24
Posts: 4946
Loc: Leatherhead, Surrey, UK
|
Hmm. Beats my 554 by quite a margin.
code:
Function Anagram($A) Dim $B,$C,$I,$T,$E,$,$R,$Q,$X,$Y $B=Ubound($A) $A=S($A,$B) For Each $C in $A $X=0 $Y="" If $C For $E=0 To $B $R=$A[$E] If Len($R)=Len($C) For $T=1 To Len($C) $Q=InStr($R,SubStr($C,$T,1)) If $Q $R=Left($R,$Q-1)+"."+SubStr($R,$Q+1) Else Goto M EndIf Next $Y=$Y+" "+$A[$E] $X=$X+1 $A[$E]="" :M EndIf Next If $X>1 $A[$]=""+$X+$Y $=$+1 EndIf EndIf Next If $ $=$-1 $A=S($A,$) ReDim Preserve $A[$] For $I=0 To $ $A[$I]=SubStr($A[$I],3) Next Else $A="" EndIf $Anagram=$A EndFunction Function S($A,$R) Dim $T,$E,$ Do $E=1 For $=1 to $R If $A[$]<$A[$-1] $T=$A[$] $A[$]=$A[$-1] $A[$-1]=$T $E=0 EndIf Next Until $E $S=$A EndFunction
|
Top
|
|
|
|
#69286 - 2002-08-22 07:45 PM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Fernando Madruga
Starting to like KiXtart
Registered: 2002-08-21
Posts: 149
Loc: Coimbra.Portugal.Europe.Earth....
|
So, what is the lowest score so far?
I'm new to KiXtart and have been fighting it most of the afternoon. Yes, fighting is the word... Either script error reporting on this thing is RUDE or I'm missing something... I have this cool idea for a bombastic implementation of the current Golf Tournament, but I've been fighting the damn KiX trying to do something that I should be able to do in 30 minutes on a decent language...
One such example: I've spent LOADS of time trying to get a function to return something and kept getting a criptic error message! All because I forgot the $ before the function name to return the value! After all, I thought the $ was for variables and the documentation for the Function/EndFunction does IMPLY that it's not used! Sure, the example DOES use it, but I was coding my func from scratch and I took some time to figure that out.
I must say, that in over 20 years of programming in 10s of languages, from several makes of assembler to SmallTalk and many more in between, this one is surely the worst I've seen in syntax error reporting!
As of now, I'm fighting to get the function call to work TWICE!
Almost a nightmare!
Anyway, just felt to take a break and find out what is the current low score to beat!
Bye, Fernando Madruga
P.S.: Is the "Preview Post" button working? Can't get to preview my posts either...
_________________________
Later,
[b]Mad[/b]ruga
|
Top
|
|
|
|
#69288 - 2002-08-22 07:55 PM
Re: KiXtart Golf Tournament IV: Anagrams (Part 2, The code!)
|
Anonymous
Anonymous
Unregistered
|
I'm sorry Lonkero, but I think you missed it. I backed out your changes to the central loop as it was the same length as mine, but used ('$a ') which I don't think is allowed. You reduced the Sort UDF by 3 but missed your own trick, namely setting the loop var to zero on a swap, allowing me to remove the outer loop. Golf score = 472
code:
FUNCTION anagram($J) DIM $u, $,$a,$b,$c, $I,$O $u = UBound($J) $I = S($J)
FOR $ = 0 TO $u DIM $t[20] FOR $a = 1 TO Len($I[$]) $t[$a] = Substr($I[$],$a,1) NEXT $J[$] = Join(S($t),'') NEXT
FOR EACH $a IN $J DIM $,$d FOR $c = 0 TO $u IF $a = $J[$c] AND $a $ = $ + ' ' + $I[$c] $d = 1 + $d $J[$c] = 0 ENDIF NEXT IF $d > 1 $O = $O +$b+ Chr($d)+$ $b = # ENDIF NEXT
$ = '' IF $O $ = S(Split($O,#)) FOR $a = 0 TO Ubound($) $[$a] = Substr($[$a],3) NEXT ENDIF $anagram = $ ENDFUNCTION ; FUNCTION S($) DIM $t FOR $S = 1 TO UBound($) $t = $[$S-1] IF $[$S] < $t $[$S-1] =$[$S] $[$S] =$t $S = 0 ENDIF NEXT $S = $ ENDFUNCTION
|
Top
|
|
|
|
Moderator: Glenn Barnas, NTDOC, Arend_, Jochen, Radimus, Allen, ShaneEP, Ruud van Velsen, Mart
|
0 registered
and 259 anonymous users online.
|
|
|