Solved

Multi-dimesional array sort?

Posted on 2006-06-14
21
601 Views
Last Modified: 2008-02-01
please see this question:
http://www.experts-exchange.com/Web/Web_Languages/ASP/Q_21885888.html

what's been built is a drop-down list of a hierarchal category table structured like this:

tableName
icID   <-INT(4) IDENTITY
parentID  <-INT(4)
invCat  <-NVARCHAR(50)

and it builds the drop-down here:http://test.apenloversparadise.com/untitled.asp

the code is:
<%
Sub write(strString)
      response.write(strString)
End Sub
function getparent(parid)
      if parid > 0 then
            set rs=createobject("adodb.recordset")
                  query = "select parentID, invCat from invCat where icID = " & parid & " ORDER BY invCat"
                  rs.open query, cn
                        getparent = getparent(rs("parentID")) & rs("invCat") & " - "
                  rs.close
            set rs=nothing
      end if
end function

set cn=createobject("adodb.connection")
cn.open inrsConn
sRecords = "SELECT * FROM invCat"
       Set r = cn.Execute(sRecords)
              write "<select name='cat'>"
              Do While Not r.EOF
                     Write "<option value=""" & r.Fields("icID") & """>" & getparent(r("parentID")) & r("invCat") & "</option>"
                     r.MoveNext
              Loop
              write "</select>"
       set r=nothing
cn.close
set cn=nothing
%>

now what I need to do is get it to sort by the 'ultimate' parent category name.  It was mentioned to me that I should put it into a multi-dimensional array, and use the sorting method in that.....I do not know how to do this though...
0
Comment
Question by:kevp75
  • 10
  • 6
  • 5
21 Comments
 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 16904884
I have seen a few options out there, particularly one called QSort. This is what I have come up with (it is still in rough shpae, this is just an idea that I was thinking about):



sub sortArray(byRef arrToSort, strSortIndexes, strSortOrders)
      'created October 2005
      'arrToSort is the 2D array that you want to sort
      'strSortIndexes are the array indexes that you want to sort by, for example 0,2,1
      'strSortOrders is how you want to sort the columns--for example "Asc,Asc,Desc"
      Const adDouble = 5
      Const adVarChar = 200
      Const adDate = 7

      'create recordset to sort array
      dim objRS_ArrSorter
      Set objRS_ArrSorter = Server.CreateObject("ADODB.Recordset")
      for i = 0  to UBound(arrToSort,2)-1
            strFieldName="fldField_" & i
            if isNumeric(arrToSort(0,i)) then
                  objRS_ArrSorter.Fields.Append strFieldName, adDouble
            elseif isDate(arrToSort(0,i)) then
                  objRS_ArrSorter.Fields.Append strFieldName, adDate
            else
                  objRS_ArrSorter.Fields.Append strFieldName, adVarChar, 255
            end if
      next
      objRS_ArrSorter.Open

      'populate recordset from array
      for i=0 to UBound(arrToSort,1)-1
            objRS_ArrSorter.AddNew
            for j=0 to UBound(arrToSort,2)-1
                  if arrToSort(i,j) <>"" and not isNull(arrToSort(i,j)) and not isEmpty(arrToSort(i,j)) then
                        objRS_ArrSorter.Fields(j).value = arrToSort(i,j)
                  else
                        objRS_ArrSorter.Fields(j).value = ""
                  end if
            next
      next

      'sort it
      arrSortIndexes = Split(strSortIndexes, ",")
      arrSortOrders = Split(strSortOrders,",")
      strSortString = ""
      for i=0 to UBound(arrSortIndexes)
            strSortString = strSortString & "fldField_" & arrSortIndexes(i) & " " & arrSortOrders(i) & ", "
      next
      strSortString = Left(strSortString,Len(strSortString)-2)
      objRS_ArrSorter.sort = strSortString

      'put the sorted data back into the array
      objRS_ArrSorter.MoveFirst()
'      arrItemsCount = objRS_ArrSorter.GetRows()
      intRecord = 0
      do while not objRS_ArrSorter.eof
            for i=0 to objRS_ArrSorter.Fields.Count -1
                  arrToSort(intRecord,i) = objRS_ArrSorter.Fields(i).value
            next
            objRS_ArrSorter.MoveNext
            intRecord = intRecord +1
      loop
       'clean up objects
      objRS_ArrSorter.Close()
      Set objRS_ArrSorter = Nothing
end sub

FtB
0
 
LVL 25

Author Comment

by:kevp75
ID: 16905074
nice one fritz...

how can I implement this in the code I posted in the question?
0
 
LVL 25

Accepted Solution

by:
clockwatcher earned 500 total points
ID: 16908802
Looks like you guys put a fair amount of work into it, but personally, I would have gone with something more like:


example.asp
--------------

<% option explicit %>

<script language="javascript" runat="server">
 
function jssort(a)
{
   return (new VBArray(a)).toArray().sort().join(String.fromCharCode(0));
}

</script>

<%
class invcat
 
   dim id, category, parentid, description

end class

class invcats

   dim cats
   dim sortindex()  'holds sorted key index

   sub class_initialize
        set cats = server.createobject("Scripting.Dictionary")
   end sub

   sub class_terminate
        set cats = nothing
   end sub

   sub BuildFromDB(connstr)
       LoadFromDB connstr
       SetLabels
       BuildSortIndex
   end sub

   sub BuildFromArray(array)
       LoadFromArray array
       SetLabels
       BuildSortIndex
   end sub

   sub LoadFromArray(a)

       dim i,n,line,cat
       for i = lbound(a) to ubound(a)
            line = split(a(i),"^")
            set cat = new invcat
            cat.id = line(0)
            cat.parentid = line(1)
            cat.category = line(2)
            cats.add cat.id, cat
       next

   end sub

   sub LoadFromDB(conn)
        dim rs, cat
        set rs = server.createobject("ADODB.Recordset")
        rs.open "select icID, parentID, invCat from invCat", conn
        do while not rs.eof
            set cat = new invcat
            cat.id = rs("icID")
            cat.parentid = rs("parentID")
            cat.category = rs("invCat")
            cats.add cat.id, cat
            rs.movenext
        loop
        rs.close
        set rs = nothing
   end sub

   sub SetLabels
      dim i
      for each i in cats.keys
          cats(i).description = mid(BuildLabel(i),4)
      next
   end sub

   function BuildLabel(id)  
       if id = 0 then
          BuildLabel = ""
          exit function
       else
          dim curcat
          set curcat = cats(id)
          BuildLabel = BuildLabel(curcat.parentid) & " - " & curcat.category
       end if
   end function

   sub BuildSortIndex
       dim key,descripts,desc
       set descripts = server.createobject("Scripting.Dictionary")
       for each key in cats.keys
           desc = cats(key).description
           if descripts.exists(desc) then
              descripts(desc) = descripts(desc) & "|" & key
           else
              descripts(desc) = key
           end if
       next
       
       dim sorted
       sorted = split(jssort(descripts.keys), chr(0))

       dim i,n,keys,index
       index = 0
       redim sortindex(cats.count - 1)
       for i = lbound(sorted) to ubound(sorted)
           keys = split(descripts(sorted(i)), "|")
           for n = lbound(keys) to ubound(keys)
              sortindex(index) = keys(n)
              index = index + 1
           next
       next

   end sub

   
   function SelectBox
        dim i,out,cat
        out = "<select name=""cat"">" & vbcrlf
        for i = lbound(sortindex) to ubound(sortindex)
           if cats.exists(sortindex(i)) then
             set cat = cats(sortindex(i))
                 out = out & "<option value=""" & cat.id & """>" & cat.description & vbcrlf
         end if
        next
        out = out & "</select>" & vbcrlf
        SelectBox = out
   end function

end class

dim myCats
set myCats = new invcats

' uncomment this to load it from your DB
'myCats.BuildFromDB(inrsConn)

' comment this out
myCats.BuildFromArray(Array(_
   "1^0^Games",_
   "2^0^Music",_
   "3^1^Doom",_
   "4^1^Quake",_
   "5^2^White Zombie",_
   "6^5^Albums",_
   "7^5^Lyrics",_
   "8^5^Members",_
   "9^8^Rob Zombie",_
   "10^8^Sean Ysault" ))
%>

<html>
<body>
<form>
<%= myCats.SelectBox %>
</form>
</body>
</html>
0
 
LVL 25

Expert Comment

by:clockwatcher
ID: 16908822
Reminds me how much I dislike vbscript.
0
 
LVL 25

Author Comment

by:kevp75
ID: 16910585
@clockwatcher

works good until I comment out the array, and un-comment the myCats.BuildFromDB
all I get is a blank drop-down with nothing in it
0
 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 16911451
@Clockwatcher--

I thought about using the JScript option, but I understood that to be for single diminsion arrays only.

@Kevp75--

I would have to know what WMIF had in mind. A few things suggest themselves to me:

1) use the ParentID as a parameter in the SQL Select?
2) Use the RecordSet.Filter() method


I need to know a little more. I'll reread your other questions.

FtB
0
 
LVL 25

Author Comment

by:kevp75
ID: 16911512
@fritz
clockwatchers works great for the array provided, however when I comment out and un-comment (like shown in his code)  all I get is a blank drop-down

kk...i'll be here  :)
0
 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 16911580
Would you please return to your original code at http://test.apenloversparadise.com/untitled.asp so I can see what you get?

FtB
0
 
LVL 25

Author Comment

by:kevp75
ID: 16911684
sorry bout that...refresh please
0
 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 16911685
Also, does this not work?

strSQL = "SELECT catID. ParentID, CatName FROM tblYourTable ORDER BY ParentID, catID"
set objRS = Server.CreateObject("ADODB.RecordSet")
objRS.Open strSQL,cn,3,3


do while not objRS.EOF
   response.write("<option value=""" & objRS("catID") & "">" & objRS("invCat") & objRS("invCat") & "</option">
  objRS.MoveNext
