Improve column output performances

Improve the performance of the module’s column output by removing the
costly optimization that attempts to fit more columns within the
available screen width.

As a result in some situations, module list or module avail may now have
an output a little less dense. This new grid output is exactly the same
as the one from the "ls" command.

Output performances are clearly improved. On "avail4" test case of
script/mb utility, a "module avail" over 962 modulefiles takes 47 ms
instead of 73 ms (-35% elapsed time).

Closes #622

Signed-off-by: Xavier Delaruelle <xavier.delaruelle@cea.fr>

Author: xdelaruelle

NEWS.rst

@@ -70,6 +70,9 @@ Modules 5.7.0 (not yet released)
   :mconfig:`non_exportable_tags` is changed with :subcmd:`config` sub-command,
   it sets the :envvar:`MODULES_NON_EXPORTABLE_TAGS` environment variable. (fix
   issue #608)
+* Improve the performance of the module’s column output by removing the costly
+  optimization that attempts to fit more columns within the available screen
+  width. (fix issue #622)
 
 
 .. _5.6 release notes:

tcl/report.tcl.in

@@ -1590,7 +1590,6 @@ proc reportModules {search_queries header hsgrkey hstyle show_mtime show_idx\
    }
 
    set len_list {}
-   set max_len 0
    # dictionary-sort results unless if output order is specified
    if {![llength $mod_list_order]} {
       set clean_list [lsort -dictionary $clean_list]
@@ -1607,9 +1606,6 @@ proc reportModules {search_queries header hsgrkey hstyle show_mtime show_idx\
          # compute display element length list on sorted result
          lappend display_list $sgrmap($disp)
          lappend len_list $lenmap($disp)
-         if {$lenmap($disp) > $max_len} {
-            set max_len $lenmap($disp)
-         }
       }
    }
 
@@ -1622,7 +1618,7 @@ proc reportModules {search_queries header hsgrkey hstyle show_mtime show_idx\
 
    # output formatted elements
    displayElementList $header $hsgrkey $hstyle $one_per_line $show_idx 1\
-      $display_list $len_list $max_len $via
+      $display_list $len_list $via
 }
 
 proc showModulePath {} {
@@ -1667,10 +1663,10 @@ proc displaySeparatorLine {{title {}} {sgrkey {}} {extra {}}} {
 # get a list of elements and print them in a column or in a
 # one-per-line fashion
 proc displayElementList {header sgrkey hstyle one_per_line display_idx\
-   start_idx display_list {len_list {}} {max_len 0} {via {}}} {
+   start_idx display_list {len_list {}} {via {}}} {
    set elt_cnt [llength $display_list]
    reportDebug "header=$header, sgrkey=$sgrkey, hstyle=$hstyle,\
-      elt_cnt=$elt_cnt, max_len=$max_len, one_per_line=$one_per_line,\
+      elt_cnt=$elt_cnt, one_per_line=$one_per_line,\
       display_idx=$display_idx, start_idx=$start_idx, via=$via"
 
    # end proc if no element are to print
@@ -1716,97 +1712,10 @@ proc displayElementList {header sgrkey hstyle one_per_line display_idx\
       # save room for numbers and spacing: 2 or 3 digits + ) + space
       set elt_prefix_len [expr {$display_idx ? $idx_len + 2 : {0}}]
       # save room for two spaces after element
-      set elt_suffix_len 2
-
-      # compute rows*cols grid size with optimized column number
-      # the size of each column is computed to display as much column
-      # as possible on each line
-      incr max_len $elt_suffix_len
-      foreach len $len_list {
-         lappend elt_len [incr len $elt_suffix_len]
-      }
-
       set tty_cols [getState term_columns]
-      # find valid grid by starting with non-optimized solution where each
-      # column length is equal to the length of the biggest element to display
-      set cur_cols [tcl::mathfunc::max [expr {int(($tty_cols - \
-         $elt_prefix_len) / $max_len)}] 0]
-      # when display is found too short to display even one column
-      if {$cur_cols == 0} {
-         set cols 1
-         set rows $elt_cnt
-         array set col_width [list 0 $max_len]
-      } else {
-         set cols 0
-         set rows 0
-      }
-      set last_round 0
-      set restart_loop 0
-      while {$cur_cols > $cols} {
-         if {!$restart_loop} {
-            if {$last_round} {
-               incr cur_rows
-            } else {
-               set cur_rows [expr {int(ceil(double($elt_cnt) / $cur_cols))}]
-            }
-            for {set i 0} {$i < $cur_cols} {incr i} {
-               set cur_col_width($i) 0
-            }
-            for {set i 0} {$i < $cur_rows} {incr i} {
-               set row_width($i) 0
-            }
-            set istart 0
-         } else {
-            ##nagelfar ignore Unknown variable
-            set istart [expr {$col * $cur_rows}]
-            # only remove width of elements from current col
-            for {set row 0} {$row < ($i % $cur_rows)} {incr row} {
-               ##nagelfar ignore Unknown variable
-               incr row_width($row) -[expr {$pre_col_width + $elt_prefix_len}]
-            }
-         }
-         set restart_loop 0
-         for {set i $istart} {$i < $elt_cnt} {incr i} {
-            set col [expr {int($i / $cur_rows)}]
-            set row [expr {$i % $cur_rows}]
-            # restart loop if a column width change
-            if {[lindex $elt_len $i] > $cur_col_width($col)} {
-               set pre_col_width $cur_col_width($col)
-               set cur_col_width($col) [lindex $elt_len $i]
-               set restart_loop 1
-               break
-            }
-            # end search of maximum number of columns if computed row width
-            # is larger than terminal width
-            if {[incr row_width($row) +[expr {$cur_col_width($col) \
-               + $elt_prefix_len}]] > $tty_cols} {
-               # start last optimization pass by increasing row number until
-               # reaching number used for previous column number, by doing so
-               # this number of column may pass in terminal width, if not
-               # fallback to previous number of column
-               if {$last_round && $cur_rows == $rows} {
-                  incr cur_cols -1
-               } else {
-                  set last_round 1
-               }
-               break
-            }
-         }
-         # went through all elements without reaching terminal width limit so
-         # this number of column solution is valid, try next with a greater
-         # column number
-         if {$i == $elt_cnt} {
-            set cols $cur_cols
-            set rows $cur_rows
-            array set col_width [array get cur_col_width]
-            # number of column is fixed if last optimization round has started
-            # reach end also if there is only one row of results
-            if {!$last_round && $rows > 1} {
-               incr cur_cols
-            }
-         }
 
-      }
+      lassign [compute_output_grid $tty_cols $len_list $elt_prefix_len] rows\
+         cols cols_width
       reportDebug list=$display_list
       reportDebug "rows/cols=$rows/$cols,\
          lastcol_item_cnt=[expr {int($elt_cnt % $rows)}]"
@@ -1821,7 +1730,8 @@ proc displayElementList {header sgrkey hstyle one_per_line display_idx\
                }
                # cannot use 'format' as strings may contain SGR codes
                append displist [lindex $display_list $index][string repeat\
-                  { } [expr {$col_width($col) - [lindex $len_list $index]}]]
+                  { } [expr {[lindex $cols_width $col] - [lindex $len_list\
+                  $index] - $elt_prefix_len}]]
             }
          }
          append displist \n
@@ -1834,6 +1744,58 @@ proc displayElementList {header sgrkey hstyle one_per_line display_idx\
    reportSeparateNextContent
 }
 
+# returns rows, cols and each col width of the output grid with most cols
+proc compute_output_grid {out_width len_list prefix_len} {
+   set col_sepa_len 2
+   set elt_count [llength $len_list]
+   if {!$elt_count} {
+      return {0 0 {0}}
+   }
+
+   # start with max possible columns guessed from shortest element in list
+   set min_len [tcl::mathfunc::min {*}$len_list]
+   set col_min [expr {$prefix_len + $min_len + $col_sepa_len}]
+   # exact same output with 1 elt to print whether width is tiny or large
+   set max_cols [tcl::mathfunc::min $elt_count\
+      [expr {int(floor(double($out_width) / $col_min))}]]
+
+   for {set cols $max_cols} {$cols > 1} {incr cols -1} {
+      set rows [expr {int(ceil(double($elt_count) / $cols))}]
+      set cols_width {}
+
+      # compute width of each column (max length among elements in that col)
+      for {set c 0} {$c < $cols} {incr c} {
+         set idx_first [expr {$c * $rows}]
+         set idx_last [expr {$idx_first + $rows - 1}]
+         # stop when no more element for available columns
+         if {$idx_first >= $elt_count} {
+            break
+         }
+         set col_max [tcl::mathfunc::max {*}[lrange $len_list $idx_first\
+            $idx_last]]
+         set col_width [expr {$prefix_len + $col_max}]
+         # column separator suffix is not added on last column
+         if {($c + 1) < $cols && ($idx_last + 1) < $elt_count} {
+            incr col_width $col_sepa_len
+         }
+         lappend cols_width $col_width
+
+         # immediately try fewer columns if we already exceed output grid
+         if {[tcl::mathop::+ {*}$cols_width] > $out_width} {
+            break
+         }
+      }
+
+      # ff it fits, this is the maximum cols possible
+      if {[tcl::mathop::+ {*}$cols_width] <= $out_width} {
+         return [list $rows $cols $cols_width]
+      }
+   }
+
+   # fits in 1 column
+   return [list $elt_count 1 {0}]
+}
+
 # Report an output key to help understand what the SGR used on this output
 # correspond to
 proc displayKey {} {
@@ -1936,19 +1898,11 @@ proc displayKey {} {
       }
    }
 
-   # find largest element
-   set max_len 0
-   foreach len $len_list {
-      if {$len > $max_len} {
-         set max_len $len
-      }
-   }
-
    if {[llength $display_list]} {
       # display header
       report Key:
       # display key content
-      displayElementList noheader {} {} 0 0 0 $display_list $len_list $max_len
+      displayElementList noheader {} {} 0 0 0 $display_list $len_list
    }
 }
 

tcl/subcmd.tcl.in

@@ -927,7 +927,6 @@ proc cmdModuleSavelist {show_oneperline show_mtime search_match args} {
       }
       set display_list {}
       set len_list {}
-      set max_len 0
       set one_per_line [expr {$show_mtime || $show_oneperline}]
       set show_idx [expr {!$one_per_line}]
       # prepare query to highlight
@@ -948,15 +947,12 @@ proc cmdModuleSavelist {show_oneperline show_mtime search_match args} {
             } else {
                lappend display_list $collsgr
                lappend len_list [set len [string length $coll]]
-               if {$len > $max_len} {
-                  set max_len $len
-               }
             }
          }
       }
 
       displayElementList noheader {} {} $one_per_line $show_idx $start_idx\
