ASP tag cloud code example
A tag cloud generator implemented in classic ASP.The algorithm for determining the font styles is dynamic, so it adapts automatically to inputs of varying sizes. The output is divided into 7 different font styles/sizes.
The function expects a simple array of tags/words as input, which are then counted and returned as a string of html links with sizes, that represent the relative number of appearances in relation to each other. The use of the ASP Dictionary object ensures performance and scalability when very large tag clouds are generated. However, best practice is still to store the generated tag cloud in something like an application variable instead of generating it on every page load.
Edit the variables strStyleSize1 to 7 and strUrlPrefix to suit your needs.
Function GenerateTagCloud(arrAllTags)
Dim strReturn
Dim strUrlPrefix
Dim intLoop
Dim objDictionary
Dim strTag
Dim colKeys
Dim strKey
Dim strStyleSize1
Dim strStyleSize2
Dim strStyleSize3
Dim strStyleSize4
Dim strStyleSize5
Dim strStyleSize6
Dim strStyleSize7
Dim lngHighestTagCount
Dim lngLowestTagCount
Dim dblDiff
Dim dblStep
Dim dblOffset
Dim dblBorder1
Dim dblBorder2
Dim dblBorder3
Dim dblBorder4
Dim dblBorder5
Dim dblBorder6
strUrlPrefix = "/?"
strStyleSize1 = "font-size: 9px;"
strStyleSize2 = "font-size: 10px;"
strStyleSize3 = "font-size: 12px;"
strStyleSize4 = "font-size: 14px;"
strStyleSize5 = "font-size: 14px; font-weight: bold;"
strStyleSize6 = "font-size: 16px; font-weight: bold;"
strStyleSize7 = "font-size: 18px; font-weight: bold;"
Set objDictionary = Server.CreateObject("Scripting.Dictionary")
For intLoop = 0 to Ubound(arrAllTags)
strTag = arrAllTags(intLoop)
If objDictionary.Exists(strTag) = True Then
objDictionary.Item(strTag) = objDictionary.Item(strTag) + 1
Else
objDictionary.Add strTag, 1
End If
Next
lngHighestTagCount = 1
lngLowestTagCount = 2147483647
colKeys = objDictionary.Keys
For Each strKey in colKeys
If objDictionary.Item(strKey) > lngHighestTagCount Then
lngHighestTagCount = objDictionary.Item(strKey)
End If
If objDictionary.Item(strKey) < lngLowestTagCount Then
lngLowestTagCount = objDictionary.Item(strKey)
End If
Next
dblDiff = (lngHighestTagCount-lngLowestTagCount)
dblStep = (dblDiff-(dblDiff/7))/5
dblOffset = dblDiff/14
dblBorder1 = lngLowestTagCount+(dblstep*0)+dblOffset
dblBorder2 = lngLowestTagCount+(dblstep*1)+dblOffset
dblBorder3 = lngLowestTagCount+(dblstep*2)+dblOffset
dblBorder4 = lngHighestTagCount-(dblstep*2)-dblOffset
dblBorder5 = lngHighestTagCount-(dblstep*1)-dblOffset
dblBorder6 = lngHighestTagCount-(dblstep*0)-dblOffset
For Each strKey in colKeys
If objDictionary.Item(strKey) < dblBorder1 Then
objDictionary.Item(strKey) = strStyleSize1
ElseIf objDictionary.Item(strKey) > dblBorder1 And _
objDictionary.Item(strKey) < dblBorder2 Then
objDictionary.Item(strKey) = strStyleSize2
ElseIf objDictionary.Item(strKey) > dblBorder2 And _
objDictionary.Item(strKey) < dblBorder3 Then
objDictionary.Item(strKey) = strStyleSize3
ElseIf objDictionary.Item(strKey) > dblBorder3 And _
objDictionary.Item(strKey) < dblBorder4 Then
objDictionary.Item(strKey) = strStyleSize4
ElseIf objDictionary.Item(strKey) > dblBorder4 And _
objDictionary.Item(strKey) < dblBorder5 Then
objDictionary.Item(strKey) = strStyleSize5
ElseIf objDictionary.Item(strKey) > dblBorder5 And _
objDictionary.Item(strKey) < dblBorder6 Then
objDictionary.Item(strKey) = strStyleSize6
ElseIf objDictionary.Item(strKey) > dblBorder6 Then
objDictionary.Item(strKey) = strStyleSize7
End If
Next
For Each strKey in colKeys
strReturn = strReturn & "<a href=""" & strUrlPrefix & _
strKey & """ style=""" & objDictionary.Item(strKey) & _
""">" & strKey & "</a> " & vbcrlf
Next
Set objDictionary = Nothing
GenerateTagCloud = strReturn
End Function
Dim strReturn
Dim strUrlPrefix
Dim intLoop
Dim objDictionary
Dim strTag
Dim colKeys
Dim strKey
Dim strStyleSize1
Dim strStyleSize2
Dim strStyleSize3
Dim strStyleSize4
Dim strStyleSize5
Dim strStyleSize6
Dim strStyleSize7
Dim lngHighestTagCount
Dim lngLowestTagCount
Dim dblDiff
Dim dblStep
Dim dblOffset
Dim dblBorder1
Dim dblBorder2
Dim dblBorder3
Dim dblBorder4
Dim dblBorder5
Dim dblBorder6
strUrlPrefix = "/?"
strStyleSize1 = "font-size: 9px;"
strStyleSize2 = "font-size: 10px;"
strStyleSize3 = "font-size: 12px;"
strStyleSize4 = "font-size: 14px;"
strStyleSize5 = "font-size: 14px; font-weight: bold;"
strStyleSize6 = "font-size: 16px; font-weight: bold;"
strStyleSize7 = "font-size: 18px; font-weight: bold;"
Set objDictionary = Server.CreateObject("Scripting.Dictionary")
For intLoop = 0 to Ubound(arrAllTags)
strTag = arrAllTags(intLoop)
If objDictionary.Exists(strTag) = True Then
objDictionary.Item(strTag) = objDictionary.Item(strTag) + 1
Else
objDictionary.Add strTag, 1
End If
Next
lngHighestTagCount = 1
lngLowestTagCount = 2147483647
colKeys = objDictionary.Keys
For Each strKey in colKeys
If objDictionary.Item(strKey) > lngHighestTagCount Then
lngHighestTagCount = objDictionary.Item(strKey)
End If
If objDictionary.Item(strKey) < lngLowestTagCount Then
lngLowestTagCount = objDictionary.Item(strKey)
End If
Next
dblDiff = (lngHighestTagCount-lngLowestTagCount)
dblStep = (dblDiff-(dblDiff/7))/5
dblOffset = dblDiff/14
dblBorder1 = lngLowestTagCount+(dblstep*0)+dblOffset
dblBorder2 = lngLowestTagCount+(dblstep*1)+dblOffset
dblBorder3 = lngLowestTagCount+(dblstep*2)+dblOffset
dblBorder4 = lngHighestTagCount-(dblstep*2)-dblOffset
dblBorder5 = lngHighestTagCount-(dblstep*1)-dblOffset
dblBorder6 = lngHighestTagCount-(dblstep*0)-dblOffset
For Each strKey in colKeys
If objDictionary.Item(strKey) < dblBorder1 Then
objDictionary.Item(strKey) = strStyleSize1
ElseIf objDictionary.Item(strKey) > dblBorder1 And _
objDictionary.Item(strKey) < dblBorder2 Then
objDictionary.Item(strKey) = strStyleSize2
ElseIf objDictionary.Item(strKey) > dblBorder2 And _
objDictionary.Item(strKey) < dblBorder3 Then
objDictionary.Item(strKey) = strStyleSize3
ElseIf objDictionary.Item(strKey) > dblBorder3 And _
objDictionary.Item(strKey) < dblBorder4 Then
objDictionary.Item(strKey) = strStyleSize4
ElseIf objDictionary.Item(strKey) > dblBorder4 And _
objDictionary.Item(strKey) < dblBorder5 Then
objDictionary.Item(strKey) = strStyleSize5
ElseIf objDictionary.Item(strKey) > dblBorder5 And _
objDictionary.Item(strKey) < dblBorder6 Then
objDictionary.Item(strKey) = strStyleSize6
ElseIf objDictionary.Item(strKey) > dblBorder6 Then
objDictionary.Item(strKey) = strStyleSize7
End If
Next
For Each strKey in colKeys
strReturn = strReturn & "<a href=""" & strUrlPrefix & _
strKey & """ style=""" & objDictionary.Item(strKey) & _
""">" & strKey & "</a> " & vbcrlf
Next
Set objDictionary = Nothing
GenerateTagCloud = strReturn
End Function
When run with the tags on this site as input, the output looks like this:
dotnet bicycle vbscript diy aspnet utilities photography japan html copenhagen torpedo asp javascript databases ajax denmark
Tags: asp
Page last updated 2009-04-10 20:37. Some rights reserved (CC by 3.0)