tclpkg-dlist.cc

Go to the documentation of this file.
00001 /** @file tcl/tclpkg-dlist.cc tcl interface package for extended
00002     list-manipulation functions */
00003 ///////////////////////////////////////////////////////////////////////
00004 //
00005 // Copyright (c) 1998-2004 California Institute of Technology
00006 // Copyright (c) 2004-2007 University of Southern California
00007 // Rob Peters <rjpeters at usc dot edu>
00008 //
00009 // created: Tue Dec  1 08:00:00 1998
00010 // commit: $Id: tclpkg-dlist.cc 11876 2009-10-22 15:53:06Z icore $
00011 // $HeadURL: svn://isvn.usc.edu/software/invt/trunk/saliency/src/tcl/tclpkg-dlist.cc $
00012 //
00013 // --------------------------------------------------------------------
00014 //
00015 // This file is part of GroovX
00016 //   [http://ilab.usc.edu/rjpeters/groovx/]
00017 //
00018 // GroovX is free software; you can redistribute it and/or modify it
00019 // under the terms of the GNU General Public License as published by
00020 // the Free Software Foundation; either version 2 of the License, or
00021 // (at your option) any later version.
00022 //
00023 // GroovX is distributed in the hope that it will be useful, but
00024 // WITHOUT ANY WARRANTY; without even the implied warranty of
00025 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00026 // General Public License for more details.
00027 //
00028 // You should have received a copy of the GNU General Public License
00029 // along with GroovX; if not, write to the Free Software Foundation,
00030 // Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
00031 //
00032 ///////////////////////////////////////////////////////////////////////
00033 
00034 #ifndef GROOVX_TCL_TCLPKG_DLIST_CC_UTC20050628161246_DEFINED
00035 #define GROOVX_TCL_TCLPKG_DLIST_CC_UTC20050628161246_DEFINED
00036 
00037 #include "tcl/tclpkg-dlist.h"
00038 
00039 #include "tcl/tclpkg-dlist.h"
00040 
00041 // This file implements additional Tcl list manipulation functions
00042 
00043 #include "tcl/list.h"
00044 #include "tcl/pkg.h"
00045 
00046 #include "rutz/algo.h"
00047 #include "rutz/arrays.h"
00048 #include "rutz/error.h"
00049 #include "rutz/rand.h"
00050 
00051 #include "rutz/trace.h"
00052 #include "rutz/debug.h"
00053 GVX_DBG_REGISTER
00054 
00055 #include <algorithm> // for std::random_shuffle
00056 #include <cmath>
00057 
00058 // Helper functions
00059 namespace
00060 {
00061   template <class Itr>
00062   double perm_distance_aux(Itr itr, Itr end)
00063   {
00064     int c = 0;
00065     double result = 0.0;
00066     while (itr != end)
00067       {
00068         result += fabs(double(*itr) - double(c));
00069         ++itr;
00070         ++c;
00071       }
00072 
00073     return result / double(c);
00074   }
00075 
00076   template <class Itr>
00077   double perm_distance2_aux(Itr itr, Itr end, double power)
00078   {
00079     int c = 0;
00080     double result = 0.0;
00081     while (itr != end)
00082       {
00083         result += pow(fabs(double(*itr) - double(c)), power);
00084         ++itr;
00085         ++c;
00086       }
00087 
00088     return pow(result, 1.0/power) / double(c);
00089   }
00090 }
00091 
00092 namespace Dlist
00093 {
00094 
00095   //---------------------------------------------------------
00096   //
00097   // This command takes two lists as arguments, and uses the integers in
00098   // the second (index) list to return a permutation of the elements in
00099   // the first (source) list
00100   //
00101   // Example:
00102   //      dlist_choose { 3 5 7 } { 2 0 1 }
00103   // returns
00104   //      7 3 5
00105   //
00106   //---------------------------------------------------------
00107 
00108   tcl::list choose(tcl::list source_list, tcl::list index_list)
00109   {
00110     tcl::list result;
00111 
00112     for (unsigned int i = 0; i < index_list.length(); ++i)
00113       {
00114         unsigned int index = index_list.get<unsigned int>(i);
00115 
00116         // use that int as an index into source list, getting the
00117         // corresponding list element and appending it to the output list
00118         result.append(source_list.at(index));
00119       }
00120 
00121     GVX_ASSERT(result.length() == index_list.length());
00122 
00123     return result;
00124   }
00125 
00126   //---------------------------------------------------------
00127   //
00128   // Cyclically shift the elements of the list leftward by n steps.
00129   //
00130   //---------------------------------------------------------
00131 
00132   tcl::list cycle_left(tcl::list source_list, unsigned int n)
00133   {
00134     n = n % source_list.length();
00135 
00136     if (n == 0)
00137       return source_list;
00138 
00139     tcl::list result;
00140 
00141     for (unsigned int i = n; i < source_list.length(); ++i)
00142       {
00143         result.append(source_list.at(i));
00144       }
00145 
00146     for (unsigned int i = 0; i < n; ++i)
00147       {
00148         result.append(source_list.at(i));
00149       }
00150 
00151     return result;
00152   }
00153 
00154   //---------------------------------------------------------
00155   //
00156   // Cyclically shift the elements of the list rightward by n steps.
00157   //
00158   //---------------------------------------------------------
00159 
00160   tcl::list cycle_right(tcl::list source_list, unsigned int n)
00161   {
00162     n = n % source_list.length();
00163 
00164     if (n == 0)
00165       return source_list;
00166 
00167     return cycle_left(source_list, source_list.length() - n);
00168   }
00169 
00170   //---------------------------------------------------------
00171   //
00172   // Returns the n'th element of the list; generates an error if n is
00173   // out of range.
00174   //
00175   //---------------------------------------------------------
00176 
00177   tcl::obj index(tcl::list source_list, unsigned int n)
00178   {
00179     return source_list.at(n);
00180   }
00181 
00182   //---------------------------------------------------------
00183   //
00184   // This command takes as its argument a single list containing only
00185   // integers, and returns a list in which each element is the logical
00186   // negation of its corresponding element in the source list.
00187   //
00188   //---------------------------------------------------------
00189 
00190   tcl::list not_(tcl::list source_list)
00191   {
00192     tcl::obj one = tcl::convert_from<int>(1);
00193     tcl::obj zero = tcl::convert_from<int>(0);
00194     tcl::list result;
00195 
00196     for (unsigned int i = 0; i < source_list.length(); ++i)
00197       {
00198         if ( source_list.get<int>(i) == 0 )
00199           result.append(one);
00200         else
00201           result.append(zero);
00202       }
00203 
00204     GVX_ASSERT(result.length() == source_list.length());
00205 
00206     return result;
00207   }
00208 
00209   //---------------------------------------------------------
00210   //
00211   // this command produces a list of ones of the length specified by its
00212   // lone argument
00213   //
00214   //---------------------------------------------------------
00215 
00216   tcl::list ones(unsigned int num_ones)
00217   {
00218     tcl::list result;
00219     result.append(1, num_ones);
00220 
00221     return result;
00222   }
00223 
00224   //---------------------------------------------------------
00225   //
00226   // This commmand returns a single element chosen at random
00227   // from the source list
00228   //
00229   //---------------------------------------------------------
00230 
00231   tcl::obj pickone(tcl::list source_list)
00232   {
00233     if (source_list.length() == 0)
00234       {
00235         throw rutz::error("source_list is empty", SRC_POS);
00236       }
00237 
00238     return source_list.at(rutz::rand_range(0u, source_list.length()));
00239   }
00240 
00241   //---------------------------------------------------------
00242   //
00243   // this command produces an ordered list of all integers between begin
00244   // and end, inclusive.
00245   //
00246   //---------------------------------------------------------
00247 
00248   tcl::list range(int begin, int end, int step)
00249   {
00250     tcl::list result;
00251 
00252     if (step == 0)
00253       {
00254         // special case: if step is 0, we return an empty list
00255       }
00256     else if (step > 0)
00257       {
00258         for (int i = begin; i <= end; i += step)
00259           {
00260             result.append(i);
00261           }
00262       }
00263     else // step < 0
00264       {
00265         for (int i = begin; i >= end; i += step)
00266           {
00267             result.append(i);
00268           }
00269       }
00270 
00271     return result;
00272   }
00273 
00274   //---------------------------------------------------------
00275   //
00276   // Make a series of linearly spaced values between (and including) two
00277   // endpoints
00278   //
00279   //---------------------------------------------------------
00280 
00281   tcl::list linspace(double begin, double end, unsigned int npts)
00282   {
00283     tcl::list result;
00284 
00285     if (npts < 2)
00286       {
00287         throw rutz::error("npts must be at least 2", SRC_POS);
00288       }
00289 
00290     const double skip = (end - begin) / (npts - 1);
00291 
00292     bool integer_mode = (skip == int(skip) && begin == int(begin));
00293 
00294     if (integer_mode)
00295       for (unsigned int i = 0; i < npts; ++i)
00296         {
00297           result.append(int(begin + i*skip));
00298         }
00299     else
00300       for (unsigned int i = 0; i < npts; ++i)
00301         {
00302           result.append(begin + i*skip);
00303         }
00304 
00305     return result;
00306   }
00307 
00308   double perm_distance(tcl::list src)
00309   {
00310     return perm_distance_aux(src.begin<unsigned int>(),
00311                              src.end<unsigned int>());
00312   }
00313 
00314   double perm_distance2(tcl::list src, double power)
00315   {
00316     return perm_distance2_aux(src.begin<unsigned int>(),
00317                               src.end<unsigned int>(),
00318                               power);
00319   }
00320 
00321   //---------------------------------------------------------
00322   //
00323   // generate a complete/pure permutation of the numbers 0..N-1
00324   // the result is such that:
00325   //   result[i] != i         for all i
00326   //   sum(abs(result[i]-i))  is maximal
00327   //
00328   // WARNING: At first glance this might sound like it yields a nice random
00329   // list, but in fact simply reversing the order of elements gives a
00330   // result that satisfies the constraints of this algorithm, without being
00331   // random at all!
00332   //
00333   //---------------------------------------------------------
00334 
00335   tcl::list permute_maximal(unsigned int N)
00336   {
00337     if (N < 2)
00338       throw rutz::error("N must be at least 2 to make a permutation",
00339                         SRC_POS);
00340 
00341     double maxdist = double(N)/2.0;
00342 
00343     if (N%2)
00344       {
00345         const double half = double(N)/2.0;
00346         maxdist = half + 1.0/(2.0 + 1.0/half);
00347       }
00348 
00349     maxdist -= 0.0001;
00350 
00351     rutz::fixed_block<unsigned int> slots(N);
00352 
00353     for (unsigned int i = 0; i < slots.size()-1; ++i)
00354       slots[i] = i+1;
00355 
00356     slots[slots.size()-1] = 0;
00357 
00358     double dist = perm_distance_aux(slots.begin(), slots.end());
00359 
00360     for (int c = 0; c < 100000; ++c)
00361       {
00362         unsigned int i = rutz::rand_range(0u, N);
00363         unsigned int j = i;
00364         while (j == i)
00365           {
00366             j = rutz::rand_range(0u, N);
00367           }
00368 
00369         if (slots[j] != i && slots[i] != j)
00370           {
00371             const double origdist =
00372               fabs(double(i)-double(slots[i])) +
00373               fabs(double(j)-double(slots[j]));
00374 
00375             const double newdist =
00376               fabs(double(j)-double(slots[i])) +
00377               fabs(double(i)-double(slots[j]));
00378 
00379             if (newdist > origdist)
00380               {
00381                 rutz::swap2(slots[i], slots[j]);
00382                 dist += (newdist-origdist)/double(N);
00383               }
00384           }
00385 
00386         if (dist >= maxdist)
00387           {
00388             double distcheck = perm_distance_aux(slots.begin(), slots.end());
00389             if (distcheck < maxdist)
00390               {
00391                 throw rutz::error("snafu in permutation "
00392                                   "distance computation", SRC_POS);
00393               }
00394 
00395             dbg_eval_nl(3, c);
00396 
00397             tcl::list result;
00398 
00399             for (unsigned int i = 0; i < slots.size(); ++i)
00400               {
00401                 result.append(slots[i]);
00402               }
00403 
00404             return result;
00405           }
00406       }
00407 
00408     throw rutz::error("permutation algorithm failed to converge",
00409                       SRC_POS);
00410     return tcl::list(); // can't happen, but placate compiler
00411   }
00412 
00413   //---------------------------------------------------------
00414   //
00415   // generate a random permutation of the numbers 0..N-1 such that:
00416   //   result[i] != i         for all i
00417   //
00418   //---------------------------------------------------------
00419 
00420   tcl::list permute_moveall(unsigned int N)
00421   {
00422     if (N < 2)
00423       throw rutz::error("N must be at least 2 to make a permutation", SRC_POS);
00424 
00425     rutz::fixed_block<bool> used(N);
00426     for (unsigned int i = 0; i < N; ++i)
00427       used[i] = false;
00428 
00429     rutz::fixed_block<unsigned int> slots(N);
00430 
00431     // fill slots[0] ... slots[N-2]
00432     for (unsigned int i = 0; i < N-1; ++i)
00433       {
00434         unsigned int v = i;
00435         while (v == i || used[v])
00436           v = rutz::rand_range(0u, N);
00437 
00438         GVX_ASSERT(v < N);
00439 
00440         used[v] = true;
00441         slots[i] = v;
00442       }
00443 
00444     // figure out which is the last available slot
00445     unsigned int lastslot = N;
00446     for (unsigned int i = 0; i < N; ++i)
00447       if (!used[i])
00448         {
00449           lastslot = i;
00450           break;
00451         }
00452 
00453     GVX_ASSERT(lastslot != N);
00454 
00455     if (lastslot == N)
00456       {
00457         slots[N-1] = slots[N-2];
00458         slots[N-2] = lastslot;
00459       }
00460     else
00461       {
00462         slots[N-1] = lastslot;
00463       }
00464 
00465     tcl::list result;
00466 
00467     for (unsigned int i = 0; i < slots.size(); ++i)
00468       {
00469         result.append(slots[i]);
00470       }
00471 
00472     return result;
00473   }
00474 
00475   //---------------------------------------------------------
00476   //
00477   // this command produces a list of random numbers each between min and
00478   // max, and of the given
00479   //
00480   //---------------------------------------------------------
00481 
00482   tcl::list rand(double min, double max, unsigned int N)
00483   {
00484     tcl::list result;
00485 
00486     static rutz::urand generator;
00487 
00488     for (unsigned int i = 0; i < N; ++i)
00489       {
00490         result.append(generator.fdraw_range(min, max));
00491       }
00492 
00493     return result;
00494   }
00495 
00496   //---------------------------------------------------------
00497   //
00498   // This command taks two lists as arguments. Each element from the
00499   // first (source) list is appended to the result multiple times; the
00500   // number of times is determined by the corresponding integer found in
00501   // the second (times) list.
00502   //
00503   // For example:
00504   //      dlist_repeat { 4 5 6 } { 1 2 3 }
00505   // returns
00506   //      4 5 5 6 6 6
00507   //
00508   //---------------------------------------------------------
00509 
00510   tcl::list repeat(tcl::list source_list, tcl::list times_list)
00511   {
00512     // find the minimum of the two lists' lengths
00513     unsigned int min_len = rutz::min(source_list.length(), times_list.length());
00514 
00515     tcl::list result;
00516 
00517     for (unsigned int t = 0; t < min_len; ++t)
00518       {
00519         result.append(source_list.at(t),
00520                       times_list.get<unsigned int>(t));
00521       }
00522 
00523     return result;
00524   }
00525 
00526   //---------------------------------------------------------
00527   //
00528   // Return a new list containing the elements of the source list in
00529   // reverse order.
00530   //
00531   //---------------------------------------------------------
00532 
00533   tcl::list reverse(tcl::list src)
00534   {
00535     if (src.length() < 2)
00536       return src;
00537 
00538     tcl::list result;
00539     for (unsigned int i = 0; i < src.length(); ++i)
00540       result.append(src.at(src.length()-i-1));
00541     return result;
00542   }
00543 
00544   //---------------------------------------------------------
00545   //
00546   // This command takes two lists as arguments, using the binary flags
00547   // in the second (flags) list to choose which elements from the first
00548   // (source) list should be appended to the output list
00549   //
00550   //---------------------------------------------------------
00551 
00552   tcl::list select(tcl::list source_list, tcl::list flags_list)
00553   {
00554     unsigned int src_len = source_list.length();
00555     unsigned int flg_len = flags_list.length();
00556 
00557     if (flg_len < src_len)
00558       {
00559         throw rutz::error("flags list must be as long as source_list",
00560                           SRC_POS);
00561       }
00562 
00563     tcl::list result;
00564 
00565     for (unsigned int i = 0; i < src_len; ++i)
00566       {
00567         // if the flag is true, add the corresponding source_list
00568         // element to the result list
00569         if ( flags_list.get<int>(i) )
00570           {
00571             result.append(source_list.at(i));
00572           }
00573       }
00574 
00575     return result;
00576   }
00577 
00578   //---------------------------------------------------------
00579   //
00580   // dlist::shuffle
00581   //
00582   //---------------------------------------------------------
00583 
00584   tcl::list shuffle(tcl::list src, int seed)
00585   {
00586     rutz::fixed_block<tcl::obj> objs(src.begin<tcl::obj>(),
00587                                         src.end<tcl::obj>());
00588 
00589     rutz::urand generator(seed);
00590 
00591     std::random_shuffle(objs.begin(), objs.end(), generator);
00592 
00593     tcl::list result;
00594 
00595     for (unsigned int i = 0; i < objs.size(); ++i)
00596       {
00597         result.append(objs[i]);
00598       }
00599 
00600     return result;
00601   }
00602 
00603   //---------------------------------------------------------
00604   //
00605   // Shuffle an input list through a random permutation such that no
00606   // element remains in its initial position.
00607   //
00608   //---------------------------------------------------------
00609 
00610   tcl::list shuffle_moveall(tcl::list src)
00611   {
00612     tcl::list permutation = permute_moveall(src.length());
00613     return Dlist::choose(src, permutation);
00614   }
00615 
00616   //---------------------------------------------------------
00617   //
00618   // Shuffle an input list through a maximal permutation.
00619   //
00620   //---------------------------------------------------------
00621 
00622   tcl::list shuffle_maximal(tcl::list src)
00623   {
00624     tcl::list permutation = permute_maximal(src.length());
00625     return Dlist::choose(src, permutation);
00626   }
00627 
00628   //---------------------------------------------------------
00629   //
00630   // dlist::slice
00631   //
00632   //---------------------------------------------------------
00633 
00634   tcl::list slice(tcl::list src, unsigned int slice)
00635   {
00636     tcl::list result;
00637 
00638     for (unsigned int i = 0, end = src.length(); i < end; ++i)
00639       {
00640         tcl::list sub(src.at(i));
00641         result.append(sub.at(slice));
00642       }
00643 
00644     GVX_ASSERT(result.length() == src.length());
00645 
00646     return result;
00647   }
00648 
00649   //---------------------------------------------------------
00650   //
00651   // this command sums the numbers in a list, trying to return an int
00652   // result if possible, but returning a double result if any doubles
00653   // are found in the source list
00654   //
00655   //---------------------------------------------------------
00656 
00657   tcl::obj sum(tcl::list source_list)
00658   {
00659     int isum=0;
00660     double dsum=0.0;
00661     bool seen_double=false;
00662 
00663     for (unsigned int i = 0; i < source_list.length(); /* incr in loop body*/)
00664       {
00665         if ( !seen_double )
00666           {
00667             try
00668               {
00669                 isum += source_list.get<int>(i);
00670               }
00671             catch(rutz::error&)
00672               {
00673                 seen_double = true;
00674                 dsum = isum;
00675                 continue; // skip the increment
00676               }
00677           }
00678         else
00679           {
00680             dsum += source_list.get<double>(i);
00681           }
00682 
00683         ++i; // here's the increment
00684       }
00685 
00686     if ( !seen_double )
00687       return tcl::convert_from<int>(isum);
00688     else
00689       return tcl::convert_from<double>(dsum);
00690   }
00691 
00692   //---------------------------------------------------------
00693   //
00694   // this command produces a list of zeros of the length specified by its
00695   // lone argument
00696   //
00697   //---------------------------------------------------------
00698 
00699   tcl::list zeros(unsigned int num_zeros)
00700   {
00701     tcl::list result;
00702     result.append(0, num_zeros);
00703 
00704     return result;
00705   }
00706 
00707 } // end namespace Dlist
00708 
00709 
00710 extern "C"
00711 int Dlist_Init(Tcl_Interp* interp)
00712 {
00713 GVX_TRACE("Dlist_Init");
00714 
00715   GVX_PKG_CREATE(pkg, interp, "Dlist", "4.$Revision: 11876 $");
00716 
00717   pkg->def( "choose", "source_list index_list", &Dlist::choose, SRC_POS );
00718   pkg->def( "cycle_left", "list n", &Dlist::cycle_left, SRC_POS );
00719   pkg->def( "cycle_right", "list n", &Dlist::cycle_right, SRC_POS );
00720   pkg->def( "index", "list index", &Dlist::index, SRC_POS );
00721   pkg->def( "not", "list", &Dlist::not_, SRC_POS );
00722   pkg->def( "ones", "num_ones", &Dlist::ones, SRC_POS );
00723   pkg->def( "linspace", "begin end npts", &Dlist::linspace, SRC_POS );
00724   pkg->def( "perm_distance", "list", &Dlist::perm_distance, SRC_POS );
00725   pkg->def( "perm_distance2", "list power", &Dlist::perm_distance2, SRC_POS );
00726   pkg->def( "permute_maximal", "N", &Dlist::permute_maximal, SRC_POS );
00727   pkg->def( "permute_moveall", "N", &Dlist::permute_moveall, SRC_POS );
00728   pkg->def( "pickone", "list", &Dlist::pickone, SRC_POS );
00729   pkg->def( "rand", "min max N", &Dlist::rand, SRC_POS );
00730   pkg->def( "range", "begin end ?step=1?", &Dlist::range, SRC_POS );
00731   pkg->def( "range", "begin end", rutz::bind_last(&Dlist::range, 1), SRC_POS );
00732   pkg->def( "repeat", "source_list times_list", &Dlist::repeat, SRC_POS );
00733   pkg->def( "reverse", "list", &Dlist::reverse, SRC_POS );
00734   pkg->def( "select", "source_list flags_list", &Dlist::select, SRC_POS );
00735   pkg->def( "shuffle", "list ?seed=0?", &Dlist::shuffle, SRC_POS );
00736   pkg->def( "shuffle", "list", rutz::bind_last(&Dlist::shuffle, 0), SRC_POS );
00737   pkg->def( "shuffle_maximal", "list", &Dlist::shuffle_maximal, SRC_POS );
00738   pkg->def( "shuffle_moveall", "list", &Dlist::shuffle_moveall, SRC_POS );
00739   pkg->def( "slice", "list n", &Dlist::slice, SRC_POS );
00740   pkg->def( "sum", "list", &Dlist::sum, SRC_POS );
00741   pkg->def( "zeros", "num_zeros", &Dlist::zeros, SRC_POS );
00742 
00743   GVX_PKG_RETURN(pkg);
00744 }
00745 
00746 static const char __attribute__((used)) vcid_groovx_tcl_tclpkg_dlist_cc_utc20050628161246[] = "$Id: tclpkg-dlist.cc 11876 2009-10-22 15:53:06Z icore $ $HeadURL: svn://isvn.usc.edu/software/invt/trunk/saliency/src/tcl/tclpkg-dlist.cc $";
00747 #endif // !GROOVX_TCL_TCLPKG_DLIST_CC_UTC20050628161246_DEFINED
Generated on Sun May 8 08:42:22 2011 for iLab Neuromorphic Vision Toolkit by  doxygen 1.6.3