Commit b8e21ba1 authored by luc.moulinier's avatar luc.moulinier

bugs ...

parent e7742327
File mode changed from 100644 to 100755
......@@ -186,7 +186,7 @@ proc SetupPDBObject {} {
# database not open, create it
if {! [info exists db] || $db eq ""} {
set db [FabriqueDeTables [set ::Defauts(TablesPDB)] "root$nom" memory]
set db [FabriqueDeTables [set ::Defauts(TablesPDB)] "root_${nom}_[clock scan now]" memory]
}
# ATTENTION !
......@@ -201,7 +201,6 @@ proc SetupPDBObject {} {
set pkp [$db last_insert_rowid]
foreach n $ChnIdn {
set Ct [set TypChn($n)]
puts "$n $Ct"
if {$Ct eq "DNA" || $Ct eq "Water"} {
continue
}
......@@ -217,7 +216,7 @@ proc SetupPDBObject {} {
set LLx [set AtmXYZ($n)]
set LLb [set AtmBQ($n)]
set LLz [set AtmNA($n)]
foreach r1 $Lr1 r3 $Lr3 rn $Lrn rt $Lrt La $LLa Lx $LLx Lb $LLb Lz $LLz {
set dbrn [format "%08s" $rn]
$db eval {insert into residues values(NULL,$pkp,$pkc,$r1,$r3,$dbrn,$rt)}
......@@ -231,7 +230,7 @@ proc SetupPDBObject {} {
set label "[string trim $a] $r3 ${n}${rn}"
$db eval {insert into atoms values(NULL,$pkp,$pkc,$pkr,$a,$x,$y,$z,$b,$q,$na)}
set cola [CouleurDeAtome $a]
$db eval {insert into objetinit values (NULL,$pkp,$pkc,$pkr,0,0,0,$cdef,0,$cdef,0,$cola, 0,0,0,$label)}
}
......@@ -239,9 +238,9 @@ proc SetupPDBObject {} {
}
$db eval {commit}
update
my _Dimensions
update
return
}
......@@ -296,7 +295,7 @@ proc SetupPDBObject {} {
set f [open "vec.dat" w]
foreach lx [set AtmXYZ($chn)] {
foreach e $lx {
puts $f [join $e]
puts $f "[join $e]"
}
}
close $f
......@@ -2562,26 +2561,27 @@ proc SetupPDBObject {} {
}
oo::define Structure method save {c d f {lgd 1} {file ""}} {
#global db
oo::define Structure method save {chn deb fin {lgd 1} {fileOut ""}} {
my variable db
if {$file eq ""} {
set file [DemandeEtSauveFichier pdb]
if {$file eq ""} {return}
if {$fileOut eq ""} {
set fileOut [DemandeEtSauveFichier pdb]
if {$fileOut eq ""} {
return
}
}
set Lres [list]
set pdb [string range [self] 2 end]
if {$c ne "all"} {
set Lc $c
if {$chn ne "all"} {
set Lchn $chn
} else {
set Lc [my _chains]
set Lchn [my _chains]
}
if {$d ne "all"} {
set deb [format "%08s" $d]
set fin [format "%08s" $f]
if {$deb ne "all"} {
set deb [format "%08s" $deb]
set fin [format "%08s" $fin]
set Ar "and r.rnbr >= '$deb' and r.rnbr <= '$fin'"
} else {
set Ar ""
......@@ -2594,7 +2594,7 @@ proc SetupPDBObject {} {
}
set i 1
foreach c $Lc {
foreach c $Lchn {
# Traite polymer
set Lv [$db eval "select a.aname, r.rname3l, r.rnbr, a.x, a.y, a.z, a.b, a.q from atoms as a, residues as r, chains as c, pdb as p where
p.name = '$pdb' and
......@@ -2612,7 +2612,7 @@ proc SetupPDBObject {} {
lappend Lres [format "ATOM %5d %4s %3s %1s%4s %8.3f%8.3f%8.3f%6.2f%6.2f" $i $an $rn $c $rr $x $y $z $q $b]
incr i
}
if {[llength $Lc] > 1} {
if {[llength $Lchn] > 1} {
lappend Lres "TER "
}
......@@ -2632,7 +2632,7 @@ proc SetupPDBObject {} {
lappend Lres [format "HETATM%5d %4s %3s %1s%4s %8.3f%8.3f%8.3f%6.2f%6.2f" $i $an $rn $c $rr $x $y $z $q $b]
incr i
}
if {[llength $Lc] > 1} {
if {[llength $Lchn] > 1} {
lappend Lres "TER "
}
}
......@@ -2642,14 +2642,22 @@ proc SetupPDBObject {} {
lappend Lres "END "
if {$file eq "ListeEnRetour"} {
if {$fileOut eq "ListeEnRetour"} {
return $Lres
} else {
set f [open $file w]
puts $f [join $Lres \n]
close $f
if {[info commands ::thread::*] eq ""} {
set f [open $fileOut w]
puts $f [join $Lres \n]
close $f
} else {
exec touch $fileOut
foreach line $Lres {
exec echo "$line" >> $fileOut
}
}
}
update
return
}
......
#
# ordali_affiche.tcl
#
proc FinDemarrage {{w ""}} {
if {! [ModeI]} {
return
......@@ -2982,7 +2982,7 @@ proc CoupleX {args} {
}
set LgLtr [font measure SeqFont Z]
lassign [split $args " "] t n p
set n [expr {$n*$LgLtr}]
set n [expr {$n * $LgLtr}]
set args "$t $n $p"
$FrmSequence.csc xview {*}$args
......@@ -4934,7 +4934,6 @@ proc UpdateRegle {} {
set TextWRegle(Comptr) [string range $TexteWRegle(Comptr) 0 end-[expr {abs($diff)}]]
set TextWRegle(Tirets) [string range $TexteWRegle(Tirets) 0 end-[expr {abs($diff)}]]
} else {
#lululu
}
$WTexteRegle configure -state normal
......@@ -5297,6 +5296,9 @@ proc ColorieNomsSelonGroupes {{quoi show}} {
proc ColorieNomsSelonPhylum {{quoi show}} {
global NomNomSeq TDesPhylum LNOrdali Defauts LNSeqlab
if {! [ModeI]} {
return
}
if {[set Defauts(AffGrp)]} {
return
......@@ -6809,8 +6811,12 @@ proc ChangeConservation {} {
proc SauveConservation {} {
global TabSF ListeTypesDeFeatures ScoreMeth Cons ConsMeth TColScore LNDG
if {$Cons(ConsCou) eq "None"} {return}
if {[regexp {^Cons\-} $Cons(ConsCou)]} {return}
if {$Cons(ConsCou) eq "None"} {
return
}
if {[regexp {^Cons\-} $Cons(ConsCou)]} {
return
}
set ftold [lindex $Cons(ConsCou) 0]
# check if feature to be saved already exists
......@@ -6856,20 +6862,32 @@ proc SauveConservation {} {
# update TColScore
lappend TColScore(Names) $ftnew
#rRRR puts [array names ScoreMeth "$ftnew,*"]
#rRRR puts ""
foreach g $LNDG {
if {$g eq "grise" || $g eq "bidon"} {
continue
}
# are there data for this group ?
if {! [info exists ScoreMeth($ftnew,Edit)]} {
continue
}
set Lv [lsort -dictionary [array names ScoreMeth "$ftnew,$g,*"]]
#rRRR puts "$g [llength $Lv]"
set data {}
set cmp -1
foreach v $Lv {
lassign [split $v ,] tmp tmp i
while {$cmp < $i} {
incr cmp
lappend data 0
}
lappend data $ScoreMeth($v)
incr cmp
}
if {$data == {} } {
incr cmp
for {set i $cmp} {$i < [LongueurDeLAlignement]} {incr i} {
lappend data 0
}
if {$data == {} || [llength [lsort -unique $data]] == 1} {
continue
}
if {$g eq "GroupeToutLeMonde"} {
......@@ -6894,7 +6912,7 @@ proc SauveConservation {} {
VueEditee 1
return
return $ftnew
}
......@@ -8369,6 +8387,8 @@ proc DessineLesScores {{f ""}} {
if {$f eq ""} {
$Ccs delete all
update idletasks
return
}
......@@ -8404,7 +8424,6 @@ proc DessineLesScores {{f ""}} {
set Lv {} ; set Lx {}
set Li [array names ScoreMeth "$f,$g,*"]
#puts " Li [llength $Li]"
foreach v $Li {
lassign [split $v ,] t m i
lappend Lx $i
......@@ -8425,7 +8444,7 @@ proc DessineLesScores {{f ""}} {
set min [set ScoreMeth($f,${g}-min)]
}
set i -1
+ set i -1
set Coord {}
foreach v [lrange $Lv 1 end] {
incr i
......@@ -9563,12 +9582,20 @@ proc vq {} {
proc CommandLineClustering {method} {
global Clus
switch $method {
"secator" {set Clus(Method) "hierarchic / secator"}
"dpc" {set Clus(Method) "kmeans / DPC"}
"mmaic" {set Clus(Method) "mixture model / AIC"}
"mmbic" {set Clus(Method) "mixture model / BIC"}
"fichierclu" {
DefinitionGroupes "fichierclu"
return
}
default {
puts "\nmethod >$method< is not defined"
return
}
}
set k "LCrit,\% identity"
set Clus($k) 1
......
......@@ -71,8 +71,8 @@ proc DefinitionGroupes {Type {NbGr -1}} {
set rep [CalculeGroupes $Type $NbGr]
if {$rep ne "1"} {
FaireLire "$rep"
FaireLaSuite
FaireLire "$rep"
return
}
......@@ -128,7 +128,7 @@ proc LogClustering {} {
proc CalculeGroupes {Type {NbGr -1}} {
global Defauts Sequences LNOrdali LNDG SDG
global Defauts Sequences LNOrdali LNDG SDG NomSeqSel
global TabSF yaord LesPoidsDesSequences OrdrePrecedent
if {[llength [array names Sequences]] < 3} {
......@@ -137,7 +137,9 @@ proc CalculeGroupes {Type {NbGr -1}} {
if {$Type eq "fixed"} {
set NbGr [ChoixNbCluster]
if {$NbGr < 2} {return "Not enough clusters"}
if {$NbGr < 2} {
return "Not enough clusters"
}
}
LesDefauts TypeDeGroupesACreer $Type
......@@ -148,6 +150,9 @@ proc CalculeGroupes {Type {NbGr -1}} {
"fichierclu" {
set FichierClu [set Defauts(FichierClu)]
LectureClusters $FichierClu SDG LNDG dpc
for {set y 1} {$y <= [llength $LNOrdali]} {incr y} {
lappend NomSeqSel "$y.0"
}
}
"integral" {
global NomsGrpIntegral LesNomsSeqGrpIntegral
......@@ -200,7 +205,9 @@ proc CalculeGroupes {Type {NbGr -1}} {
AjouteGroupeToutLeMonde
if {! [llength $LNDG]} {
unset -nocomplain SDG
set SDG(GroupeToutLeMonde) $LNOrdali
foreach n $LNOrdali {
if {$n ne ""} {lappend SDG(GroupeToutLeMonde) $n}
}
set LNDG "GroupeToutLeMonde"
}
......@@ -380,7 +387,7 @@ proc GroupeRestant {as al LR} {
# Donne toutes les sequences qui :
# - n'ont pas ete selectionnees pour clustering
# - ont ete miises dans le groupe poubelle
# - ont ete mises dans le groupe poubelle
# all seqs
set i 1
......@@ -396,9 +403,10 @@ proc GroupeRestant {as al LR} {
}
# add garbage seqs
puts "LR $LR"
foreach i $LR {
incr i
set TLi($i) 1
set TLi($i) 0
}
# take the rest
......@@ -410,7 +418,7 @@ proc GroupeRestant {as al LR} {
}
incr i
}
puts "Laisse $Laisse"
if {[llength $Laisse]} {
lappend LG "GroupSeqOut"
set SG(GroupSeqOut) $Laisse
......@@ -1263,6 +1271,73 @@ proc kir {{method ""}} {
}
proc kirsley_ShowMethod {root {grp "all"}} {
set Lf [lsort [glob ${root}_*.csv]]
if {$Lf == {} } {
return
}
set Lres {}
set first 0
foreach f $Lf {
# methode name
set idx [string first "_" $f]
set meth [string range [file rootname $f] $idx+1 end]
# get scores
set Ll [LesLignesDuFichier $f]
if {! $first} {
lappend Lres [split [lindex $Ll 0] ,]
set first 1
}
set iline [lsearch -regexp $Ll "^$grp"]
if {$iline == -1} {
puts "no group named >$grp<"
exit
}
set Lv [split [lindex $Ll $iline] ,]
lset Lv 0 $meth
lappend Lres $Lv
}
kirsley_PrintScores $Lres
return
}
proc kirsley_ShowGroups {file} {
set Ll [LesLignesDuFichier $file]
set Lv {}
foreach l $Ll {
lappend Lv [split $l ,]
}
kirsley_PrintScores $Lv
return
}
proc kirsley_PrintScores {Lv} {
set step 10
set stepm1 [expr {$step - 1}]
set fmt "%10s | [string repeat "%3d " $step]"
for {set i 1} {$i < [llength [lindex $Lv 0]]} {incr i $step} {
foreach l $Lv {
set Lval [lrange $l $i $i+${stepm1}]
set reste [expr {$step - [llength $Lval]}]
lappend Lval {*}[lrepeat $reste 0]
puts [format $fmt [lindex $l 0] {*}$Lval]
}
puts ""
}
exit
}
This diff is collapsed.
......@@ -1035,14 +1035,14 @@ proc AfficheBoutonsConservation {} {
label $wx.lmth \
-text "Method : " \
-anchor w -justify left
set ListeOrdMeth [list "Threshold" "Liu" "Mean Distances" "Vector Norm" "Multi" "BILD"]
set wdt [PlusLongEltDe $ListeOrdMeth]
set ListeMethCons [list "Threshold" "BILD" "Liu" "Mean Distances" "Vector Norm" "Multi"]
set wdt [PlusLongEltDe $ListeMethCons]
ttk::combobox $wx.smth \
-width $wdt \
-background white \
-state readonly \
-textvariable Cons(Method) \
-values $ListeOrdMeth
-values $ListeMethCons
$wx.smth current 0
bind $wx.smth <<ComboboxSelected>> [list set ::Cons(Title) ""]
label $wx.ltt \
......@@ -1391,3 +1391,12 @@ proc AfficheBoutonsSeqLab {} {
return
}
proc rcm {} {
set Lmeth [LesLignesDuFichier kir]
foreach m $Lmeth {
exec ordali kir.tfa -batch -group kir.clu -exe kirsley $m
}
exit
}
......@@ -821,8 +821,6 @@ proc PrepareRunOrdali {} {
ColorieSelonFeature "Clear"
}
#MetAJourGroupes
InitCouleursGroupes
InitPoints
CreeLesPiliers
......@@ -834,17 +832,43 @@ proc PrepareRunOrdali {} {
}
switch $method {
"Wang" {
set cmd "RunMethode Wang $OGlob"
}
"Caffrey" {
set cmd "RunMethode Caffrey $OGlob"
}
"Capra" {
set cmd "RunMethode Capra $OGlob"
}
"Karlin" {
set cmd "RunMethode Karlin $OGlob"
}
"Peivar" {
set cmd "RunMethode Peivar $OGlob"
}
"Kabat" {
set cmd "RunMethode Kabat $OGlob"
}
"Liu" {
set cmd "RunMethode Liu $OGlob"
}
"Liu2" {
set cmd "RunMethode Liu2 $OGlob"
}
"Williamson" {
set cmd "RunMethode Williamson $OGlob"
}
"Threshold" {
set cmd "RunOrdali $OGlob"
}
"MeanDistances" -
"Mean Distances" {
set cmd "RunMethode MeanDistance $OGlob"
}
"VectorNorm" -
"Vector Norm" {
< set cmd "RunMethode VectorNorm $OGlob"
set cmd "RunMethode VectorNorm $OGlob"
}
"Ranganathan" {
set cmd "RunMethode Ranganathan $OGlob"
......
......@@ -1208,12 +1208,13 @@ proc InterpreteLaLigneDeCommande {Ligne} {
LesDefauts TypeAli ALN
}
"-group" {
set TypeDeGroupesACreer $v
LesDefauts TypeDeGroupesACreer $TypeDeGroupesACreer
if {$TypeDeGroupesACreer == "fichierclu"} {
set fichierclu [lindex $Liste [expr {$Idx + 2}]]
LesDefauts FichierClu $fichierclu
if {[file exists $v] && [file extension $v] eq ".clu"} {
set TypeDeGroupesACreer "fichierclu"
LesDefauts FichierClu $v
} else {
set TypeDeGroupesACreer $v
}
LesDefauts TypeDeGroupesACreer $TypeDeGroupesACreer
}
"-batch" {
LesDefauts Mode Batch
......@@ -1560,8 +1561,6 @@ proc Rpipe {args} {
# faire un package require Rtcl quelque part
#::rtcl::eval -verbose $cmd
return [::rtcl::eval {*}$args]
return ""
}
proc Rpipe_tmp {Cmd} {
......
#
# ordali_pdb.tcl
#
proc SelectSSDeType {type} {
global PositionInitiale ListePDB NomNomSeq NomTextSeq
......
......@@ -216,12 +216,13 @@ proc CreeFeaturesMethod {ft} {
set g "GroupeToutLeMonde"
set target "all"
} else {
# ex: group4
set i [string range $t 5 end]
set c [CouleurO2Ordali [CouleurDuGroupe $i]]
set g $t
set target "group"
}
#puts "Cref $g [llength $v]"
set note $t
foreach e $v {
set s [set ScoreMeth($ft,$g,$e)]
......@@ -239,7 +240,7 @@ proc CreeFeaturesMethod {ft} {
}
}
}
set ScoreMeth($ft,Edit) 0
return
......@@ -1317,13 +1318,11 @@ proc CreeListeScore {{g ""}} {
for {set i 0} {$i < $len} {incr i} {
lappend Lidx $i
}
#puts "ListeScore >$g< [array names TbScores] | $len"
set ListeScore [list]
foreach i $Lidx {
set ligne [list $i]
set cok 1
foreach sco [set TbScores(Lcols)] {
if {[set val [lindex [set TbScores(Score,$sco)] $i]] == -999.0} {
set cok 0
break
......@@ -1350,12 +1349,13 @@ proc NormalisationColonnes {} {
for {set i 1} {$i < $c} {incr i} {
set l$i [ExtraitListeDeListe $ListeScore $i]
if {[llength [lsort -unique [set l$i]]] == 1} {
puts "==> only ONE value : [lindex $l 0] repeated [llength [set l$i]] times, col $i"
puts "==> only ONE value : [lindex $l 0] repeated [llength [set l$i]] times, col $i of ListeScore"
return 0
}
set nl$i [Standardise [set l$i]]
}
# get columns indexes
set tmp [ExtraitListeDeListe $ListeScore 0]
set new [list]
for {set j 0} {$j < $n} {incr j} {
......@@ -1571,7 +1571,8 @@ proc ScoreDeBILD {ListePil {ThrGap ""}} {
lappend Lres $bild
}
puts "\nScoreDeBILD :"
plist $Lres %6.3f
return $Lres
}
......@@ -3780,7 +3781,7 @@ proc StockScores {f g {DoNorm 1}} {
} else {
set nlval $Lval
}
set min 99999999. ; set max -99999999.
foreach i $Li v $nlval {
set ScoreMeth($f,$g,$i) $v
......@@ -3789,13 +3790,14 @@ proc StockScores {f g {DoNorm 1}} {
}
set ScoreMeth($f,${g}-min) $min
set ScoreMeth($f,${g}-max) $max
set ScoreMeth(ScaleGlobal) 0
set ScoreMeth($f,ScaleGlobal) 0
puts "nb $g [llength [array names ScoreMeth $f,$g,*]]"
return
}
proc RunMethode {method {Grp ""}} {
proc RunMethode {methode {Grp ""}} {
global ConsMeth ScoreMeth LNDG SDG LNOrdali TableScore OrdTmpDir ListeTypesDeFeatures ListeDesPiliersDuGroupe TbScores
set NSqs [llength $SDG(GroupeToutLeMonde)]
......@@ -3803,9 +3805,9 @@ proc RunMethode {method {Grp ""}} {
FaireLire "Too few sequences ! !"
return
}
switch $method {
"Cluster" {
switch $methode {
"Cluster" {
set cols [list Norm Thompson]
set ident "Multi"
set lameth "Multi"
......@@ -3823,29 +3825,19 @@ proc RunMethode {method {Grp ""}} {
set lameth "Mean Distance"
set ft "Cons-MeanD"
}
"Ranganathan" {
set cols Ranganatan
set ident "Ranganathan"
set lameth "Ranganathan"
set ft "Cons-Ranga"
}
"Liu" {
set cols Liu
set ident "Liu"
set lameth "Liu"
set ft "Cons-Liu"
}
"Liu2" {
set cols Liu2
set ident "Liu2"
set lameth "Liu2"
set ft "Cons-Liu2"
}
"BILD" {
set cols BILD
set ident "BILD"
set lameth "BILD"
set ft "Cons-BILD"
"Liu" -
"Liu2" -
"BILD" -
"Peivar" -
"Ranganatan" -
"Capra" -
"Caffrey" -
"Kabat" -
"Karlin" {
set cols $methode
set ident $methode
set lameth $methode
set ft "Cons-$methode"
}
"User" {
set cols ""
......@@ -3880,45 +3872,47 @@ proc RunMethode {method {Grp ""}} {
} else {
set LGrp $Grp
}
puts "grp >$Grp< LGrp $LGrp"
if {! [info exists ListeDesPiliersDuGroupe]} {
CreeLesPiliers
}
unset -nocomplain TbScores
set TbScores(Lcols) $cols
puts "LGrp=$LGrp"
foreach g $LGrp {
puts "g= $g"
array unset TbScore "Score,*"
if {$g eq ""} {set g [lindex $LNDG 0]}
set ListePil [set ListeDesPiliersDuGroupe($g)]
puts "RunMethod g=$g size [llength [set SDG($g)]]"
if {$g eq "bidon" || $g eq "grise"} {continue}
if {$g eq "GroupeToutLeMonde"} {
set g ""
if {$g eq "bidon" || $g eq "grise"} {
continue
}
if {$g ne "" && [llength [set SDG($g)]] < 3} {
if {[llength [set SDG($g)]] < 3} {
puts "\t VIRE g= $g size [llength [set SDG($g)]]"
continue
}
if {$g eq "GroupeToutLeMonde"} {
set g ""
}
foreach c $cols {
set TbScores(Score,$c) [ScoreDe$c $ListePil]
}
CreeListeScore $g
set cok [NormalisationColonnes]
if {! $cok} {
puts "\tNormalisation g= $g size [llength [set SDG($g)]]"
puts "\tNormalisation failed g= $g size [llength [set SDG($g)]]"
continue
}
StockScores $ft $g
set Lgr [Tclcluspack $::ListeScore -dt coordinates -cm mm -nbc aic -wc]
TraiteResultatClusteringTcl $Lgr $ident $g "mixturemodels"
set Lclus [Tclcluspack $::ListeScore -dt coordinates -cm mm -nbc aic -wc]
TraiteResultatClusteringTcl $Lclus $ident $g "mixturemodels"
}
CreeFeaturesMethod $ft
......
......@@ -2986,34 +2986,50 @@ proc CalculeLesPoidsDesSeqs_eigen {} {
set usv [::math::linearalgebra::determineSVD $Md]
set eigenVectors [lindex $usv 2]
set singular [lindex $usv 1]
set u [lindex $usv 0]
puts "matrix U:"