1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
# Copyright (C) 1999-2018
# Smithsonian Astrophysical Observatory, Cambridge, MA, USA
# For conditions of distribution and use, see copyright notice in "copyright"
package provide DS9 1.0
proc TSVRead {t fn} {
upvar #0 $t T
global $t
global debug
if {$debug(tcl,cat) || $debug(tcl,sia)} {
puts stderr "TSVRead"
}
if {$fn == {}} {
return
}
catch {
set fp [open $fn r]
# init db
set T(Nrows) 0
set T(Ncols) 0
set T(Header) {}
set T(HLines) 0
# ok, get first non comment line
while (true) {
if {[gets $fp line] == -1} {
return
}
# skip any comments
if {[string range $line 0 0] != "#"} {
break;
}
}
# reduce number of spaces
regsub -all { +} $line { } line
# strip any quotes
regsub -all {\"} $line {} line
# determine separator
if {[llength [split $line "\t"]] > 1} {
set ss "\t"
} elseif {[llength [split $line ","]] > 1} {
set ss ","
} elseif {[llength [split $line ":"]] > 1} {
set ss ":"
} else {
set ss " "
}
# determine header
set first {}
set foo [split $line $ss]
if {([string is integer [lindex $foo 0]] || [string is double [lindex $foo 0]]) && ([string is integer [lindex $foo 1]] || [string is double [lindex $foo 1]])} {
# determine num cols
set cnt [llength $foo]
# we need to build an header
set first $line
set line "X${ss}Y"
for {set ii 2} {$ii<$cnt} {incr ii} {
append line "${ss}column[expr $ii+3]"
}
}
# process header
# cols
incr ${t}(HLines)
set n $T(HLines)
set T(H_$n) $line
set T(Header) [split $T(H_$n) $ss]
# dashes
set T(Dashes) [regsub -all {[A-Za-z0-9]} $T(H_$n) {-}]
set T(Ndshs) [llength $T(Dashes)]
starbase_colmap $t
# process table
if {$first == {}} {
gets $fp line
} else {
set line $first
}
while {![eof $fp]} {
# skip any comments
if {[string range $line 0 0] == "#"} {
set line {}
}
# reduce number of spaces
regsub -all { +} $line { } line
set line [string trim $line]
# do we have something?
if {$line != {}} {
# ok, save it
incr ${t}(Nrows)
set r $T(Nrows)
set NCols [starbase_ncols $t]
set c 1
foreach val [split $line $ss] {
set T($r,$c) $val
incr c
}
for {} {$c <= $NCols} {incr c} {
set T($r,$c) {}
}
}
gets $fp line
}
close $fp
}
}
proc TSVWrite {t fn} {
upvar #0 $t T
global $t
global debug
if {$debug(tcl,cat) || $debug(tcl,sia)} {
puts stderr "TSVWrite"
}
if {$fn == {}} {
return
}
set fp [open $fn w]
set nr $T(Nrows)
set nc $T(Ncols)
# header
for {set cc 1} {$cc < $nc} {incr cc} {
puts -nonewline $fp "[lindex $T(Header) [expr $cc-1]]\t"
}
puts $fp "[lindex $T(Header) [expr $nc-1]]"
# data
for {set rr 1} {$rr <= $nr} {incr rr} {
for {set cc 1} {$cc < $nc} {incr cc} {
puts -nonewline $fp "$T($rr,$cc)\t"
}
puts $fp "$T($rr,$nc)"
}
close $fp
}
|