loop

FtB
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 25

Author Comment

by:kevp75
ID: 16911780
all that would display is something like this:

<option>CrossCross</option>

and would not display the hierarchy of categories, if you scroll the top drop-down to right around the bottom you'll see what I mean by hierarchy
0
 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 16911848
Sorry, I confused the parent category with the sub category.

tableName
icID   <-INT(4) IDENTITY
parentID  <-INT(4)
invCat  <-NVARCHAR(50)

invCat is the name of the parent category. What is the name of the other field within the category? If the two fields are different, then I have an idea.

FtB
0
 
LVL 25

Author Comment

by:kevp75
ID: 16911884
there is no other fields, there's the records ID, then parent categories ID, and the category name

parentID relates to icID.

please look at the recordset under the drop dows, you'll catch the relationships
0
 
LVL 25

Expert Comment

by:clockwatcher
ID: 16912026
Can you put that particular table in an access database and post it somewhere?  The only code that deals with the database in my post is the LoadFromDB method and glancing I don't see anything wrong with it.  Can you modify it to this and post the results?

  sub LoadFromDB(conn)
        dim rs, cat
        set rs = server.createobject("ADODB.Recordset")
        rs.open "select icID, parentID, invCat from invCat", conn
        response.write "recordset opened<BR>"
        do while not rs.eof
            set cat = new invcat
            cat.id = rs("icID")
            cat.parentid = rs("parentID")
            cat.category = rs("invCat")
            cats.add cat.id, cat
            response.write "Added: " & cat.id & "|" & cat.parentid & "|" & cat.category & "<BR>"
            rs.movenext
        loop
        rs.close
        set rs = nothing
   end sub
