另类无限级分类思考

前段时间尝试了几种不同的无限级分类算法,感觉各有优劣,至少,我的实现上还不完美.

下面是一些无限级分类要点的思考:

分类功能细节实现

1.添加
2.删除
3.排序
4.遍历树
5.子节点查询
6.父节点查询
7.层级查询
8.内容查询(仅该分类)
9.内容查询(该分类及所有子分类) 
分类思路总结: 
一.
id(自增) pid(int) name(text) [sort](int)
适用简单分类,2-3级

辅助xml缓存,可以改进较多,但内容查询始终是瓶颈,或者可以改变下内容区的关联格式

二.
id(自增) pid(int) path(text) name(text) [sort](int)
适合较复杂分类.
如果追求效率,需要在内容表插入path字段,否则查询多个子分类时容易引起遍历麻烦
对path字段索引,使用字符串包含查询

三.
id(bigint) name(text) [sort](int)
需要预先在程序内设定分层级别,每层数量,各层掩码(二种掩码)
虽然麻烦些,优点是查询方便,管理方便
可以方便了解当前层最大可有多少个分类,达到最高层或最多分类时方便提示

简单示例(3层*3个分类)
010000(16) 分类
010100(20) 子分类1
010101(21) 子子分类1
010110(22) 子子分类2
100000(32) 分类2
100100(36) 子分类2
100101(37) 子子分类3

查询方便,但方便得不彻底(需要借助掩码)

四.左右编码值树型结构
[id](int) name(text) left(int) right(int)
插入,排序,删除都会影响比较多的分类
可以快速算出所有子分类数目((right-left-1)/2) 
编码示例
 1商品18
 +---------------------------------------+
 2食品11                              12电器17
 +-----------------+                     +---------------------+
 3肉类6          7蔬菜类10 13电视机14 15电冰箱16
 4猪肉5           8白菜9

之前写了套asp企业网站程序,最不满意的地方就是频道和分类的规划方式,所以,要改版,首要就是改这个.

要把频道和分类做在一个表里,分类可以外链,可以绑定不同的模块,这个分类的实现方式又令我犯难.

左右值我不喜欢的是后期改动会影响到内容表数据,也会影响到分类id参数,所以,可能会引起文章地址变动,这对用户和搜索引擎都不够友好.

位运算的方法实现还是比较合适的,但分类id关系不够直观,需要对不同的层级和数目要求改动.

于是想到了简单算法加上xml缓存来实现这个功能.

程序初始化时判断xml对象是否已经缓存在application中

 

If Not IsObject(Application(APPSN & "cate")) Then
	Application.Lock()
	Set Application(APPSN & "cate")=CreateThreedXML(Apppath & CONFIG_PATH & "cate.xml")
	Application.UnLock()
End If
Set catedom=Application(APPSN & "cate")

Function CreateThreedXML(sPath)
	Dim xml
	Set xml=Server.CREATEOBJECT("MSXML2.FreeThreadedDOMDocument.3.0")
	xml.async = False
	If Not xml.Load(Server.MapPath(sPath)) Then
		xml.LoadXML("<?xml version=""1.0"" encoding=""UTF-8""?><root />")
		xml.Save Server.MapPath(sPath)
	End If
	
	Set CreateThreedXML=xml
End Function
分类的设置还是存放在一个数据表里,有改动时重新读取数据表内容,生成dom树,保存在文件里

 

 

	Private Sub Makecate
		Dim rs,Node, field
		sql.Field("*")
		sql.where(Array("$p$pid=0"))
		sql.order(Array("sort asc","id asc"))
		Set rs=sql.CreateSQL("select",True)
		For Each Node In cate.documentElement.childNodes
			cate.documentElement.removeChild(Node)
		Next
		Do Until rs.EOF
			Set Node=cate.documentElement.AppendChild(cate.CreateElement("cate"))
			For Each Field In rs.Fields
				Node.setAttribute Field.Name,Field.Value&""
			Next
			Makesubcate rs("id").Value,Node
			rs.MoveNext
		Loop
		rs.Close
		cate.Save Server.MapPath(path)
		Application.Lock()
		Set Application(APPSN & "cate")=cate
		Application.UnLock()
		Set rs=Nothing
	End Sub
	
	Private Sub Makesubcate(pid,node)
		Dim rs, sNode, Field
		sql.where(Array("$p$pid="& pid))
		Set rs=sql.CreateSQL("select",True)
		Do Until rs.EOF
			Set sNode=Node.AppendChild(cate.CreateElement("cate"))
			For Each Field In rs.Fields
				sNode.setAttribute Field.Name,Field.Value&""
			Next
			Makesubcate rs("id").Value,sNode
			rs.MoveNext
		Loop
		rs.Close
		Set rs=Nothing
	End Sub
