Commit 2ae56b05 authored by luc.moulinier's avatar luc.moulinier

bug dans ChercheMotifSuivant

parent 02e8c5b4
......@@ -3496,6 +3496,12 @@ proc PeintHitsCherche {} {
proc ChercheMotifSuivant {{enplace 0}} {
global NomTextSeq Chrc
if {! [info exists Chrc] || ! [info exists Chrc(NextOc)]} {
# the 'serch' or <return> button has not been
# pressed. Do it here
ChercheMotif
}
set lg [llength $Chrc(NextOc)]
if {! $lg} {return}
if {! $enplace} {
......@@ -6809,6 +6815,7 @@ proc SauveConservation {} {
set ftnew [string range $ftold 3 end]
set ifin [string last "_" $ftnew]
if {$ifin > 4} {
# is of form Cons_XXX_n
set ext [string range $ftnew [string last "_" $ftnew]+1 end]
if {[regexp {[0-9]*} $ext]} {
set ftnew [string range $ftnew 0 [string last "_" $ftnew]-1]
......@@ -6823,7 +6830,7 @@ proc SauveConservation {} {
# replace tmp feat by normal one
set ftrad $ftnew
if {$if} {
if {$if > 0} {
set ftnew "${ftnew}_$if"
}
......@@ -6878,7 +6885,7 @@ proc SauveConservation {} {
set Cons(Title) ""
set Cons(ConsCou) $ftnew
if {[info exists Cons(ComboSel)] && $Cons(ComboSel) ne ""} {
lset Cons(ListeCons) $i $newf
set Cons(ListeCons) [lreplace $Cons(ListeCons) $i $i $newf]
$Cons(ComboSel) configure -values $Cons(ListeCons)
$Cons(ComboSel) current $i
}
......
......@@ -12331,3 +12331,60 @@ e set Cons(Entry) ""
}
exit
}
proc ParseScope {file} {
set Ll [LesLignesDuFichier $file]
foreach l $Ll {
if {[string index $l 0] eq ">"} {
regsub -all { +} [string range $l 1 end] " " l
set Lv [split $l " "]
set reste [lassign $Lv id fold zone]
set reste [join $reste]
#puts ">$reste<"
set discon [expr {[string first "," $zone] > -1}]
set zone [string range $zone 1 end-1]
# orga + taxid
set function [string trim [string range $reste 0 [string first "\{" $reste]-1]]
set orgtx [string range $reste [string first "\{" $reste]+1 [string first "\}" $reste]-1]
#puts ">$orgtx<"
set orga [string trim [string range $orgtx 0 [string first "\[" $orgtx]-1]]
set taxid [string range $orgtx [string first "\[" $orgtx]+8 [string first "\]" $orgtx]-1]
set T($id,pdb) [string range $id 1 4]
set T($id,fold) $fold
set T($id,zone) $zone
set T($id,reste) $reste
set T($id,seq) ""
set T($id,function) $function
set T($id,orga) $orga
set T($id,taxid) $taxid
set T($id,discon) $discon
} else {
append T($id,seq) [string trim [string toupper $l]]
}
}
foreach k [array names T "*,seq"] {
lassign [split $k ,] id tmp
set T($id,length) [string length $T($k)]
}
parray T
set out "[file rootname $file].csv"
if {[file exists $out]} {
file delete $out
}
set o [open $out w]
puts $o "ID;Fold;Zone;Length;Function;Organism;TaxID;Discontinue"
foreach k [array names T "*,seq"] {
lassign [split $k ,] id tmp
puts $o "$id;$T($id,fold);$T($id,zone);$T($id,length);$T($id,function);$T($id,orga);$T($id,taxid);$T($id,discon)"
}
close $o
exit
}
#
# ordali_tree.tcl
#
proc FastMEExe {} {
global tcl_platform
global OrdBinDir
......@@ -5289,7 +5293,7 @@ proc DoLevel {root Level} {
proc ArrayTree2PH {node} {
set Lf $::Tx($node,Child)
set Lf $::Tx(Child,$node)
if {$Lf != {}} {
append ::phTree "("
foreach f $Lf {
......@@ -5310,35 +5314,55 @@ proc ArrayTree2PH {node} {
proc ttn2 {} {
global Tx phTree
global Tx phTree
set Ll [LesLignesDuFichier euk.tab]
#set Ll [LesLignesDuFichier euk.tab]
set Ll [LesLignesDuFichier newtree.txt]
foreach l $Ll {
set Lv [split $l \t]
regsub -all { +} [string trim $l] " " l
if {$l eq ""} {
continue
}
set Lv [split $l]
#set Lv [split $l \t]
set node [lindex $Lv 0]
set par [lindex $Lv end]
set Tx(Parent,$node) $par
lappend Tx(Child,$par) $node
set Tx(Name,$node) "n$node"
set Tx(Name,$par) "n$par"
set Tx(Rank,$node) "node"
set Tx(Rank,$par) "node"
lappend Tx($par,Child) $node
lappend Lf $node
lappend Lp $par
}
set Ltot [lsort -unique [concat $Lf $Lp]]
foreach f $Ltot {
if {! [info exists Tx($f,Child)]} {
set Tx($f,Child) {}
set Lfeuilles [lsort -unique -integer [lor $Lf $Lp from1]]
set LAllIds [lsort -unique [concat $Lf $Lp]]
foreach f $LAllIds {
if {! [info exists Tx(Child,$f)]} {
# is a leaf
set Tx(Rank,$f) Species
set Tx(Child,$f) {}
}
set Tx($f,nbC) [llength $Tx($f,Child)]
set Tx(NbChild,$f) [llength $Tx(Child,$f)]
set Tx($f,nbC) [llength $Tx(Child,$f)]
}
set phTree "("
ArrayTree2PH 2759
#ArrayTree2PH 2759
ArrayTree2PH 0
append phTree ");"
set Fin [string last ":" $phTree]
set phTree "[string range $phTree 1 $Fin-1];"
set phTree [string map {",)" ")"} $phTree]
puts ""
puts "$phTree"
flush stdout
set o [open test.ph w]
puts $o "$phTree\n"
close $o
......@@ -5379,6 +5403,76 @@ proc tclau {} {
}
proc ttn3 {} {
global Abr Tx Lfeuilles LSelectableIds LAllIds TaxRoot
ttn2
set Lsamp [LesLignesDuFichier out]
set PAD [set Abr(1,PAD)]
foreach l $Lsamp {
set n "n$l"
set id [$PAD find withtag "Rfeuille-$n"]
puts "$n $id"
$PAD itemconfig $id -fill blue
}
PrintCanvas $PAD "" it100000.png
return
incr Tx(NbChild,$par)
set Tx(NbChildCum,$node) 0
set Tx(hasSel,$node) 0
set Tx(Etat,$node) 0
set Tx(isComp,$node) 0
set Tx(NbComp,$node) 0
set Tx(isGold,$node) 0
set Tx(isInt,$node) 0
set Tx(NbInt,$node) 0
set Tx(ShowInt,$node) 0
set Tx(NbKeep,$node) 0
lappend Tx(Child,$par) $node
set TaxRoot 0
CountCompleteGenomesPerNode
set LSelectableId $LAllIds
set Tx(hasSel,0) 1
set Tx(hasSel,$TaxRoot) 1
foreach id $LSelectableId {
set Tx(isGold,$id) 1
set Tx(hasSel,$id) 1
}
DefineChildsWithGold
return
}
proc ttn4 {} {
global TaxRoot Tx
set TaxRoot 0
set Tx(-root) 0
return
}
proc methProportional {} {
global TaxRoot Tx LSelectableId LAllIds Lfeuilles
return
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment