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

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

merging from NameBlock/VMatrix branch

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

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