0
 
LVL 25

Expert Comment

by:clockwatcher
ID: 16912270
Okay... it's a problem with types.  Change these two methods:

   sub LoadFromDB(conn)
        dim rs, cat
        set rs = server.createobject("ADODB.Recordset")
        rs.open "select icID, parentID, invCat from invCat", conn
        do while not rs.eof
            set cat = new invcat
            cat.id = rs("icID")
            cat.parentid = rs("parentID")
            cat.category = rs("invCat")
            cats.add clng(cat.id), cat
            rs.movenext
        loop
        rs.close
        set rs = nothing
   end sub

And

  function SelectBox
        dim i,out,cat
        out = "<select name=""cat"">" & vbcrlf
        for i = lbound(sortindex) to ubound(sortindex)
           if cats.exists(clng(sortindex(i))) then
           set cat = cats(clng(sortindex(i)))
                out = out & "<option value=""" & cat.id & """>" & cat.description & vbcrlf
        end if
        next
        out = out & "</select>" & vbcrlf
        SelectBox = out
   end function


And let me know.

0
 
LVL 25

Author Comment

by:kevp75
ID: 16912443
odd...it works like it should on the test link, however on the production page, it gets outta whack
0
 
LVL 25

Author Comment

by:kevp75
ID: 16912534
nevermind...got it
I just had it in the wrong place...thank you very much!
0
 
LVL 25

Expert Comment

by:clockwatcher
ID: 16912636
Cool... sorry about the first post with the wrong types.  Didn't feel like creating a database table to test it.  Getting lazy in my old age-- and unless you're 100% positive the database will never go wacky, the BuildLabel method should really have an infinite recursion check.  If you're worried about that let me know and I'll add the couple of lines to take care of it.
0
 
LVL 25

Author Comment

by:kevp75
ID: 16912900
actually it works out just great, so far (in production I've only got 4 levels, but I don't see it going any further than that)

thanks again clockwatcher
0
 
LVL 25

Author Comment

by:kevp75
ID: 17216897
@clockwatcher

I'm wondering if you may be able to answer this  (here, or would you like a new question?  :) )


how can I add another value in:
sub LoadFromDB(conn)
        dim rs, cat
        set rs = server.createobject("ADODB.Recordset")
        rs.open "select icID, parentID, invCat from invCat", conn
        do while not rs.eof
            set cat = new invcat
            cat.id = rs("icID")
            cat.parentid = rs("parentID")
            cat.category = rs("invCat")
            cats.add clng(cat.id), cat
            rs.movenext
        loop
        rs.close
        set rs = nothing
   end sub

basically what I'm trying to do now is have a default selected value based on a querystring....so, say I pass pCat=12 to the page this is implemented in, it'll automatically select the correct category.

I've tried, well....have a look at this question:
http://www.experts-exchange.com/Web/Web_Languages/ASP/Q_21924766.html
0
 
LVL 46

Expert Comment

by:fritz_the_blank
ID: 17217037
That what my code does, and that is why--as clockwatcher points out--I put a lot of work into it.

If you care to understand how it all works, read my article on the subject:  www.fairfieldconsulting.com/codecorner.asp

ftB
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

I recently decide that I needed a way to make my pages scream on the net.   While searching around how I can accomplish this I stumbled across a great article that stated "minimize the server requests." I got to thinking, hey, I use more than one…
I have helped a lot of people on EE with their coding sources and have enjoyed near about every minute of it. Sometimes it can get a little tedious but it is always a challenge and the one thing that I always say is:  The Exchange of information …
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now