-         $display_list $len_list $max_len
+         $display_list $len_list
    }
 }
 

testsuite/example/siteconfig.tcl-1

@@ -44,15 +44,11 @@ if {[info exists env(TESTSUITE_ENABLE_SITECONFIG_TRICKYLISTDISP)]} {
    # set a specific terminal column number to fall in tricky condition
    set orig_term_columns [getState term_columns]
    setState term_columns 80
-   set max_len 0
    foreach elt [list abc/def abcdefgh/ijklmnop abc/defg abcd/ef abc/defg-hijkl.mn.op abcdefgh/ijklm.nopqrst abcdefg/hijklmnop-qr.st.uvw abcdefgh/ijklmnopqrst-u-vwxy.zA-BCD-E abcdef/ghijklm-nopq.r_st.uv abcdefgh/ijklmnop-q-rstu.vw-xyz-A abcdefg/hijklmn-op.qr.stu abcdefg/hijkl-mn.op.qrs abcd/efgh-ij.k abcdefg/hijk-lmnop_qr.st.uvw abcdef/ghijklmno-p.q.r abcdefgh/ijklmn-o-pqrs.tu abcdefgh/ijklmnop-q-rstu.vw-xyz abcdefg/hij-klm.nopq abcdefg/hij-kl.mn.opq abcdefgh/ijklmnopq_rstuv-w-xyzA.BC-DEF abcdefgh/ijklmnopqrstuv-w-xyzA.BC abcdefgh/ij-k-lmno.pq abcdefgh/ijk-l-mnop.qr-stu abcdefgh/ijklmnop-qr.st abcdef/ghijklmno-pq.rs abcdef/ghi-jklm_no_pqrstuv abcdefgh/ijk-lm-n-opqr.st abcdefgh/ijklm-n-opqr.st-uvw abcdef/ghijklm-nopq_r abcdefg/hijkl-mn.op.qzs abcdefg/hijklmn-op.qr.stz abcdefgh/ijklmn] {
       lappend display_list $elt
       lappend len_list [string length $elt]
-      if {[string length $elt] > $max_len} {
-         set max_len [string length $elt]
-      }
    }
-   displayElementList test {} terse 0 1 1 $display_list $len_list $max_len
+   displayElementList test {} terse 0 1 1 $display_list $len_list
    setState term_columns $orig_term_columns
 }
 
