[LON-CAPA-cvs] cvs: rat / map.pm

[albertel]

albertel		Fri Nov 30 22:07:39 2007 EDT

  Modified files:              
    /rat	map.pm 
  Log:
  - the existing map flattening was very slow this preserves most orderings while be much much faster
  
  
Index: rat/map.pm
diff -u rat/map.pm:1.9 rat/map.pm:1.10
--- rat/map.pm:1.9	Fri Nov 30 20:59:54 2007
+++ rat/map.pm	Fri Nov 30 22:07:39 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # routines for modyfing .sequence and .page files
 #
-# $Id: map.pm,v 1.9 2007/12/01 01:59:54 albertel Exp $
+# $Id: map.pm,v 1.10 2007/12/01 03:07:39 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -27,7 +27,7 @@
 #
 
 package LONCAPA::map;
-
+use strict;
 use HTML::TokeParser;
 use HTML::Entities();
 use Apache::lonnet;
@@ -154,94 +154,65 @@
     if ($errtext) { return @theseres }
 
 # -------------------------------------------------------------------- Read map
+    my ($start,$finish);
     foreach (split(/\<\&\>/,$outtext)) {
 	my ($command,$number,$content)=split(/\<\:\>/,$_);
         if ($command eq 'objcont') {
-	    my ($title,$src,$ext,$type)=split(/\:/,$content);
-	    unless ($type eq 'zombie') {
+	    my ($title,$src,$ext,$type)=split(/\:/,$content);	    
+	    if ($type ne 'zombie' && $ext ne 'cond') {
 		$theseres[$number]=$content;
 	    }
+	    if ($type eq 'start') {
+		$start = $number;
+	    }
+	    if ($type eq 'finish') {
+		$finish = $number;
+	    }
         }
         if ($command eq 'objlinks') {
             $links[$number]=$content;
         }
     }
     if ($unsorted) {
-       return @theseres;
+	return @theseres;
     }
 
-# --------------------------------------------------------------- Sort, sort of
-
-    my @objsort;
+# ---------------------------- attempt to flatten the map into a 'sorted' order
 
-    for (my $k=1;$k<=$#theseres;$k++) {
-	if (defined($theseres[$k])) {
-	    $objsort[$#objsort+1]=$k;
-	}
-    }
+    my %path_length = ($start => 0);
+    my @todo = @links;
 
-    for (my $k=1;$k<=$#links;$k++) {
-	if (defined($links[$k])) {
-	    my @data1=split(/\:/,$links[$k]);
-	    my $kj=-1;
-	    for (my $j=0;$j<=$#objsort;$j++) {
-		if ((split(/\:/,$objsort[$j]))[0]==$data1[0]) {
-		    $kj=$j;
-		}
-	    }
-	    if ($kj!=-1) { $objsort[$kj].=':'.$data1[1]; }
-	}
-    }
-    for (my $k=0;$k<=$#objsort;$k++) {
-	for (my $j=0;$j<=$#objsort;$j++) {
-	    if ($k!=$j) {
-		my @data1=split(/\:/,$objsort[$k]);
-		my @data2=split(/\:/,$objsort[$j]);
-		my $dol=$#data1+1;
-		my $dtl=$#data2+1;
-		if ($dol+$dtl<1000) {
-		    for (my $kj=1;$kj<$dol;$kj++) {
-			if ($data1[$kj]==$data2[0]) {
-			    for ($ij=1;$ij<$dtl;$ij++) {
-				$data1[$#data1+1]=$data2[$ij];
-			    }
-			}
-		    }
-		    for (my $kj=1;$kj<$dtl;$kj++) {
-			if ($data2[$kj]==$data1[0]) {
-			    for ($ij=1;$ij<$dol;$ij++) {
-				$data2[$#data2+1]=$data1[$ij];
-			    }
-			}
-		    }
-		    $objsort[$k]=join(':',@data1);
-		    $objsort[$j]=join(':',@data2);
-		}
-	    }
-	} 
+    while (@todo) {
+	my $link = shift(@todo);
+	next if (!defined($link));
+	my ($from,$to) = split(':',$link);
+	if (!exists($path_length{$from})) {
+	    # don't know how long it takes to get to this link,
+	    # save away to retry
+	    push(@todo,$link);
+	    next;
+	}
+	# already have a length, keep it
+	next if (exists($path_length{$to}));
+	$path_length{$to}=$path_length{$from}+1;
+    }
+    # invert hash so we have the ids in depth order now
+    my @by_depth;
+    while (my ($key,$value) = each(%path_length)) {
+	push(@{$by_depth[$value]},$key);
     }
-# ---------------------------------------------------------------- Now sort out
-
-    @objsort=sort {
-	my @data1=split(/\:/,$a);
-	my @data2=split(/\:/,$b);
-	my $rvalue=0;
-	for (my $k=1;$k<=$#data1;$k++) {
-	    if ($data1[$k]==$data2[0]) { $rvalue--; }
-	}
-	for (my $k=1;$k<=$#data2;$k++) {
-	    if ($data2[$k]==$data1[0]) { $rvalue++; }
-	}
-	if ($rvalue==0) { $rvalue=$#data2-$#data1; }
-	$rvalue;
-    } @objsort;
-
+    # reorder resources
     my @outres;
-
-    for ($k=0;$k<=$#objsort;$k++) {
-	$outres[$k]=$theseres[(split(/\:/,$objsort[$k]))[0]];
+    foreach my $ids_at_depth (@by_depth) {
+	foreach my $id (sort(@{$ids_at_depth})) {
+	    # skip the finish resource
+	    next if ($id == $finish);
+	    push(@outres, $theseres[$id]);
+	}
     }
-
+    # make sure finish is last (in case there are cycles or bypass routes
+    # finish can end up with a rather short possible path)
+    push(@outres, $theseres[$finish]);
     return @outres;
 }