这里用到了其实模块的一些方法,不过思路应该很明确.

 

生成之后将application缓存也更新.

下面是内容管理页面的分类管理链接和选择框的分类树生成

Class cClass
	Private cate
	Public	treestr, linkstr
	
	Public pid
	
	Private Sub Class_Initialize
		treestr	= "<option value=""$0$"" $2$ >$1$</option>"
		linkstr	= "<a href=""?pid=$0$"" $2$>$1$</a>"
		Set cate= Application(APPSN & "cate")
	End Sub
	
	Private Sub Class_Terminate
		Set cate= Nothing
	End Sub
	
	Public Function ClassTree(ByVal sid, m)
		Dim cates, eStr, i, dStr
		Set cates=cate.selectNodes("/root/cate[@model='"& m &"']")
		If cates.length=0 Then
			eStr	= tree(Array(0,"没有分类",""))
		Else
			For i=0 To cates.length-1
				If cates(i).getAttribute("id")=sid Then dStr=" selected=""selected"" " Else dStr=""
				eStr	= eStr & tree(Array(cates(i).getAttribute("id"),cates(i).getAttribute(LANG_DEFAULT&"name"),dStr)) & SubTree(1,cates(i),sid)
			Next
		End If
		ClassTree=eStr
	End Function
	
	Private Function SubTree(ByVal level, pNode, sid)
		Dim rStr, dStr, Node
		For Each Node In pNode.childNodes
			If Node.getAttribute("id")=sid Then dStr=" Selected=""selected"" " Else dStr=""
			If level>0 Then
				rStr	= rStr & tree(Array(Node.getAttribute("id"),String(level-1,"║") &"╠"& Node.getAttribute(LANG_DEFAULT&"name"),dStr))
			Else
				rStr	= rStr & tree(Array(Node.getAttribute("id"),Node.getAttribute(LANG_DEFAULT&"name"),dStr))
			End If
			rStr	= rStr & SubTree(level+1, Node, sid)
		Next
		SubTree=rStr
	End Function
	
	Public Function LinkTree(ByVal sid, m)
		Dim cates, eStr, i, pNode
		If sid=0 Or sid="" Or IsNull(sid) Then
			eStr	= SubLink(cate.documentElement, sid, m)
		Else
			Set cates=cate.selectSingleNode("//cate[@id='"& sid &"' and @model='"& m &"']")
			If cates Is Nothing Then
				alertBack "分类不存在!"
			Else
				eStr	= SubLink(cates, 0, m)
				Set pNode=cates.parentNode
				If pNode.nodeName="cate" Then
					Do
						eStr	=  SubLink(pNode, cates.getAttribute("id"), m) & eStr
						Set cates=pNode
						Set pNode=cates.parentNode
					Loop Until pNode.nodeName="root"
				End If
				eStr	=  SubLink(pNode, cates.getAttribute("id"), m) & eStr
			End If
		End If
		If eStr="" Then alertBack "该模块还没有分类,请先至频道管理添加分类"
		LinkTree=eStr
	End Function
	
	Private Function SubLink( pNode, sid, m)
		Dim rStr, dStr, Node
		For Each Node In pNode.childNodes
			If Int(Node.getAttribute("model")) = m Then
				If Node.getAttribute("id")=sid Then dStr=" class=""active"" " Else dStr=""
				rStr	= rStr & Link(Array(Node.getAttribute("id"),Node.getAttribute(LANG_DEFAULT&"name"),dStr))
			End If
		Next
		If rStr<>"" Then rStr	= "<p>"& rStr &"</p>"
		SubLink=rStr
	End Function
	
	Public Function getArr()
		Set cates=cate.selectSingleNode("//cate[@id='"& sid &"' and @model='"& m &"']")
	End Function
	
	Private Function Link(aArr)
		Dim temp
		temp=linkstr
		For i=0 To Ubound(aArr)
			temp=replace(temp,"$"& i &"$",aArr(i))
		Next
		Link=temp
	End Function
	
	Private Function tree(aArr)
		Dim temp
		temp=treestr
		For i=0 To Ubound(aArr)
			temp=replace(temp,"$"& i &"$",aArr(i))
		Next
		tree=temp
	End Function
	
End Class

'使用方法,pid表分类id,cid是文章的分类id,生成后自动选择到该项,1是模块编号
'<%=(New cClass).LinkTree( pid, 1 )%>
'<%= (New cClass).ClassTree(cid, 1)%>