Anonymous user
Anagrams: Difference between revisions
→{{header|Vedit macro language}}
m (→{{header|Picat}}: Added out tag.) |
|||
Line 9,126:
Time to go : 2,464844 seconds.</pre>
=={{header|VBScript}}==
A little convoluted, uses a dictionary and a recordset...
<lang vb>
Const adInteger = 3
Const adVarChar = 200
function charcnt(s,ch)
cnt=0
for i=1 to len(s)
if mid(s,i,1)=ch then cnt=cnt+1
next
charcnt=cnt
end function
set fso=createobject("Scripting.Filesystemobject")
dim a(122)
sfn=WScript.ScriptFullName
sfn= Left(sfn, InStrRev(sfn, "\"))
s=sfn& "unixdict.txt"
set f=fso.opentextfile(s,1)
'words to dictionnary using acronym as key
set d=createobject("Scripting.Dictionary")
while not f.AtEndOfStream
erase a :cnt=0
s=trim(f.readline)
for i=1 to len(s)
n=asc(mid(s,i,1))
a(n)=a(n)+1
next
k=""
for i= 48 to 122
if a(i) then k=k & string(a(i),chr(i))
next
if d.exists(k) then
b=d(k)
d(k)=b & " " & s
else
d(k)=s
end if
wend
'copy dictionnary to recorset to be able to sort it .Add nr of items as new field
Set rs = CreateObject("ADODB.Recordset")
rs.Fields.Append "chars", adVarChar, 30
rs.Fields.Append "items", adInteger
rs.Fields.Append "words", adVarChar, 200
rs.open
for each k in d.keys
rs.addnew
rs("chars")=k
s=d(k)
rs("words")=s
rs("items")=charcnt(s," ")+1
rs.update
next
d.removeall
'sort the recordset
rs.sort="items" &" DESC"
'do the query
rs.movefirst
it=rs("items")
while rs("items")=it
wscript.echo rs("items") & " (" &rs("chars") & ") " & rs("words")
rs.movenext
wend
rs.close
</lang>
The output:
<pre>
5 (eilv) evil levi live veil vile
5 (aeln) elan lane lean lena neal
5 (acert) caret carte cater crate trace
5 (aegln) angel angle galen glean lange
5 (aeglr) alger glare lager large regal
5 (abel) abel able bale bela elba
</pre>
=={{header|Vedit macro language}}==
This implementation first sorts characters of each word using Insertion sort in subroutine SORT_LETTERS.<br>
| |||