@@ -701,4 +697,9 @@ if {[info exists env(TESTSUITE_ENABLE_RUNENVCOMMAND_UNSET)]} {
     }
 }
 
+# specific tests to improve compute_output_grid coverage
+if {[info exists env(TESTSUITE_ENABLE_SITECONFIG_COMPUTEOUTPUTGRID)]} {
+    report [compute_output_grid 80 {} 3]
+}
+
 }

testsuite/modules.00-init/120-siteconfig.exp

@@ -217,27 +217,38 @@ unset env(TESTSUITE_ENABLE_SITECONFIG_TERSENUM)
 # test displayElementList procedure with a tricky list that triggers unusual condition
 setenv_var TESTSUITE_ENABLE_SITECONFIG_TRICKYLISTDISP 1
 set ans "test:
- 1\\) abc/def                                 22\\) abcdefgh/ij-k-lmno.pq         
- 2\\) abcdefgh/ijklmnop                       23\\) abcdefgh/ijk-l-mnop.qr-stu    
- 3\\) abc/defg                                24\\) abcdefgh/ijklmnop-qr.st       
- 4\\) abcd/ef                                 25\\) abcdef/ghijklmno-pq.rs        
- 5\\) abc/defg-hijkl.mn.op                    26\\) abcdef/ghi-jklm_no_pqrstuv    
- 6\\) abcdefgh/ijklm.nopqrst                  27\\) abcdefgh/ijk-lm-n-opqr.st     
- 7\\) abcdefg/hijklmnop-qr.st.uvw             28\\) abcdefgh/ijklm-n-opqr.st-uvw  
- 8\\) abcdefgh/ijklmnopqrst-u-vwxy.zA-BCD-E   29\\) abcdef/ghijklm-nopq_r         
- 9\\) abcdef/ghijklm-nopq.r_st.uv             30\\) abcdefg/hijkl-mn.op.qzs       
-10\\) abcdefgh/ijklmnop-q-rstu.vw-xyz-A       31\\) abcdefg/hijklmn-op.qr.stz     
-11\\) abcdefg/hijklmn-op.qr.stu               32\\) abcdefgh/ijklmn               
-12\\) abcdefg/hijkl-mn.op.qrs                 
-13\\) abcd/efgh-ij.k                          
-14\\) abcdefg/hijk-lmnop_qr.st.uvw            
-15\\) abcdef/ghijklmno-p.q.r                  
-16\\) abcdefgh/ijklmn-o-pqrs.tu               
-17\\) abcdefgh/ijklmnop-q-rstu.vw-xyz         
-18\\) abcdefg/hij-klm.nopq                    
-19\\) abcdefg/hij-kl.mn.opq                   
-20\\) abcdefgh/ijklmnopq_rstuv-w-xyzA.BC-DEF  
-21\\) abcdefgh/ijklmnopqrstuv-w-xyzA.BC       
+ 1\\) abc/def
+ 2\\) abcdefgh/ijklmnop
+ 3\\) abc/defg
+ 4\\) abcd/ef
+ 5\\) abc/defg-hijkl.mn.op
+ 6\\) abcdefgh/ijklm.nopqrst
+ 7\\) abcdefg/hijklmnop-qr.st.uvw
+ 8\\) abcdefgh/ijklmnopqrst-u-vwxy.zA-BCD-E
+ 9\\) abcdef/ghijklm-nopq.r_st.uv
+10\\) abcdefgh/ijklmnop-q-rstu.vw-xyz-A
+11\\) abcdefg/hijklmn-op.qr.stu
+12\\) abcdefg/hijkl-mn.op.qrs
+13\\) abcd/efgh-ij.k
+14\\) abcdefg/hijk-lmnop_qr.st.uvw
+15\\) abcdef/ghijklmno-p.q.r
+16\\) abcdefgh/ijklmn-o-pqrs.tu
+17\\) abcdefgh/ijklmnop-q-rstu.vw-xyz
+18\\) abcdefg/hij-klm.nopq
+19\\) abcdefg/hij-kl.mn.opq
+20\\) abcdefgh/ijklmnopq_rstuv-w-xyzA.BC-DEF
+21\\) abcdefgh/ijklmnopqrstuv-w-xyzA.BC
+22\\) abcdefgh/ij-k-lmno.pq
+23\\) abcdefgh/ijk-l-mnop.qr-stu
+24\\) abcdefgh/ijklmnop-qr.st
+25\\) abcdef/ghijklmno-pq.rs
+26\\) abcdef/ghi-jklm_no_pqrstuv
+27\\) abcdefgh/ijk-lm-n-opqr.st
+28\\) abcdefgh/ijklm-n-opqr.st-uvw
+29\\) abcdef/ghijklm-nopq_r
+30\\) abcdefg/hijkl-mn.op.qzs
+31\\) abcdefg/hijklmn-op.qr.stz
+32\\) abcdefgh/ijklmn
 
 $vers_reportre"
 testouterr_cmd_re "sh" "-V" "OK" $ans
