source: tol/toltcl/generic/tolsergrp.cpp @ cc7ddc7

1941-docker-image-to-testdevel
Last change on this file since cc7ddc7 was b6e5dacc, checked in by Jorge Pérez <josp.jorge@…>, 12 years ago

refs #1812, refs #1818, compilación basada en CMake, eliminación de warnings, automatización de la regla install.

Configuración en Linux como:

cmake -DCMAKE_TOOLCHAIN_FILE=../linux-i686.toolchain.cmake -DTOL_PREFIX_PATH=/usr/local/tol32 -DCMAKE_BUILD_TYPE=Release -DTCL_LIBRARY=/usr/local/tcl8.5-i686/lib/libtcl8.5.so ..

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@6456 be4846ae-f051-483a-831f-b64e7d08527f

  • Property mode set to 100644
File size: 58.5 KB
Line 
1/* tolsergrp.cpp: This file implements a the command to manipulate a
2                  group of series.
3                  GNU/tolTcl Library
4
5   Copyright (C) 2001, 2002, 2003 - Bayes Decisión, SL
6
7   This program is free software; you can redistribute it and/or modify
8   it under the terms of the GNU General Public License as published by
9   the Free Software Foundation; either version 2, or (at your option)
10   any later version.
11
12   This program is distributed in the hope that it will be useful,
13   but WITHOUT ANY WARRANTY; without even the implied warranty of
14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15   GNU General Public License for more details.
16
17   You should have received a copy of the GNU General Public License
18   along with this program; if not, write to the Free Software
19   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
20   USA.
21 */
22
23#include <toltclInt.h>
24#include <tt_crash.h>
25
26#ifdef USE_BLT_VECTOR
27#include <bltVector.h>
28#endif
29
30#if defined(_MSC_VER)
31#  include <win_tolinc.h>
32#endif
33
34#include <tol/tol_bcommon.h>
35#include <tol/tol_btsrgra.h>
36#include <tol/tol_bstat.h>
37
38struct Tol_SerieCursor;
39struct Tol_SerieData;
40struct Tol_SerieGroup;
41
42static Tol_SerieCursor * Tol_AllocSerieCursor();
43static void Tol_FreeSerieCursor(Tol_SerieCursor * tsc);
44static int Tol_InitSerieCursor(Tol_SerieCursor * tsc,
45                               Tol_SerieData * tsd,
46                               BUserTimeSerie * uts,
47                               BDate & begin,
48                               BDate & end,
49                               int RangeIsDefault);
50
51static int Tol_GetIntIndex(Tcl_Interp * interp,
52                           Tcl_Obj * obj,
53                           const char * keys,
54                           int max, int * idx);
55
56static int Tol_SerieGrpObjCmd(ClientData clientData,
57                              Tcl_Interp *interp,
58                              int objc, Tcl_Obj *CONST objv[]);
59
60static void Tol_SerieGrpDelCmd(ClientData clientData);
61
62static int Tol_CreateSerieGrpData(Tcl_Interp * interp,
63                                  int objc,
64                                  Tcl_Obj *CONST series[],
65                                  Tol_SerieGroup ** tsgPtr,
66                                  BDate & begin,
67                                  BDate & end,
68                                  int RangeIsDefault,
69                                  Tcl_Obj *obj_result);
70
71static int Tol_CreateSerieGrpData(Tcl_Interp * interp,
72                                  BList * series,
73                                  Tol_SerieGroup ** tsgPtr,
74                                  BDate & begin,
75                                  BDate & end,
76                                  int RangeIsDefault,
77                                  Tcl_Obj *obj_result);
78
79#define TICK_END -1
80#define TICK_TCL  1
81#define TICK_TOL  2
82#define GROW_TICK_DATA 10
83
84typedef BDat (*StatFunc)(BSyntaxObject *);
85
86struct SerieStats {
87  const char * name;
88  StatFunc func;
89};
90
91static SerieStats
92stats_data[] = {
93  {"Count",     StatCount},
94  {"Maximun",   StatMax},
95  {"Minimun",   StatMin},
96  {"Sum",       StatSum},
97  {"Average",   StatAverage},
98  {"Std. Dev.", StatStDs},
99  {"Varianze",  StatVarianze},
100  {"Asymmetry",  StatAsymmetry},
101  {"Kurtosis",  StatKurtosis},
102  {"Median",    StatMedian}
103};
104
105#define NUMSTATS sizeof(stats_data)/sizeof(stats_data[0])
106
107static
108Tcl_Obj * Tol_GetAllSerieStats( BUserTimeSerie * uts )
109{
110  const int listsize = 2*NUMSTATS;
111  Tcl_Obj * stats[listsize];
112  BDat dat;
113  for ( size_t i = 0; i < NUMSTATS; i++ ) {
114    stats[2*i] = Tcl_NewStringObj(stats_data[i].name,-1);
115    dat = (*(stats_data[i].func))(uts);
116    if ( dat.IsKnown() )
117      stats[2*i+1] = Tcl_NewDoubleObj(dat.Value());
118    else {
119      BText name(dat.Name());
120      stats[2*i+1] = Tcl_NewStringObj(name,-1);
121    }
122  }
123  return Tcl_NewListObj( listsize, stats );
124}
125                       
126/*
127 *----------------------------------------------------------------------
128 *
129 * Tol_ComputeSerieStat --
130 *
131 *       Implements the new Tcl "::tol::seriestat" command.
132 *
133 *       tol::seriestat serieref     
134 *           -> {serie-name {list of stats names & values}}
135 *
136 *       tol::seriestat serieref statname ?args?
137 *            -> return the stat value. (not implemented yet)
138 *
139 * Results:
140 *       
141 *
142 * Side effects:
143 *       None.
144 *
145 *----------------------------------------------------------------------
146 */
147
148int Tol_ComputeSerieStat(Tcl_Interp * interp,
149                         int objc, Tcl_Obj *CONST objv[],
150                         Tcl_Obj * obj_result)
151{
152  BUserTimeSerie * uts;
153  bool found;
154 
155  // uts = Tol_GetTimeSerie( interp, objv[0] );
156  uts = (BUserTimeSerie*)Tol_ResolveObject(interp, objv[0],
157                                           obj_result/*,GraSerie()*/);
158  if ( !uts ) {
159    return TCL_ERROR;
160  }
161  Tcl_Obj * listv[2];
162  if ( objc > 1 ) {
163    Tcl_Obj **stats;
164    stats = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*2*(objc-1) );
165    //const int listsize = 2*(objc-1);
166    //Tcl_Obj * stats[listsize];
167    BDat dat;
168
169    listv[0] = Tcl_NewStringObj(uts->Identify(),-1);
170    for ( size_t i = 0; i < size_t(objc-1); i++ ) {
171      found = false;
172      for ( size_t j = 0; j < NUMSTATS; j++ ) {
173        if (strcmp(Tcl_GetString(objv[i+1]),stats_data[j].name) == 0) {
174          found = true;
175          stats[2*i] = Tcl_NewStringObj(stats_data[j].name,-1);
176          dat = (*(stats_data[j].func))(uts);
177          if ( dat.IsKnown() )
178            stats[2*i+1] = Tcl_NewDoubleObj(dat.Value());
179          else {
180            BText name(dat.Name());
181            stats[2*i+1] = Tcl_NewStringObj(name,-1);
182          }
183        }
184      }
185      if (found == false) {
186        Tcl_AppendStringsToObj(obj_result, "bad statistics name '",
187                          Tcl_GetString(objv[i+1]),"'", NULL);
188        Tcl_Free((char*)(stats));
189        return TCL_ERROR;
190      }     
191    }
192    listv[1] = Tcl_NewListObj(2*(objc-1), stats);
193    Tcl_SetListObj(obj_result, 2, listv);
194    Tcl_Free((char*)(stats));
195    return TCL_OK;
196
197  } else { 
198    // {Count 20 ... Median 0.23}
199    listv[0] = Tcl_NewStringObj(uts->Identify(),-1);
200    listv[1] = Tol_GetAllSerieStats( uts );
201    Tcl_SetListObj(obj_result, 2, listv);
202    return TCL_OK;
203  }
204}
205
206struct Tol_TicksData {
207  /* set of ticks marker at integer indexes */
208
209  int length;
210  int size;
211  int * ticks;
212
213  /* name of the set of ticks, could be a TimeSet or a constant set of
214     dates */
215
216  char * name;
217
218  /* 1 means TimeSet, 2 means constant set of dates */
219
220  char type;
221
222  /* if invalid we can reuse this slot */
223  char  valid;
224
225  int ReturnTicks( Tcl_Interp * interp );
226
227  void SetInfo( char * n, int t ) {
228    if ( !name ) {
229      int lenstr = strlen(n);
230      name = Tcl_Alloc( lenstr + 1 );
231      strcpy( name, n );
232      type = t;
233      valid = 1;
234    }
235  }
236  int new_tick( int t ) {
237    int _new;
238    if ( length == size ) {
239      size += GROW_TICK_DATA;
240      ticks = (int *)Tcl_Realloc( (char*)ticks, size * sizeof(ticks[0]) );
241    }
242    _new = length;
243    ticks[_new] = t;
244    ++length;
245    return _new;
246  }
247};
248
249int Tol_TicksData::ReturnTicks( Tcl_Interp * interp )
250{
251  Tcl_Obj * obj_result = Tcl_GetObjResult( interp );
252  Tcl_Obj ** items;
253 
254  if ( length ) {
255    items = (Tcl_Obj **)Tcl_Alloc( length * sizeof(items[0]) );
256    for ( int i = 0; i < length; ++i )
257      items[i] = Tcl_NewIntObj( ticks[i] );
258    Tcl_SetListObj( obj_result, length, items );
259    Tcl_Free( (char*)items );
260  } else
261    Tcl_SetListObj( obj_result, 0, NULL );
262 
263  return TCL_OK;
264}
265
266static void Tol_InitTicksData _ANSI_ARGS_((Tol_TicksData &ttd));
267static void Tol_FreeTicksData _ANSI_ARGS_((Tol_TicksData &ttd));
268static void Tol_ReleaseTicksData _ANSI_ARGS_((Tol_TicksData &ttd));
269
270#define GROW_SET_TICKS 10
271
272class CSetOfTicksData {
273public:
274  CSetOfTicksData() {
275    Init();
276  }
277  ~CSetOfTicksData() {
278    Destroy();
279  }
280  void Init() {
281    length = size = 0;
282    data = NULL;
283  }
284  void Destroy ();
285  Tol_TicksData * Get( int i ) {
286    return data + i;
287  }
288  int New();
289  int Length() { return length; }
290  int Find( char * name );
291  void Release( int i );
292private:
293  void Compact( int i );
294  int length;
295  int size;
296  Tol_TicksData * data;
297};
298
299void CSetOfTicksData::Destroy ()
300{
301  if ( data ) {
302    for ( int i = 0; i < length; i++ )
303      Tol_FreeTicksData( data[i] );
304    Tcl_Free( (char*)data );
305    data = NULL;
306    length = size = 0;
307  }
308}
309
310int CSetOfTicksData::New()
311{
312  int _new;
313  if ( length == size ) {
314    size += GROW_SET_TICKS;
315    data = (Tol_TicksData *)Tcl_Realloc( (char*)data, size * sizeof(data[0]) );
316  }
317  Tol_InitTicksData( data[length] );
318  _new = length;
319  ++length;
320  return _new;
321}
322 
323int CSetOfTicksData::Find( char * name )
324{
325  int i;
326
327  for ( i = 0; i < length; i++ )
328    if ( !strcmp( name, data[i].name ) )
329      break;
330  return i < length ? i : -1;
331}
332
333void CSetOfTicksData::Release( int i )
334{
335  Tol_TicksData & ttd = data[i];
336
337  Tol_ReleaseTicksData( ttd );
338  if ( ttd.type == TICK_TCL )
339    Compact( i );
340}
341
342void CSetOfTicksData::Compact( int i )
343{
344  int n;
345
346  n = length - 1 - i;
347  if ( n ) {
348    Tol_TicksData tmp = data[i];
349    memmove( data+i, data+i+1, n * sizeof(data[0]) );
350    data[length-1] = tmp;
351  }
352  --length;
353}
354
355static
356int CmpDate( const void * date1, const void * date2 )
357{
358  BDate & dte1 = *((BDate*)date1);
359  BDate & dte2 = *((BDate*)date2);
360
361  return dte1 > dte2 ? 1 : (dte1 < dte2 ? -1 : 0);
362}
363
364class CTickCursor {
365public:
366  CTickCursor( BDate * Index, int size ) {
367    m_index = Index;
368    m_size = size;
369    m_current = -1;
370  }
371  virtual ~CTickCursor() {}
372  int Start();
373  int Next();
374  int Current() {
375    return m_current;
376  }
377protected:
378  virtual int _first( BDate & f ) = 0;
379  virtual int _next() = 0;
380
381  BDate   m_curdate;
382  BDate * m_index;
383  int     m_size;
384  int     m_current;
385};
386
387int CTickCursor::Start()
388{
389  BDate & last = m_index[m_size-1];
390
391  m_current = 0;
392
393  do {
394    if ( !_first( m_index[m_current] ) )
395      return 0;
396
397    if ( m_curdate > last ) {
398      m_current = -1;
399      return 1;
400    }
401    /* este ciclo lo puedes mejorar
402       con una busqueda binaria */
403
404    while ( m_current < m_size ) {
405      if ( m_index[m_current] == m_curdate )
406        return 1;
407      if ( m_index[m_current] > m_curdate )
408        break;
409      ++m_current;
410    }
411    if ( m_current >= m_size )
412      m_current = -1;
413  } while ( m_current != -1 );
414  return 1;
415}
416
417int CTickCursor::Next() {
418  if ( m_current != -1 ) {
419    if ( !_next() )
420      return 0;
421    if ( m_curdate <= m_index[m_size-1] ) {
422      BDate * item = (BDate *)bsearch( &m_curdate,
423                                       m_index + m_current,
424                                       m_size - m_current,
425                                       sizeof(BDate),
426                                       &CmpDate );
427      /*
428       * Si yo implementara mi bsearch quizas pudiera optimizar
429       * esta busqueda, ya que aprovecharia el hecho de que
430       * despues de una bsearch m_current ya nunca se alcanzara siempre
431       * que el "mas cercano por debajo" a m_curdate es mayor que m_current.
432       */
433
434      if ( item )
435        m_current = item - m_index;
436      else
437        return Next();
438    } else
439      m_current = -1;
440  }
441  return 1;
442}
443
444class CTickCursor_TOL : public CTickCursor {
445public:
446  CTickCursor_TOL( BDate * Index, int size )
447    : CTickCursor( Index, size ) { }
448  ~CTickCursor_TOL() {}
449  void SetData( BUserTimeSet * uts ) {
450    m_uts = uts;
451  }
452protected:
453  virtual int _first( BDate & f );
454  virtual int _next();
455private:
456  BUserTimeSet * m_uts;
457};
458
459
460int CTickCursor_TOL::_first( BDate & f ) {
461  m_curdate = m_uts->FirstNoLess( f );
462  return 1;
463}
464
465int CTickCursor_TOL::_next() {
466  m_curdate = m_uts->Next( m_curdate );
467  return 1;
468}
469
470class CTickCursor_TCL: public CTickCursor {
471public:
472  CTickCursor_TCL( BDate * Index, int size )
473    : CTickCursor( Index, size ) {
474    m_objv = 0;
475  }
476  ~CTickCursor_TCL() {
477    if ( m_objv )
478      Tcl_Free( (char*)m_objv );
479    m_objc = m_curobj = 0;
480  }
481  int SetData( Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[] );
482protected:
483  virtual int _first( BDate & f );
484  virtual int _next();
485private:
486  int m_curobj;
487  int m_objc;
488  BDate * m_objv;
489};
490
491int CTickCursor_TCL::SetData( Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[] )
492{
493  int tcl_code;
494
495  m_curobj = 0;
496  m_objc = objc;
497  m_objv = (BDate*)Tcl_Alloc( objc * sizeof(BDate) );
498  for ( int i = 0; i < objc; i++ ) {
499    tcl_code = Tol_ListToDate( interp, objv[i], m_objv[i],
500                               Tcl_GetObjResult(interp) );
501    if ( tcl_code != TCL_OK )
502      return 0;
503  }
504  return 1;
505}
506
507int CTickCursor_TCL::_first( BDate & )
508{
509  if ( m_objc > 0 ) {
510    m_curobj = 0;
511    m_curdate = m_objv[0];
512  }
513  return 1;
514}
515
516int CTickCursor_TCL::_next()
517{
518  ++m_curobj;
519  if ( m_curobj < m_objc )
520    m_curdate = m_objv[m_curobj];
521  else {
522    m_curdate = m_index[m_size-1];
523    m_curdate.IncDay();
524  }
525  return 1;
526}
527
528struct Tol_SerieData {
529  int size;  /* == #?+1 */
530#ifdef USE_BLT_VECTOR
531  Blt_Vector ** X, ** Y;
532#else
533    Tcl_Obj ** X, ** Y;
534#endif
535  Tcl_Obj *stats;
536  char * name;
537  /* name of the syntax object, may be equal to name */
538  char * obj_name;
539  /* pointer to user object, valid only during construction */
540  BUserTimeSerie * tms_obj;
541  int add_segment(int * x, double * y, int n,
542                  Tcl_Interp * interp,
543                  Tol_SerieCursor * tsc);
544  void ComputeStats( BUserTimeSerie * uts )
545  {
546    if ( uts ) {
547      if ( stats ) {
548        Tcl_DecrRefCount( stats );
549      }
550      stats = Tol_GetAllSerieStats( uts );
551      Tcl_IncrRefCount( stats );
552    }
553  }
554};
555
556static Tol_SerieData * Tol_AllocSerieData _ANSI_ARGS_((void));
557static void Tol_FreeSerieData _ANSI_ARGS_((Tol_SerieData *tsd));
558
559#define GROW_DATING_BUFFER 10
560
561struct Tol_SerieGroup {
562  Tcl_Interp * interp;
563 
564  /* basic dating, common to every serie in the group */
565  Tcl_DString format;
566  BDate * dating;
567  char * dating_name;
568  int     dating_length;
569  int   dating_size;
570 
571  /* list of serie data */
572  int size;
573  Tol_SerieData ** series_data;
574
575  /* list of ticks markers */
576
577  CSetOfTicksData ticks_markers;
578 
579  /* token used to remove the command */
580 
581  Tcl_Command cmd_token;
582
583  int AddDate( BDate & date );
584  int AddTicks( int objc, Tcl_Obj * CONST objv[] );
585  int RemoveTicks( int objc, Tcl_Obj * CONST objv[] );
586  int SetFormat( char * fmt );
587  int GetFormat();
588  int ReturnDate( int idx, char * str_idx );
589  int ReturnDatingName();
590};
591
592static Tol_SerieGroup * Tol_AllocSerieGroup _ANSI_ARGS_((void));
593
594static void Tol_FreeSerieGroup _ANSI_ARGS_((Tol_SerieGroup * tsg));
595
596static int Tol_GroupFindSerie _ANSI_ARGS_((char * name,
597                                           Tol_SerieGroup * sgrp));
598
599static int Tol_GroupFindSerie _ANSI_ARGS_((BUserTimeSerie * obj,
600                                           Tol_SerieGroup * sgrp));
601
602int Tol_SerieGroup::AddDate( BDate & date ) {
603  if ( dating_length == dating_size ) {
604    dating_size += GROW_DATING_BUFFER;
605    dating = (BDate*)Tcl_Realloc( (char*)dating,
606                                  dating_size*sizeof(BDate) );
607  }
608  dating[dating_length] = date;
609  ++dating_length;
610  return TCL_OK;
611}
612
613int Tol_SerieGroup::AddTicks( int objc, Tcl_Obj * CONST objv[] )
614{
615  char * tsn;
616  int idx;
617  Tol_TicksData * ttd;
618  Tcl_Obj ** items;
619  int length;
620  int tcl_code;
621  Tcl_DString uniBuffer;
622
623  BGrammar * gra = GraTimeSet();
624
625  if ( !gra ) {
626    Tcl_AppendResult(interp,
627                     "TimeSet grammar not found", NULL);
628    return TCL_ERROR;
629  }
630
631  BUserTimeSet * uts;
632
633  CTickCursor * tickCursor;
634  CTickCursor_TOL tolCursor( dating, dating_length  );
635  CTickCursor_TCL tclCursor( dating, dating_length );
636  BDate current;
637  int ctick;
638
639  for ( int i = 0; i < objc; i++ ) {
640    tcl_code = Tcl_ListObjGetElements( interp, objv[i], &length, &items );
641    if ( tcl_code != TCL_OK )
642      return tcl_code;
643    if ( !length ) {
644      Tcl_AppendResult( interp, "empty tick set name", NULL );
645      return TCL_ERROR;
646    }
647    tsn = Tcl_GetString( items[0] );
648    idx = ticks_markers.Find( tsn );
649    if ( idx != -1 ) {
650      ttd = ticks_markers.Get( idx );
651      if ( ttd->valid ) {
652        Tcl_AppendResult( interp, "tick set '", tsn,
653                          "' already exists", NULL );
654        return TCL_ERROR;
655      } else {
656        /* should be a previous TimeSet, so use it */
657        ttd->valid = 1;
658        continue;
659      }
660    } else {
661      if ( length == 1 ) {
662        Tcl_DStringInit( &uniBuffer );
663        Tcl_UtfToExternalDString(NULL, tsn, -1,&uniBuffer);
664        uts = (BUserTimeSet *)(gra->FINDVARIABLE(uniBuffer.string));
665        Tcl_DStringFree(&uniBuffer);
666        if ( !uts ) {
667          Tcl_AppendResult( interp, "object timeset '",
668          tsn, "' not found", NULL );
669          return TCL_ERROR;
670        }
671        /* CACHE: try to fill cache for uts */
672        tolCursor.SetData( uts );
673        tickCursor = &tolCursor;
674        idx = ticks_markers.New();
675        ttd = ticks_markers.Get( idx );
676        ttd->SetInfo( tsn, TICK_TOL );
677      } else {
678        /* verificar las fechas y construir un array de BDate */
679        if ( !tclCursor.SetData( interp, length-1, items+1 ) ) {
680          Tcl_AppendResult( interp, "\nError in cursor", NULL );
681          ticks_markers.Release( idx );
682          return TCL_ERROR;
683        }
684        tickCursor = &tclCursor;
685        idx = ticks_markers.New();
686        ttd = ticks_markers.Get( idx );
687        ttd->SetInfo( tsn, TICK_TCL );
688      }
689      /* recorrer tickCursor para rellenar ttd */
690      if ( !tickCursor->Start() ) {
691        Tcl_AppendResult( interp, "\nError in cursor", NULL );
692        ticks_markers.Release( idx );
693        return TCL_ERROR;
694      }
695      while ( (ctick = tickCursor->Current()) != TICK_END ) {
696        // add tick;
697        ttd->new_tick( ctick );
698        if ( !tickCursor->Next() ) {
699          Tcl_AppendResult( interp, "\nError in cursor", NULL );
700          ticks_markers.Release( idx );
701          return TCL_ERROR;
702        }
703      }
704    }
705  }
706  return TCL_OK;
707}
708
709int Tol_SerieGroup::RemoveTicks( int objc, Tcl_Obj * CONST objv[] )
710{
711  char * tms;
712  int idx;
713
714  for ( int i = 0; i < objc; i++ ) {
715    tms = Tcl_GetString( objv[i] );
716    idx = ticks_markers.Find( tms );
717    if ( idx == -1 || !ticks_markers.Get(idx)->valid ) {
718      Tcl_AppendResult( interp, "time set '", tms,
719                        "' not found", NULL );
720      return TCL_ERROR;
721    }
722    ticks_markers.Release( idx );
723  }
724  return TCL_OK;
725}
726
727int Tol_SerieGroup::SetFormat( char * fmt )
728{
729  Tcl_DStringSetLength( &format, strlen(fmt) );
730  strcpy( format.string, fmt );
731  return TCL_OK;
732}
733
734int Tol_SerieGroup::GetFormat()
735{
736  char * fmt;
737
738  if ( Tcl_DStringLength( &format ) )
739    fmt = Tcl_DStringValue( &format );
740  else
741    fmt = ((BText&)(BDateFormat::Defect().Format())).Buffer();
742  Tcl_SetResult( interp, fmt, TCL_VOLATILE );
743  return TCL_OK;
744}
745
746int Tol_SerieGroup::ReturnDate( int idx, char * str_idx )
747{
748  BDateFormat bformat( BDateFormat::Defect() );
749  Tcl_DString dstr;
750
751  if ( Tcl_DStringLength( &format ) )
752    bformat = BDateFormat( Tcl_DStringValue( &format ) );
753
754  BText btxt( bformat.DateToText( dating[idx] ) );
755 
756  Tcl_DStringInit( &dstr );
757  Tcl_ExternalToUtfDString( NULL , btxt.Buffer(), -1, &dstr );
758  Tcl_DStringResult( interp, &dstr );
759  Tcl_DStringFree( &dstr );
760
761  return TCL_OK;
762}
763
764int Tol_SerieGroup::ReturnDatingName()
765{
766  if (dating_name)
767    Tcl_SetResult( interp, dating_name, TCL_VOLATILE );
768  else
769    Tcl_SetResult( interp, "", TCL_VOLATILE );
770  return TCL_OK;
771}
772
773/*
774 * Tol_SerieCursor : used to build a group of series
775 */
776
777struct Tol_SerieCursor {
778  /* bounds of the group of series */
779  static BDate lowerD, upperD;
780  static void InitBounds() {
781    lowerD = BDate::Begin();
782    upperD = BDate::End();
783  }
784  /* current date in tms, start in first */
785  BDate cur_date;
786  /* last date to see */
787  BDate until_date;
788  /* is the serie unbounded */
789  unsigned char lowerU, upperU;
790  /* serie with data */
791  BUserTimeSerie * serie;
792  /* dating of serie */
793  BUserTimeSet * tms;
794  /* all indexes, to light the memory manager */
795  int * _x_;
796  /* all data, to light the memory manager */
797  double * _y_;
798 
799  /*
800   * indexes of the current segment, respect to _x_ & _y_
801   * represent the boundaries of current segment
802   */
803 
804  int idx0, idx1;
805  Tol_SerieData * tsd;
806  /* tsd->size <= size */
807#define SEG_GROW 10
808  int size;
809  void append(int x, double y) {
810    ++idx1;
811    _x_[idx1] = x;
812    _y_[idx1] = y;
813  }
814  void new_segment(Tcl_Interp * interp) {
815    if (idx0<=idx1) {
816      tsd->add_segment(_x_+idx0,_y_+idx0,idx1-idx0+1,interp,this);
817      idx0 = idx1+1;
818    }
819  }
820  /* useful <==> cur_date <= until_date */
821  int useful;
822  int operator<= (Tol_SerieCursor & c) {
823    return !useful || cur_date <= c.cur_date;
824  }
825  int operator== (Tol_SerieCursor & c) {
826    return cur_date == c.cur_date;
827  }
828  int next_date() {
829    cur_date += tms;
830    if (cur_date>until_date)
831      useful = 0;
832    return useful;
833  }
834};
835
836BDate Tol_SerieCursor::lowerD = BDate::Begin();
837BDate Tol_SerieCursor::upperD = BDate::End();
838
839int Tol_SerieData::add_segment(int * x, double * y, int n,
840                               Tcl_Interp * interp,
841                               Tol_SerieCursor * tsc)
842{
843  if (size == tsc->size) {
844    tsc->size += SEG_GROW;
845#ifdef USE_BLT_VECTOR
846    X = (Blt_Vector**)Tcl_Realloc((char*)X,sizeof(Blt_Vector*)*tsc->size);
847#else
848    X = (Tcl_Obj**)Tcl_Realloc((char*)X,sizeof(Tcl_Obj*)*tsc->size);
849#endif
850    if (!X)
851      return TCL_ERROR;
852#ifdef USE_BLT_VECTOR
853    Y = (Blt_Vector**)Tcl_Realloc((char*)Y,sizeof(Blt_Vector*)*tsc->size);
854#else
855    Y = (Tcl_Obj**)Tcl_Realloc((char*)Y,sizeof(Tcl_Obj*)*tsc->size);
856#endif
857    if (!Y)
858      return TCL_ERROR;
859  }
860#ifdef USE_BLT_VECTOR
861  tcl_code = Blt_CreateVector(interp,"#auto",n,X+size);
862  if (tcl_code!=TCL_OK)
863    return TCL_ERROR;
864  Blt_Vector * xv = X[size];
865  tcl_code = Blt_CreateVector(interp,"#auto",n,Y+size);
866  if (tcl_code!=TCL_OK)
867    return TCL_ERROR;
868  Blt_Vector * yv = Y[size];
869  for (int i=0; i<n; ++i) {
870    xv->valueArr[i] = x[i];
871    yv->valueArr[i] = y[i];
872  }
873#else
874  Tcl_Obj ** itemsX = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*)*n);
875  Tcl_Obj ** itemsY = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*)*n);
876  for (int i=0; i<n; ++i) {
877    itemsX[i] = Tcl_NewDoubleObj(x[i]);
878    itemsY[i] = Tcl_NewDoubleObj(y[i]);
879  }
880  Tcl_IncrRefCount(X[size]=Tcl_NewListObj(n, itemsX));
881  Tcl_IncrRefCount(Y[size]=Tcl_NewListObj(n, itemsY));
882#endif
883  ++size;
884  return TCL_OK;
885}
886
887/*
888 *  Tol_CreateSerieGrp --
889 *
890 */
891
892int Tol_CreateSerieGrp(Tcl_Interp * interp,
893                       int objc, Tcl_Obj *CONST series[], Tcl_Obj * obj_result)
894{
895  int tcl_code;
896  Tol_SerieGroup * sgrp = NULL;
897  Tcl_CmdInfo cmd_info;
898  char * sgrp_name = Tcl_GetString(series[0]);
899 
900  if (!*sgrp_name) {
901    Tcl_AppendStringsToObj(obj_result,
902                           "invalid serie group name\"",sgrp_name,"\"",NULL);
903    return TCL_ERROR;
904  }
905 
906  /* verify if sgrp_name already exists as a group of series */
907 
908  if (Tcl_GetCommandInfo(interp,sgrp_name,&cmd_info) &&
909      (cmd_info.objProc == Tol_SerieGrpObjCmd)) {
910    Tcl_AppendStringsToObj(obj_result, "\"",sgrp_name,"\"",
911                           " already exists as a group of series object",NULL);
912    return TCL_ERROR;
913  }
914
915  /* check for date interval */
916  BDate I0,I1;
917  int isDefault = 1;
918  if ( !strcmp(Tcl_GetString(series[1]),"-range") ) {
919    int datec;
920    Tcl_Obj ** datev;
921
922    if ( objc < 4 ) {
923      Tcl_AppendStringsToObj(obj_result,
924                             "wrong # args: should be \"",
925                             "tol::seriegrp create grpName -range range serName ?serName?\"", NULL );
926      return TCL_ERROR;
927    }
928
929    tcl_code = Tcl_ListObjGetElements(interp,series[2],&datec,&datev);
930    if (tcl_code != TCL_OK) {
931      Tcl_AppendObjToObj(obj_result,Tcl_GetObjResult(interp));
932      return TCL_ERROR;
933    }
934    if (datec == 1) {
935      /* try to convert to an interval */
936      tcl_code = Tol_ParseDate(interp,Tcl_GetString(datev[0]),I0);
937      if (tcl_code!=TCL_OK) {
938        Tcl_AppendObjToObj(obj_result,Tcl_GetObjResult(interp));
939        return TCL_ERROR;
940      }
941      I1 = BDate::DefaultLast();
942    } else if (datec==2) {
943      /* try to convert to an interval */
944      tcl_code = Tol_ParseDate(interp,Tcl_GetString(datev[0]),I0);
945      if (tcl_code!=TCL_OK) {
946        Tcl_AppendObjToObj(obj_result,Tcl_GetObjResult(interp));
947        return TCL_ERROR;
948      }
949      tcl_code = Tol_ParseDate(interp,Tcl_GetString(datev[1]),I1);
950      if (tcl_code!=TCL_OK) {
951        Tcl_AppendObjToObj(obj_result,Tcl_GetObjResult(interp));
952        return TCL_ERROR;
953      }
954    } else {
955      Tcl_AppendStringsToObj(obj_result,"invalid range list",NULL);
956      return TCL_ERROR;
957    }
958    if (I0>I1) {
959      Tcl_SetStringObj(obj_result,"improper date range",-1);
960      return TCL_ERROR;
961    }
962    isDefault = 0;
963    // skip three arguments.
964    objc -=3;
965    series += 3;
966  } else {
967    I0 = BDate::DefaultFirst();
968    I1 = BDate::DefaultLast();
969    isDefault = 1;
970    --objc;
971    ++series;
972  }
973  if (objc==0) {
974    Tcl_SetStringObj(obj_result,
975                     "wrong # args, missing serie names arguments",-1);
976    return TCL_ERROR;
977
978  }
979  tcl_code = Tol_CreateSerieGrpData(interp,objc,series,&sgrp,
980                                    I0,I1,isDefault,obj_result);
981  if ( tcl_code != TCL_OK ) {
982    Tol_FreeSerieGroup(sgrp);
983    return TCL_ERROR;
984  }
985 
986  /* now is ok to create the obj cmd */
987 
988  sgrp->cmd_token = Tcl_CreateObjCommand(interp,sgrp_name,Tol_SerieGrpObjCmd,
989                                         (ClientData) sgrp,Tol_SerieGrpDelCmd);
990  sgrp->interp = interp;
991  Tcl_SetStringObj(obj_result,sgrp_name,-1);
992  return TCL_OK;
993}
994
995
996/*
997 *  Tol_CreateSerieGrp --
998 *
999 *    to be called directly from C++.
1000 */
1001
1002int Tol_CreateSerieGrp(Tcl_Interp * interp,
1003                       char * sgrp_name, BList *series, Tcl_Obj * obj_result)
1004{
1005  int tcl_code;
1006  Tol_SerieGroup * sgrp;
1007  Tcl_CmdInfo cmd_info;
1008 
1009  if (!*sgrp_name) {
1010    Tcl_AppendStringsToObj(obj_result,
1011                           "invalid serie group name\"",sgrp_name,"\"",NULL);
1012    return TCL_ERROR;
1013  }
1014 
1015  /* verify if sgrp_name already exists as a group of series */
1016 
1017  if (Tcl_GetCommandInfo(interp,sgrp_name,&cmd_info)) {
1018    Tcl_AppendStringsToObj(obj_result, "\"",sgrp_name,"\"",
1019                           " already exists as a group of series object",NULL);
1020    return TCL_ERROR;
1021  }
1022
1023  /* check for date interval */
1024  BDate I0,I1;
1025  I0 = BDate::DefaultFirst();
1026  I1 = BDate::DefaultLast();
1027  int isDefault = 1;
1028
1029  tcl_code = Tol_CreateSerieGrpData(interp,series,&sgrp,
1030                                    I0,I1,isDefault,obj_result);
1031  if ( tcl_code != TCL_OK ) {
1032    Tol_FreeSerieGroup(sgrp);
1033    return TCL_ERROR;
1034  }
1035 
1036  /* now is ok to create the obj cmd */
1037 
1038  sgrp->cmd_token = Tcl_CreateObjCommand(interp,sgrp_name,Tol_SerieGrpObjCmd,
1039                                         (ClientData) sgrp,Tol_SerieGrpDelCmd);
1040  sgrp->interp = interp;
1041  Tcl_SetStringObj(obj_result,sgrp_name,-1);
1042  return TCL_OK;
1043}
1044
1045/*
1046 * Destroy a list of series groups.
1047 *
1048 */
1049
1050int Tol_DestroySerieGrp (Tcl_Interp * interp,
1051                         int objc, Tcl_Obj *CONST objv[],
1052                         Tcl_Obj * obj_result)
1053{
1054  Tcl_CmdInfo cmd_info;
1055  char * sgrp_name;
1056 
1057  for (int i=0; i<objc; ++i) {
1058    sgrp_name = Tcl_GetString(objv[i]);
1059    if (Tcl_GetCommandInfo(interp,sgrp_name,&cmd_info) &&
1060        (cmd_info.objProc == Tol_SerieGrpObjCmd)) {
1061      if (Tcl_DeleteCommand(interp,sgrp_name)) {
1062        Tcl_AppendStringsToObj(obj_result,
1063                               "could not delete \"",sgrp_name,"\"",NULL);
1064        return TCL_ERROR;
1065      }
1066    } else {
1067      Tcl_AppendStringsToObj(obj_result,
1068                             "can't find serie group \"",sgrp_name,"\"",NULL);
1069      return TCL_ERROR;
1070    }
1071  }
1072  Tcl_ResetResult(interp);
1073  return TCL_OK;
1074}
1075
1076/*
1077 *  Tol_SerieGrpObjCmd --
1078 *
1079 *    implement an specific group of series given by clientData.
1080 *
1081 *    seriegrp dating (size|idx|name)
1082 *
1083 *           seriegrp dating size --> return the basic dating size
1084 *
1085 *           seriegrp dating idx --> return the date info for the idx
1086 *                                   element of the basic dating.
1087 *
1088 *      seriegrp dating name --> return the name of the common (possibly)
1089 *            dating
1090 *
1091 *    seriegrp serie (size|(idx (name|data|stat)))
1092 *
1093 *      seriegrp serie size --> return the number of series
1094 *
1095 *      seriegrp serie idx name -> return the name of ith serie.
1096 * 
1097 *           seriegrp serie idx data -->
1098 *                             
1099 *                             return a 2 element list with the serie
1100 *                             data corresponding to serName. The
1101 *                             first element is a * BLT vector name
1102 *                             representing the indexes in the basic
1103 *                             dating, * the second one is a vector
1104 *                             with corresponding values.
1105 *
1106 *      seriegrp serie idx reference -> return
1107 *
1108 *      seriegrp serie idx stats -> return the statistics for the serie
1109 *
1110 *      seriegrp format ?strfmt?
1111 *
1112 *      seriegrp ticks ...
1113 *
1114 *        seriegrp ticks add tms ?tms?
1115 *
1116 *        seriegrp ticks remove tms ?tms?
1117 *
1118 *        seriegrp ticks get tms
1119 */
1120
1121
1122int Tol_SerieGrpObjCmd (ClientData clientData,
1123                        Tcl_Interp *interp,
1124                        int objc, Tcl_Obj *CONST objv[])
1125{
1126  int tcl_code;
1127  int idx;
1128
1129#ifdef __RELEASE__
1130  try_crash {
1131#endif
1132    Tol_SerieGroup * sgrp = (Tol_SerieGroup*) clientData;
1133 
1134    if ( objc < 2 ) {
1135      Tcl_AppendResult(interp,
1136                       "wrong # args: should be \"",
1137                       Tcl_GetString(objv[0]),
1138                       " option\"", NULL );
1139      return TCL_ERROR;
1140    }
1141 
1142    char * option = Tcl_GetString(objv[1]);
1143    int length = strlen(option);
1144    char * arg = NULL;
1145
1146    if ( objc >= 3)
1147      arg = Tcl_GetString(objv[2]);
1148 
1149    if (length && !strncmp("dating",option,length)) {
1150      if (objc != 3) {
1151        Tcl_AppendResult(interp,
1152                         "wrong # args: should be \"",
1153                         Tcl_GetString(objv[0]),
1154                         " dating arg\"", NULL );
1155        return TCL_ERROR;
1156      }
1157      if (!strcmp("name",arg))
1158        return sgrp->ReturnDatingName();
1159      else if (!strcmp("size",arg)) {
1160        Tcl_SetObjResult(interp,Tcl_NewIntObj(sgrp->dating_length));
1161        return TCL_OK;
1162      } else {
1163        tcl_code = Tol_GetIntIndex(interp,objv[2],"",
1164                                   sgrp->dating_length-1,&idx);
1165        if (tcl_code == TCL_ERROR)
1166          return TCL_ERROR;
1167        //tcl_code = Tcl_ListObjIndex(interp,sgrp->dating,idx,&obj_result);
1168
1169        return sgrp->ReturnDate( idx, Tcl_GetString(objv[2]) );
1170      }
1171    } else if (length && !strncmp("serie",option,length)) {
1172      if ( objc < 3 ) {
1173        Tcl_AppendResult(interp,
1174                         "wrong # args: should be \"",
1175                         Tcl_GetString(objv[0]),
1176                         " option args\"", NULL );
1177        return TCL_ERROR;
1178      }
1179      if (!strcmp("size",arg)) {
1180        if (objc != 3) {
1181          Tcl_AppendResult(interp,
1182                           "extra args: should be \"",
1183                           Tcl_GetString(objv[0]),
1184                           " serie size\"", NULL );
1185          return TCL_ERROR;
1186        }
1187        Tcl_SetObjResult(interp,Tcl_NewIntObj(sgrp->size));
1188        return TCL_OK;
1189      }
1190      if (objc != 4) {
1191        Tcl_AppendResult(interp,
1192                         "wrong # args: should be \"",
1193                         Tcl_GetString(objv[0]),
1194                         " serie idx arg\"", NULL );
1195        return TCL_ERROR;
1196      }
1197      tcl_code = Tol_GetIntIndex(interp,objv[2],"",
1198                                 sgrp->size-1,&idx);
1199      if (tcl_code == TCL_ERROR)
1200        return TCL_ERROR;
1201   
1202      Tol_SerieData * sdata = sgrp->series_data[idx];
1203
1204      arg = Tcl_GetString(objv[3]);
1205      if (!strcmp(arg,"name")) {
1206        Tcl_AppendResult(interp,sdata->obj_name,NULL);
1207        return TCL_OK;
1208      }
1209      if (!strcmp(arg,"reference")) {
1210        Tcl_AppendResult(interp,sdata->name,NULL);
1211        return TCL_OK;
1212      }
1213      if ( !strcmp(arg,"stats") ) {
1214        Tcl_SetObjResult( interp, sdata->stats );
1215        return TCL_OK;
1216      }
1217      if (strcmp(arg,"data")) {
1218        Tcl_AppendResult(interp,"invalid option, must be: name, data or reference", NULL);
1219        return TCL_ERROR;
1220
1221      }
1222      /* extract the vector names from the serie data or vector values*/
1223   
1224      Tcl_Obj * XY[2];
1225      Tcl_Obj ** segments = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*)*sdata->size);
1226   
1227   
1228      for (int i=0; i<sdata->size; i++) {
1229#ifdef USE_BLT_VECTOR
1230        XY[0] = Tcl_NewStringObj(Blt_NameOfVector(sdata->X[i]),-1);
1231        XY[1] = Tcl_NewStringObj(Blt_NameOfVector(sdata->Y[i]),-1);
1232#else
1233        XY[0] = sdata->X[i];
1234        XY[1] = sdata->Y[i];
1235#endif
1236        segments[i] = Tcl_NewListObj(2,XY);
1237      }
1238      Tcl_SetObjResult(interp,Tcl_NewListObj(sdata->size,segments));
1239      Tcl_Free( (char*)segments );
1240      return TCL_OK;
1241    } else if ( !strncmp( "format", option, length ) ) {
1242      if ( objc > 3 ) {
1243        Tcl_AppendResult( interp, "wrong # args, should be: '",
1244                          Tcl_GetString( objv[0] ), " ", option,
1245                          " strformat'", NULL );
1246        return TCL_ERROR;
1247      }
1248      /* implementar la opcion de formato aqui */
1249      /* almacenar en una variable para cuando se pida una fecha */
1250      if ( objc == 3 )
1251        return sgrp->SetFormat( Tcl_GetString( objv[2] ) );
1252      else
1253        return sgrp->GetFormat();
1254    } else if ( !strncmp( "ticks", option, length ) ) {
1255      if ( objc < 4 ) {
1256        Tcl_AppendResult( interp, "wrong # args, should be:\n",
1257                          Tcl_GetString( objv[0] ), " ticks add tms ?tms?\n",
1258                          Tcl_GetString( objv[0] ), " ticks get tms\n",
1259                          Tcl_GetString( objv[0] ), " ticks remove tms ?tms?", NULL );
1260        return TCL_ERROR;
1261      }
1262      char * subopt = Tcl_GetString( objv[2] );
1263      length = strlen( subopt );
1264      if ( length && !strncmp( "add", subopt, length ) )
1265        return sgrp->AddTicks( objc-3, objv+3 );
1266      else if ( length && !strncmp( "get", subopt, length ) ) {
1267        Tol_TicksData * ttd;
1268        idx = sgrp->ticks_markers.Find( Tcl_GetString(objv[3] ) );
1269        if ( idx == -1 ||
1270             !((ttd=sgrp->ticks_markers.Get(idx))->valid) ) {
1271          Tcl_AppendResult( interp, "time set '", Tcl_GetString(objv[3]),
1272                            "' not found", NULL );
1273          return TCL_ERROR;
1274        }
1275        return ttd->ReturnTicks( interp );
1276      } else if ( length && !strncmp( "remove", subopt, length ) )
1277        return sgrp->RemoveTicks( objc-3, objv+3 );
1278      else {
1279        Tcl_AppendResult( interp, "Invalid option '", subopt,
1280                          "' should be: add, get or remove", NULL );
1281        return TCL_ERROR;
1282      }
1283    } else {
1284      Tcl_AppendResult(interp, "bad option \"",option,
1285                       "\": must be dating, format, serie or ticks",NULL);
1286      return TCL_ERROR;
1287    }
1288#ifdef __RELEASE__
1289  } catch_crash {
1290    Tcl_AppendResult(interp,
1291                     "Fatal error in seriegrp subcommand, kill the application",
1292                     NULL);
1293    return TCL_ERROR;
1294  }
1295#endif
1296}
1297
1298static
1299int Tol_GetIntIndex(Tcl_Interp * interp, Tcl_Obj * obj,
1300                    const char * keys, int max, int * idx)
1301{
1302  if (!strcmp("end",Tcl_GetString(obj)))
1303    *idx = max;
1304  else if (Tcl_GetIntFromObj(interp,obj,idx)==TCL_OK) {
1305    if (*idx < 0 || *idx > max) {
1306      char str_max[1024];
1307      sprintf(str_max,"%d",max);
1308      Tcl_AppendResult(interp,"index out of range \"",
1309                       Tcl_GetString(obj),
1310                       "\": must be not negative and no greater than ",
1311                       str_max,NULL);
1312      return TCL_ERROR;
1313    }
1314  } else {
1315    char empty[] = "";
1316    if (!keys)
1317      keys = empty;
1318    Tcl_AppendResult(interp,"\ninvalid index \"",
1319                     Tcl_GetString(obj),
1320                     "\": must be ",keys,", integer or end",NULL);
1321    return TCL_ERROR;
1322  }
1323  return TCL_OK;
1324}
1325
1326void Tol_SerieGrpDelCmd (ClientData clientData)
1327{
1328  Tol_SerieGroup * tsg = (Tol_SerieGroup*) clientData;
1329 
1330  Tol_FreeSerieGroup(tsg);
1331}
1332
1333static
1334Tol_SerieData * Tol_AllocSerieData(void)
1335{
1336  Tol_SerieData * tsd = (Tol_SerieData *)Tcl_Alloc(sizeof(Tol_SerieData));
1337 
1338  if (tsd) {
1339    tsd->size = 0;
1340    tsd->X = tsd->Y = NULL;
1341    tsd->name = NULL;
1342    tsd->obj_name = NULL;
1343    tsd->tms_obj = NULL;
1344    tsd->stats = Tcl_NewObj();
1345    Tcl_IncrRefCount( tsd->stats );
1346  }
1347  return tsd;
1348}
1349
1350static
1351void Tol_FreeSerieData(Tol_SerieData *tsd)
1352{
1353  if (tsd) {
1354    if (tsd->size) {
1355      for (int i=0; i<tsd->size; ++i) {
1356#ifdef USE_BLT_VECTOR
1357        Blt_DeleteVector(tsd->X[i]);
1358        Blt_DeleteVector(tsd->Y[i]);
1359#else
1360        Tcl_DecrRefCount(tsd->X[i]);
1361        Tcl_DecrRefCount(tsd->Y[i]);
1362#endif
1363      }
1364      Tcl_Free((char*)tsd->X);
1365      Tcl_Free((char*)tsd->Y);
1366    }
1367    if (tsd->name)
1368      Tcl_Free(tsd->name);
1369    if (tsd->obj_name)
1370      Tcl_Free(tsd->obj_name);
1371    Tcl_DecrRefCount( tsd->stats );
1372    Tcl_Free((char*)tsd);
1373  }
1374}
1375
1376static
1377void Tol_InitTicksData( Tol_TicksData & ttd )
1378{
1379  ttd.length = 0;
1380  ttd.size = 0;
1381  ttd.ticks = NULL;
1382  ttd.name = NULL;
1383  ttd.valid = 0;
1384  ttd.type = TICK_TCL;
1385}
1386
1387static
1388void Tol_FreeTicksData( Tol_TicksData & ttd )
1389{
1390  if (ttd.ticks) {
1391    Tcl_Free((char*)ttd.ticks);
1392    ttd.length = 0;
1393    ttd.size = 0;
1394    ttd.ticks = NULL;
1395  }
1396  if (ttd.name) {
1397    Tcl_Free(ttd.name);
1398    ttd.name = NULL;
1399  }
1400  ttd.valid = 0;
1401  ttd.type = TICK_TCL;
1402}
1403
1404static
1405void Tol_ReleaseTicksData( Tol_TicksData & ttd )
1406{
1407  if ( ttd.type == TICK_TOL )
1408    ttd.valid = 0;
1409  else
1410    Tol_FreeTicksData(ttd);
1411}
1412
1413static
1414Tol_SerieGroup * Tol_AllocSerieGroup(void)
1415{
1416  Tol_SerieGroup * tsg = (Tol_SerieGroup *)Tcl_Alloc(sizeof(Tol_SerieGroup));
1417 
1418  if (tsg) {
1419    tsg->interp = NULL;
1420    Tcl_DStringInit( &(tsg->format) );
1421    tsg->dating = NULL;
1422    tsg->dating_name = NULL;
1423    tsg->dating_length = 0;
1424    tsg->dating_size = 0;
1425    tsg->size = 0;
1426    tsg->series_data = NULL;
1427    tsg->ticks_markers.Init();
1428  }
1429  return tsg;
1430}
1431
1432static
1433void Tol_FreeSerieGroup(Tol_SerieGroup * tsg)
1434{
1435  if (tsg) {
1436    int i;
1437    Tcl_DStringFree( &(tsg->format) );
1438    if (tsg->dating) {
1439      Tcl_Free((char*)tsg->dating);
1440    }
1441    if (tsg->dating_name) {
1442      Tcl_Free((char*)tsg->dating_name);
1443    }
1444    if (tsg->series_data) {
1445      for ( i = 0; i < tsg->size; ++i)
1446        Tol_FreeSerieData(tsg->series_data[i]);
1447      Tcl_Free((char*)tsg->series_data);
1448    }
1449    tsg->ticks_markers.Destroy();
1450    Tcl_Free((char*)tsg);
1451  }
1452}
1453
1454static
1455int Tol_GroupFindSerie(BUserTimeSerie * obj, Tol_SerieGroup * tsg)
1456{
1457  if (tsg) {
1458    for (int i=0; i<tsg->size; ++i)
1459      if (obj == tsg->series_data[i]->tms_obj)
1460        return i;
1461  }
1462  return -1;
1463}
1464
1465static
1466int Tol_GroupFindSerie(char * name, Tol_SerieGroup * tsg)
1467{
1468  if (tsg) {
1469    for (int i=0; i<tsg->size; ++i)
1470      if (!strcmp(name,tsg->series_data[i]->name))
1471        return i;
1472  }
1473  return -1;
1474}
1475
1476static
1477Tol_SerieCursor * Tol_AllocSerieCursor(void)
1478{
1479  Tol_SerieCursor * tsc = (Tol_SerieCursor *)Tcl_Alloc(sizeof(Tol_SerieCursor));
1480 
1481  if (tsc) {
1482    tsc->serie = NULL;
1483    tsc->tms = NULL;
1484    tsc->_x_ = NULL;
1485    tsc->_y_ = NULL;
1486    tsc->idx0 = tsc->idx1 = -1;
1487    tsc->tsd = NULL;
1488    tsc->size=0;
1489    tsc->useful = 0;
1490  }
1491  return tsc;
1492}
1493
1494static
1495void Tol_FreeSerieCursor(Tol_SerieCursor * tsc)
1496{
1497  if (tsc) {
1498    if (tsc->_x_)
1499      Tcl_Free((char*)tsc->_x_);
1500    if (tsc->_x_)
1501      Tcl_Free((char*)tsc->_y_);
1502    Tcl_Free((char*)tsc);
1503  }
1504}
1505
1506/*
1507 * Tol_AllocMemoryForCursor --
1508 *
1509 */
1510
1511int Tol_AllocMemoryForCursor(Tol_SerieCursor * tsc) {
1512  int length;
1513 
1514  if (tsc->lowerU || tsc->upperU) {
1515    /* delay allocation until all bounded series are processed */
1516    tsc->useful = 0;
1517    return 1;
1518  }
1519 
1520  tsc->cur_date = tsc->tms->FirstNoLess(tsc->cur_date);
1521  tsc->until_date = tsc->tms->FirstNoGreat(tsc->until_date);
1522  tsc->useful = 1;
1523  length = tsc->tms->Difference(tsc->cur_date,tsc->until_date)+1;
1524  if (length<=0) {
1525    tsc->useful = 0;
1526    /* no tiene datos, no es error pero no es util */
1527    return 1;
1528  }
1529  tsc->_x_ = (int*)Tcl_Alloc(sizeof(int)*length);
1530  if (!tsc->_x_)
1531    return 0;
1532  tsc->_y_ = (double*)Tcl_Alloc(sizeof(double)*length);
1533  if (!tsc->_y_)
1534    return 0;
1535#ifdef USE_BLT_VECTOR
1536  tsc->tsd->X = (Blt_Vector**)Tcl_Alloc(sizeof(Blt_Vector*)*SEG_GROW);
1537#else
1538  tsc->tsd->X = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*)*SEG_GROW);
1539#endif
1540  if (!tsc->tsd->X)
1541    return 0;
1542#ifdef USE_BLT_VECTOR
1543  tsc->tsd->Y = (Blt_Vector**)Tcl_Alloc(sizeof(Blt_Vector*)*SEG_GROW);
1544#else
1545  tsc->tsd->Y = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*)*SEG_GROW);
1546#endif
1547  if (!tsc->tsd->Y)
1548    return 0;
1549  tsc->size = SEG_GROW;
1550  return 1;
1551}
1552
1553/*
1554 * Tol_InitSerieCursor --
1555 *
1556 *    Initialize a SerieCursor.
1557 *
1558 *      tsd -> SerieData to update
1559 *
1560 *      uts -> Data source with valid dating.
1561 *
1562 *
1563 */
1564
1565static
1566int Tol_InitSerieCursor (Tol_SerieCursor * tsc,
1567                         Tol_SerieData * tsd,
1568                         BUserTimeSerie * uts,
1569                         BDate & begin,
1570                         BDate & end, int RangeIsDefault)
1571{
1572  tsc->serie = uts;
1573
1574  tsc->cur_date = uts->FirstDate();
1575  tsc->until_date = uts->LastDate();
1576  tsc->lowerU = !tsc->cur_date.HasValue();
1577  tsc->upperU = !tsc->until_date.HasValue();
1578
1579  if ( RangeIsDefault ) {
1580    /*
1581    if ( tsc->lowerU )
1582      tsc->cur_date = begin;
1583    if ( tsc->upperU )
1584      tsc->until_date = end;
1585    */
1586    if ( !tsc->lowerD.HasValue() || (!tsc->lowerU && tsc->cur_date < tsc->lowerD) )
1587      tsc->lowerD = tsc->cur_date;
1588    if ( !tsc->upperD.HasValue() || (!tsc->upperU && tsc->until_date > tsc->upperD) )
1589      tsc->upperD = tsc->until_date;
1590  } else {
1591    /* Este camino se eliminara en un futuro cercano, es decir RangeIsDefault==1 */
1592    if ( tsc->lowerU || tsc->cur_date < begin )
1593      tsc->cur_date = begin;
1594    if ( tsc->upperU || tsc->until_date > end )
1595      tsc->until_date = end;
1596  }
1597
1598  tsc->tms = uts->Dating();
1599  tsc->idx0 = 0;
1600  tsc->idx1 = -1;
1601  tsc->tsd = tsd;
1602  /* CACHE: inicializar el HashBetween aqui?
1603   * [cur_date,until_date]
1604   */
1605  BHash hash;
1606  tsc->tms->GetHashBetween(hash, tsc->cur_date,tsc->until_date);
1607  return Tol_AllocMemoryForCursor(tsc);
1608}
1609
1610inline
1611int BadAlloc(Tcl_Interp * interp)
1612{
1613  Tcl_AppendResult(interp,
1614                   "could not allocate serie group data",NULL);
1615  return TCL_ERROR;
1616}
1617
1618#define _CHECK_PTR_(ptr) \
1619if (!ptr) return BadAlloc(interp);
1620
1621struct scursors {
1622  int last;
1623  int first_good;
1624  int first_sorted;
1625  Tol_SerieCursor ** data;
1626  scursors() {
1627    last = -1;
1628    first_good = 0;
1629    first_sorted = 0;
1630    data = NULL;
1631  }
1632  ~scursors() {
1633    if (data) {
1634      for (int i=0; i<=last; i++)
1635        Tol_FreeSerieCursor(data[i]);
1636      Tcl_Free((char*)data);
1637    }
1638  }
1639  void sort();
1640  int HasUseful() {
1641    return first_good <= last;
1642  }
1643  void compact( int bad ) {
1644    int n = bad - first_good;
1645    if ( n ) {
1646      Tol_SerieCursor * tmp = data[bad];
1647      memmove( data+first_good+1, data+first_good, sizeof(data[0]) * n );
1648      data[first_good] = tmp;
1649    }
1650  }
1651};
1652
1653void scursors::sort()
1654{
1655  int i,j,n;
1656  Tol_SerieCursor * tmp;
1657 
1658  while (first_good<=last && !data[first_good]->useful)
1659    ++first_good;
1660  if (first_good>last)
1661    return;
1662  for (i=first_sorted-1; i>=first_good; --i) {
1663    for (j=i+1; j<=last; j++)
1664      if (*(data[i])<=*(data[j]))
1665        break;
1666    n = j - i - 1;
1667    if ( n ) {
1668      tmp = data[i];
1669      memmove(data+i,data+i+1,sizeof(Tol_SerieCursor*)*n);
1670      data[i+n] = tmp;
1671    }
1672  }
1673  first_sorted = first_good;
1674}
1675
1676/*
1677 *  Tol_CreateSerieGrpData --
1678 *
1679 *    to be called from tcl interface.
1680 */
1681
1682static
1683int Tol_CreateSerieGrpData (Tcl_Interp * interp,
1684                            int objc, Tcl_Obj *CONST series[],
1685                            Tol_SerieGroup ** tsgPtr,
1686                            BDate & begin,
1687                            BDate & end,
1688                            int RangeIsDefault,
1689                            Tcl_Obj *obj_result)
1690{
1691 
1692  BGrammar * gra = GraSerie();
1693
1694  if ( !gra ) {
1695    Tcl_AppendStringsToObj( obj_result,
1696                            "Serie grammar not found", NULL );
1697    return TCL_ERROR;
1698  }
1699
1700  scursors cursors;
1701  Tol_SerieGroup * tsg = NULL;
1702
1703  *tsgPtr = NULL;
1704
1705  tsg = *tsgPtr = Tol_AllocSerieGroup();
1706  _CHECK_PTR_(tsg);
1707   
1708  /*
1709   * alloc space for serie data array
1710   * but for now it's empty
1711   */
1712 
1713  tsg->size = 0;
1714  tsg->series_data = (Tol_SerieData**)Tcl_Alloc(sizeof(Tol_SerieData*)*objc);
1715  _CHECK_PTR_(tsg->series_data);
1716 
1717  /*
1718   * alloc space for array of cursors
1719   * but for now it's empty
1720   */
1721 
1722  cursors.data = (Tol_SerieCursor**)Tcl_Alloc(sizeof(Tol_SerieCursor*)*objc);
1723  _CHECK_PTR_(cursors.data);
1724 
1725  /*
1726   * build cursor & serie data for every known serie
1727   */
1728 
1729  Tol_SerieData * tsd;
1730  BUserTimeSerie * uts;
1731  Tol_SerieCursor * tsc;
1732  char * sername;
1733  int str_len;
1734  int status;
1735  Tcl_DString uniBuffer;
1736  int flagDating = 0;
1737  BUserTimeSet * firstDating = 0;
1738 
1739  Tcl_DStringInit(&uniBuffer);
1740  Tol_SerieCursor::InitBounds();
1741  for (int i=0; i<objc; ++i) {
1742    /* verify serie */
1743    //sername = Tcl_UtfToExternalDString(NULL,Tcl_GetString(series[i]),-1,&uniBuffer);
1744    if ( Tol_GroupFindSerie(Tcl_GetString(series[i]),tsg) != -1 )
1745      continue;
1746    //uts = Tol_GetTimeSerie(interp,series[i]);
1747    uts = (BUserTimeSerie*)Tol_ResolveObject(interp, series[i], obj_result/*,
1748                                             gra*/);
1749    if ( !uts )
1750      return TCL_ERROR;
1751
1752    /* validate the string representation */
1753
1754    sername = Tcl_GetString(series[i]);
1755    if (!uts->HasDating()) {
1756      Tcl_AppendStringsToObj(obj_result, "'",
1757                             sername,
1758                             "' does not have dating", NULL );
1759      return TCL_ERROR;
1760    }
1761    /* exists and have dating */
1762   
1763    /* then alloc serie data */
1764   
1765    tsd = tsg->series_data[i] = Tol_AllocSerieData();
1766    _CHECK_PTR_(tsd);
1767    ++tsg->size;
1768
1769    str_len = strlen(sername);
1770    tsd->name = Tcl_Alloc(str_len+1);
1771    _CHECK_PTR_(tsd->name);
1772    strcpy(tsd->name,sername);
1773
1774    str_len = strlen(uts->Identify());
1775    tsd->obj_name = Tcl_Alloc(str_len+1);
1776    _CHECK_PTR_(tsd->obj_name);
1777    strcpy(tsd->obj_name,uts->Identify());
1778
1779    /* then alloc corresponding cursor */
1780   
1781    tsc = cursors.data[i] = Tol_AllocSerieCursor();
1782    _CHECK_PTR_(tsc);
1783    ++cursors.last;
1784    status = Tol_InitSerieCursor(tsc,tsd,uts,begin,end,RangeIsDefault);
1785    if (!status) {
1786      if (tsc->useful)
1787        return BadAlloc(interp);
1788      /* por aqui no deberia pasar, REVISALO!!! */
1789      Tcl_AppendStringsToObj(obj_result,"invalid range of dates",NULL);
1790      return TCL_ERROR;
1791    }
1792    tsd->ComputeStats( uts );
1793
1794    if ( flagDating == 0 ) {
1795      flagDating = 1;
1796      firstDating = uts->Dating();
1797    } else if ( (flagDating == 1) && (firstDating != uts->Dating()) )
1798      flagDating = 2;
1799  }
1800
1801  /* now we have a set of cursors */
1802 
1803  if (cursors.last==-1) {
1804    Tcl_AppendStringsToObj(obj_result,
1805                           "the set of serie given have no data",NULL);
1806    return TCL_ERROR;
1807  }
1808
1809  if (!Tol_SerieCursor::lowerD.HasValue()) {
1810    /* All series are lower unbounded */
1811    Tol_SerieCursor::lowerD = begin;
1812  }
1813  if (!Tol_SerieCursor::upperD.HasValue()) {
1814    /* All series are upper unbounded */
1815    Tol_SerieCursor::upperD = end;
1816  }
1817   
1818  int iter, idx_dating = -1;
1819  int tcl_code;
1820  BDat dat;
1821  BDate cur_date;
1822  Tol_SerieCursor * iter_cursor;
1823  int isunbounded;
1824
1825  /* Now bound the unbounded cursors */
1826 
1827  for (iter=0; iter <= cursors.last; iter++) {
1828    tsc = cursors.data[iter];
1829    isunbounded = 0;
1830    if (tsc->lowerU) {
1831      /* is lower unbounded so bound it! */
1832      isunbounded = 1;
1833      tsc->cur_date = Tol_SerieCursor::lowerD;
1834      /* now on is not unbounded */
1835      tsc->lowerU = 0;
1836    }
1837    if (tsc->upperU) {
1838      /* is upper unbounded so bound it! */
1839      isunbounded = 1;
1840      tsc->until_date = Tol_SerieCursor::upperD;
1841     /* now on is not unbounded */
1842      tsc->upperU = 0;
1843    }
1844    if (isunbounded) {
1845      /* if unbounded ==> alloc resources */
1846      if (!Tol_AllocMemoryForCursor(tsc))
1847        return BadAlloc(interp);
1848    }
1849  }
1850
1851  cursors.first_good = 0;
1852  cursors.first_sorted = cursors.last;
1853  cursors.sort();
1854
1855  /* grow the interval if necessary */
1856  /*
1857    I think growing is not neccesary now
1858
1859  int new_length;
1860  int has_grown;
1861
1862  for ( iter = cursors.first_good; iter <= cursors.last; ++iter ) {
1863    tsc = cursors.data[iter];
1864    has_grown = 0;
1865    if ( tsc->lowerU && tsc->lowerD < tsc->cur_date ) {
1866      tsc->cur_date = tsc->tms->FirstNoLess( tsc->lowerD );
1867      has_grown = 1;
1868    }
1869    if ( tsc->upperU && tsc->upperD > tsc->until_date ) {
1870      tsc->until_date = tsc->tms->FirstNoGreat( tsc->upperD );
1871      has_grown = 1;
1872    }
1873    if ( has_grown ) {
1874      new_length = tsc->tms->Difference(tsc->cur_date,tsc->until_date)+1;
1875      tsc->_x_ = (int*)Tcl_Realloc((char*)tsc->_x_, sizeof(int)*new_length);
1876      if (!tsc->_x_)
1877        return BadAlloc(interp);
1878      tsc->_y_ = (double*)Tcl_Realloc((char*)tsc->_y_, sizeof(double)*new_length);
1879      if (!tsc->_y_)
1880        return BadAlloc(interp);
1881    }
1882  }
1883  */
1884 
1885  /* iter over the cursors */
1886
1887  while (cursors.HasUseful()) {
1888    iter = cursors.first_good;
1889    tsc = cursors.data[iter];
1890    cur_date = tsc->cur_date;
1891
1892    /* add this date to basic dating */
1893    tcl_code = tsg->AddDate(cur_date);
1894
1895    if (tcl_code != TCL_OK)
1896      return TCL_ERROR;
1897    ++idx_dating;
1898    /* update every serie data having this date in its dating */
1899    do {
1900      iter_cursor = cursors.data[iter];
1901      dat = (*(iter_cursor->serie))[cur_date];
1902      if (dat.IsKnown())
1903        iter_cursor->append(idx_dating,dat.Value());
1904      else
1905        iter_cursor->new_segment(interp);
1906      if (!iter_cursor->next_date()) {
1907        iter_cursor->new_segment(interp);
1908        cursors.compact( iter );
1909      }
1910      ++iter;
1911    } while (iter<=cursors.last && cur_date==cursors.data[iter]->cur_date);
1912    if (iter>cursors.last)
1913      cursors.first_sorted = cursors.last;
1914    else
1915      cursors.first_sorted = iter;
1916    cursors.sort();
1917  }
1918 
1919  if ( flagDating == 1 ) {
1920    tsg->dating_name = Tcl_Alloc(firstDating->Name().Length()+1);
1921    strcpy( tsg->dating_name, firstDating->Name() );
1922  }
1923
1924  /*tsg->dating_length = idx_dating+1;*/
1925  return TCL_OK;
1926}
1927
1928/*
1929 *  Tol_CreateSerieGrpData --
1930 *
1931 *    to be called from C++ interface.
1932 */
1933
1934static
1935int Tol_CreateSerieGrpData (Tcl_Interp * interp,
1936                            BList * series,
1937                            Tol_SerieGroup ** tsgPtr,
1938                            BDate & begin,
1939                            BDate & end,
1940                            int RangeIsDefault,
1941                            Tcl_Obj *obj_result)
1942{
1943  int objc = LstLength(series);
1944  scursors cursors;
1945  Tol_SerieGroup * tsg = NULL;
1946
1947  *tsgPtr = NULL;
1948
1949  tsg = *tsgPtr = Tol_AllocSerieGroup();
1950  _CHECK_PTR_(tsg);
1951   
1952  /*
1953   * alloc space for serie data array
1954   * but for now it's empty
1955   */
1956 
1957  tsg->size = 0;
1958  tsg->series_data = (Tol_SerieData**)Tcl_Alloc(sizeof(Tol_SerieData*)*objc);
1959  _CHECK_PTR_(tsg->series_data);
1960 
1961  /*
1962   * alloc space for array of cursors
1963   * but for now it's empty
1964   */
1965 
1966  cursors.data = (Tol_SerieCursor**)Tcl_Alloc(sizeof(Tol_SerieCursor*)*objc);
1967  _CHECK_PTR_(cursors.data);
1968 
1969  /*
1970   * build cursor & serie data for every known serie
1971   */
1972 
1973  Tol_SerieData * tsd;
1974  BUserTimeSerie * uts;
1975  Tol_SerieCursor * tsc;
1976  int str_len;
1977  int status;
1978  Tcl_DString uniBuffer;
1979  int flagDating = 0;
1980  BUserTimeSet * firstDating = 0;
1981 
1982  Tcl_DStringInit(&uniBuffer);
1983  Tol_SerieCursor::InitBounds();
1984  int i = 0;
1985  while(series) {
1986    uts = (BUserTimeSerie *)Car(series);
1987    /* verify serie */
1988    if ( Tol_GroupFindSerie(uts,tsg) != -1 )
1989      continue;
1990   
1991    /* alloc serie data */
1992   
1993    tsd = tsg->series_data[i] = Tol_AllocSerieData();
1994    _CHECK_PTR_(tsd);
1995    ++tsg->size;
1996
1997    str_len = strlen(uts->Name());
1998    tsd->name = Tcl_Alloc(str_len+1);
1999    _CHECK_PTR_(tsd->name);
2000    strcpy(tsd->name,uts->Name());
2001
2002    str_len = strlen(uts->Identify());
2003    tsd->obj_name = Tcl_Alloc(str_len+1);
2004    _CHECK_PTR_(tsd->obj_name);
2005    strcpy(tsd->obj_name,uts->Identify());
2006
2007    tsd->tms_obj = uts;
2008
2009    tsd->ComputeStats( uts );
2010
2011
2012    /* then alloc corresponding cursor */
2013   
2014    tsc = cursors.data[i] = Tol_AllocSerieCursor();
2015    _CHECK_PTR_(tsc);
2016    ++cursors.last;
2017    status = Tol_InitSerieCursor(tsc,tsd,uts,begin,end,RangeIsDefault);
2018    if (!status) {
2019      if (tsc->useful)
2020        return BadAlloc(interp);
2021      /* por aqui no deberia pasar, REVISALO!!! */
2022      Tcl_AppendStringsToObj(obj_result,
2023                             "invalid range of dates",NULL);
2024      return TCL_ERROR;
2025    }
2026    if ( flagDating == 0 ) {
2027      flagDating = 1;
2028      firstDating = uts->Dating();
2029    } else if ( flagDating == 1 && firstDating != uts->Dating() )
2030      flagDating = 2;
2031    ++i;
2032    series = Cdr(series);
2033  }
2034
2035  /* now we have a set of cursors */
2036 
2037  if (cursors.last==-1) {
2038    Tcl_AppendStringsToObj(obj_result,
2039                           "the set of serie given have no data",NULL);
2040    return TCL_ERROR;
2041  }
2042
2043  if (!Tol_SerieCursor::lowerD.HasValue()) {
2044    /* All series are lower unbounded */
2045    Tol_SerieCursor::lowerD = begin;
2046  }
2047  if (!Tol_SerieCursor::upperD.HasValue()) {
2048    /* All series are upper unbounded */
2049    Tol_SerieCursor::upperD = end;
2050  }
2051   
2052  int iter, idx_dating = -1;
2053  int tcl_code;
2054  BDat dat;
2055  BDate cur_date;
2056  Tol_SerieCursor * iter_cursor;
2057  int isunbounded;
2058
2059  /* Now bound the unbounded cursors */
2060 
2061  for (iter=0; iter <= cursors.last; iter++) {
2062    tsc = cursors.data[iter];
2063    isunbounded = 0;
2064    if (tsc->lowerU) {
2065      /* is lower unbounded so bound it! */
2066      isunbounded = 1;
2067      tsc->cur_date = Tol_SerieCursor::lowerD;
2068      /* now on is not unbounded */
2069      tsc->lowerU = 0;
2070    }
2071    if (tsc->upperU) {
2072      /* is upper unbounded so bound it! */
2073      isunbounded = 1;
2074      tsc->until_date = Tol_SerieCursor::upperD;
2075     /* now on is not unbounded */
2076      tsc->upperU = 0;
2077    }
2078    if (isunbounded) {
2079      /* if unbounded ==> alloc resources */
2080      if (!Tol_AllocMemoryForCursor(tsc))
2081        return BadAlloc(interp);
2082    }
2083  }
2084
2085  cursors.first_good = 0;
2086  cursors.first_sorted = cursors.last;
2087  cursors.sort();
2088
2089  /* grow the interval if necessary */
2090  /*
2091    I think growing is not neccesary now
2092
2093  int new_length;
2094  int has_grown;
2095
2096  for ( iter = cursors.first_good; iter <= cursors.last; ++iter ) {
2097    tsc = cursors.data[iter];
2098    has_grown = 0;
2099    if ( tsc->lowerU && tsc->lowerD < tsc->cur_date ) {
2100      tsc->cur_date = tsc->tms->FirstNoLess( tsc->lowerD );
2101      has_grown = 1;
2102    }
2103    if ( tsc->upperU && tsc->upperD > tsc->until_date ) {
2104      tsc->until_date = tsc->tms->FirstNoGreat( tsc->upperD );
2105      has_grown = 1;
2106    }
2107    if ( has_grown ) {
2108      new_length = tsc->tms->Difference(tsc->cur_date,tsc->until_date)+1;
2109      tsc->_x_ = (int*)Tcl_Realloc((char*)tsc->_x_, sizeof(int)*new_length);
2110      if (!tsc->_x_)
2111        return BadAlloc(interp);
2112      tsc->_y_ = (double*)Tcl_Realloc((char*)tsc->_y_, sizeof(double)*new_length);
2113      if (!tsc->_y_)
2114        return BadAlloc(interp);
2115    }
2116  }
2117  */
2118 
2119  /* iter over the cursors */
2120
2121  while (cursors.HasUseful()) {
2122    iter = cursors.first_good;
2123    tsc = cursors.data[iter];
2124    cur_date = tsc->cur_date;
2125
2126    /* add this date to basic dating */
2127    tcl_code = tsg->AddDate(cur_date);
2128
2129    if (tcl_code != TCL_OK)
2130      return TCL_ERROR;
2131    ++idx_dating;
2132    /* update every serie data having this date in its dating */
2133    do {
2134      iter_cursor = cursors.data[iter];
2135      dat = (*(iter_cursor->serie))[cur_date];
2136      if (dat.IsKnown())
2137        iter_cursor->append(idx_dating,dat.Value());
2138      else
2139        iter_cursor->new_segment(interp);
2140      if (!iter_cursor->next_date()) {
2141        iter_cursor->new_segment(interp);
2142        cursors.compact( iter );
2143      }
2144      ++iter;
2145    } while (iter<=cursors.last && cur_date==cursors.data[iter]->cur_date);
2146    if (iter>cursors.last)
2147      cursors.first_sorted = cursors.last;
2148    else
2149      cursors.first_sorted = iter;
2150    cursors.sort();
2151  }
2152 
2153  if ( flagDating == 1 ) {
2154    tsg->dating_name = Tcl_Alloc(firstDating->Name().Length()+1);
2155    strcpy( tsg->dating_name, firstDating->Name() );
2156  }
2157
2158  /*tsg->dating_length = idx_dating+1;*/
2159  return TCL_OK;
2160}
2161
2162/*
2163 *  Implement tol::autocorr
2164 *
2165 *    tol::autocor type serie ?lagsize? ?range?
2166 *
2167 *   range will be a future option.
2168 *
2169 */
2170
2171
2172enum ACFType { ACF, PACF, IACF, IPACF };
2173 
2174int Tol_GetAutoCorr( Tcl_Interp * interp,
2175                     int objc, Tcl_Obj *CONST objv[],
2176                     Tcl_Obj * obj_result )
2177{
2178  char * type_name;
2179  int acf_type;
2180  const char * valid_types[] = { "ACF", "PACF", "IACF", "IPACF" };
2181#define NTYPES sizeof(valid_types)/sizeof(valid_types[0])
2182  size_t i;
2183  int tcl_code;
2184
2185
2186  type_name = Tcl_GetString( objv[0] );
2187  for ( i = 0; i < NTYPES; ++i )
2188    if ( !strcmp( type_name, valid_types[i] ) )
2189      break;
2190  if ( i == NTYPES ) {
2191    Tcl_AppendStringsToObj(obj_result,
2192                           "invalid autocorrelation funtion type '",
2193                           type_name, "' must be: ACF, PACF, IACF or IPACF",
2194                           NULL );
2195    return TCL_ERROR;
2196  }
2197
2198  acf_type = ACFType(i);
2199
2200  BUserTimeSerie * uts;
2201  //uts = Tol_GetTimeSerie( interp, objv[1] );
2202  uts = (BUserTimeSerie*)Tol_ResolveObject(interp, objv[1], obj_result/*,
2203                                           GraSerie()*/);
2204  if ( !uts ) {
2205    return TCL_ERROR;
2206  }
2207  int size_cor = -1;
2208  if ( objc == 3 ) {
2209    tcl_code = Tcl_GetIntFromObj( interp, objv[2], &size_cor );
2210    if ( tcl_code != TCL_OK ) {
2211      Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
2212      Tcl_AppendStringsToObj( obj_result,
2213                              "\ninvalid autocorrelation function size", NULL );
2214      return TCL_ERROR;
2215    }
2216  }
2217  BDate I0 = uts->FirstDate();
2218  BDate I1 = uts->LastDate();
2219  int length;
2220
2221  if ( !I0.HasValue() )
2222    I0 = BDate::DefaultFirst();
2223  if ( !I1.HasValue() )
2224    I1 = BDate::DefaultLast();
2225
2226  BUserTimeSet * tms = uts->Dating();
2227
2228  if ( !tms ) {
2229    Tcl_AppendStringsToObj(obj_result,"Serie \'",
2230                           Tcl_GetString(objv[1]),
2231                           "\' does not have dating", NULL);
2232    return TCL_ERROR;
2233  }
2234
2235  /* ajustamos el intervalo de fechas al fechado */
2236
2237  I0 = tms->FirstNoLess(I0);
2238  I1 = tms->FirstNoGreat(I1);
2239  length = tms->Difference(I0,I1)+1;
2240  if ( length <= 0 ) {
2241    Tcl_SetStringObj(obj_result,
2242                     "last date must be greater or equal than first",-1);
2243    return TCL_ERROR;
2244  }
2245
2246  if ( size_cor < 0 ) {
2247    size_cor = length / 4;
2248    if ( !size_cor )
2249      size_cor = 1;
2250  }
2251
2252  BArray<BDat> autocor( size_cor );
2253  BArray<BDat> serdata( length );
2254  BArray<BDat> autocor1( size_cor );
2255  BArray<BDat> * result_data = NULL;
2256  double sigma;
2257
2258  uts->ReadData();
2259  for ( i = 0; i < size_t(length); i++ ) {
2260    serdata(i) = (*uts)[I0];
2261    I0 += tms;
2262  }
2263  sigma = 1 / sqrt( (long double) length );
2264  AutoCor( serdata, autocor, size_cor, 1);
2265  switch ( acf_type ) {
2266    case ACF:
2267      result_data = &autocor;
2268      break;
2269    case PACF:
2270      PartAutoCor( autocor, autocor1 );
2271      result_data = &autocor1;
2272      break;
2273    case IACF:
2274      InverseAutoCor( autocor, autocor1 );
2275      result_data = &autocor1;
2276      break;
2277    case IPACF:
2278      InvPartAutoCor( autocor, autocor1 );
2279      result_data = &autocor1;
2280  }
2281 
2282  Tcl_Obj * itemv [4];
2283  Tcl_Obj ** subitemv = (Tcl_Obj**)Tcl_Alloc( size_cor * sizeof(Tcl_Obj*) );
2284  BDat c;
2285
2286  for ( i = 0; i < size_t(size_cor); i++ ) {
2287    c = (*result_data)(i);
2288    if ( c.Known() )
2289      subitemv[i] = Tcl_NewDoubleObj( c.Value() );
2290    else
2291      subitemv[i] = Tcl_NewStringObj( "?", -1 );
2292  }
2293  itemv[0] = Tcl_NewStringObj( uts->Identify(), -1 );
2294  itemv[1] = Tcl_NewIntObj( size_cor );
2295  itemv[2] = Tcl_NewDoubleObj( sigma );
2296  itemv[3] = Tcl_NewListObj( size_cor, subitemv );
2297  Tcl_SetListObj( obj_result, 4, itemv );
2298  Tcl_Free( (char*)subitemv );
2299  return TCL_OK;
2300}
2301
Note: See TracBrowser for help on using the repository browser.