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
      objDictionary.Add strTag, 1
    End If
  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
  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
  For Each strKey in colKeys
    strReturn = strReturn & "<a href=""" & strUrlPrefix & _
      strKey & """ style=""" & objDictionary.Item(strKey) & _
      """>" & strKey & "</a> " & vbcrlf
  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)