@@ -666,8 +677,8 @@ lappend ans {      invoked from within}
 lappend ans {  "displaySeparatorLine $header $sgrkey $extra"}
 lappend ans {      (procedure "displayElementList" line 19)}
 lappend ans {      invoked from within}
-lappend ans {  "displayElementList $header $hsgrkey $hstyle $one_per_line $show_idx 1 $display_list $len_list $max_len $via"}
-lappend ans {      (procedure "reportModules" line 155)}
+lappend ans {  "displayElementList $header $hsgrkey $hstyle $one_per_line $show_idx 1 $display_list $len_list $via"}
+lappend ans {      (procedure "reportModules" line 151)}
 lappend ans {      invoked from within}
 lappend ans {  "reportModules $args $dir mp $hstyle $show_mtime 0 $one_per_line $theader_cols hidden-loaded"}
 lappend ans {      (procedure "cmdModuleAvail" line 43)}
@@ -766,6 +777,13 @@ lappend ans $vers_reportre
 testouterr_cmd_re sh -V OK [join $ans \n]
 unsetenv_var TESTSUITE_ENABLE_RUNENVCOMMAND_UNSET
 
+setenv_var TESTSUITE_ENABLE_SITECONFIG_COMPUTEOUTPUTGRID 1
+set ans [list]
+lappend ans {0 0 \{0\}}
+lappend ans $vers_reportre
+testouterr_cmd_re sh -V OK [join $ans \n]
+unsetenv_var TESTSUITE_ENABLE_SITECONFIG_COMPUTEOUTPUTGRID
+
 } elseif {$verbose} {
     send_user "\tSkip tests relying on an excepted siteconfig file installed\n"
 }