sir_mud wrote:Here's my version that while not as "cool" as levenstien distance, I believe it is what you were looking for and a bit easier
to understand while introducing little new stuff (maybe the string indexing).
Hi SIR
Nice neat easy to understand method.
I see that you have a different interpretation of Squall's requirements to my own.
I just used comparison from the beginning of the guess, if you got the first letter wrong, then my interpretation is that you are a bit of a twit, and get no reward.
My percentage reflects the number you get right to the length of your guess, so if you bung in millions of letters, my interpretation is you are a bit of a chancer.
It looks as though, since the advent of fb 21, that neat easy code like your own is no longer viable to solve easy questions.
Now you must have recourse to a double barrelled algorith, preferably translated from C++ pseudo code.
J_milton picked a cracker in the famous Damerau–Levenshtein .
So, in light of this new found fad, I'm going to do the same thing, and if I can't come across a fitting name, I'll just make my own what d'ya think?
Here's the Leiper and Poynter method incorporated with the thing that J_milton suggested.
Code: Select all
declare Sub compare(Byref _correct As String,Byref _guess As String)
declare function bigformat(num as string) as string
'YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
' LEIPER AND POYNTER ALGORITHM FOR EXPANSIVE FORMATTING OF NUMERICAL STRINGS
' THE NEGOTIATED NEGATED Damerau–Levenshtein ALGORITHM FOR DEPTH SOUNDING
' TRANSLTED FROM THE C++ plus AND OBJECTIVE CAML PSEUDO CODE.
' THIS CODE IS OPEN SOURCE TO THE BEST OF MY RECKONING
' IN OTHER WORDS, IT CAN BE MESSED WITH, AT YOUR OWN PERIL
' DODICAT 27th. August 2010 @c
Type score
As Double percentage
As Integer value
End Type
Dim Shared info As score
' *********************** **************************************
Dim As String s1,s2
s1=bigformat("99887504534e-867")'the proper thing
s2=bigformat("99887504533e-867")'the guess
compare(s1,s2)
Print s1
print s2
print
Print "score ";info.value;" percentage correct";info.percentage
Sleep
' ************************ ****************************************
Sub compare(Byref _correct As String,Byref _guess As String)
Dim As String correct=Lcase(_correct)
Dim As String guess=Lcase(_guess)
Dim As String var1
Dim As String var2
#macro split(stri,char)
Scope
Dim As Long pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
Endif
End Scope
#endmacro
Dim ch As String
Dim As String copyguess,t1,t2
Dim z As Integer
For z =1 To Len (correct)
t1=(Left(correct,z))
t2=(Left(guess,z))
copyguess=Mid(guess,z)
ch= Mid(correct,z,1)
split(copyguess,ch)
If var2="" Then
If (correct)<>(guess) Then z=z-1
Exit For
End If
If t1<>t2 Then
z=z-1
Exit For
End If
Next z
info.value =z*100
info.percentage=z/Len(guess)*100
End Sub
function bigformat(num as string) as string
dim n as string=lcase(num)
for z as integer=1 to len(n) 'if d is used, make it e
if mid(n,z,1)="d" then mid(n,z,1)="e"
next z
if instr(n,"e") = 0 then return num 'no formatting needed
dim asci as integer
dim temp as string
' macro Remove all char from s
#macro remove(s,char)
asci=asc(char)
For i as long =0 To Len(s)-1
If s[i]<>asci Then temp=temp+Chr$(s[i])
Next i
s= temp:temp=""
#endmacro
dim as string part1,part2
'macro insert a character into a string
#macro insert(s,char,position)
part1=mid$(s,1,position-1)
part2=mid$(s,position)
s=part1+char+part2
#endmacro
remove(n,"+") 'get rid of + signs
' _________________________________________________
dim as string var1,var2,p1,p2
dim c as integer
dim tr as integer
' macro split on either side of the char
#macro two_parts(stri,char,var1,var2)
for c=1 to len(stri)
if tr=0 and mid(stri,c,1)<>char then
var1=var1+mid(stri,c,1)
endif
if mid(stri,c,1)=char then tr=1
if tr=1 then var2=var2+mid(stri,c+1,1)
next c
tr=0
#endmacro
two_parts(n,"e",p1,p2) 'e.g. 45.7e9 becomes p1=45.7 and p2= 9
p1=rtrim(p1,".") 'get rid of unneeded decimal
select case instr(p2,"-") 'e.g. 8e-9 where p2=-9
case 0
'________________________________________
select case instr(p1,".") 'e.g. 5.8e3 where p1=5.8
case 0 'no decimals
return p1+string(val(P2),"0")
case else
dim as integer lf1
dim as string f1,f2
two_parts(p1,".",f1,f2) 'e.g. 67.78e-7 f2=78
lf1=len(f2)
return f1+f2+string(val(p2)-lf1,"0")
end select
'_end case 0________________________________________
case else 'instr(p2,-) e.g. 78e-12 where p2=-12
dim zeros as integer
dim as integer lf1
dim as string f1,f2,sign
if instr(p1,"-") then sign="-"
two_parts(p2,"-",f1,f2)
zeros=val(f2)
two_parts(p1,".",f1,f2)
remove(f1,"-")
if len(f1) > val(f2)then 'e.g. 12345e-4
insert(f1,".",len(f1)-val(f2)+1)
return sign+f1
end if
lf1=len(f1)
remove(p1,"-")
remove(p1,".")
return ltrim(sign+"."+string(zeros-lf1,"0")+p1,"0")
end select
end function