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

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
}
......@@ -11258,14 +11258,6 @@ proc pe {} {
}
# oliver : menu classique pain burgger + frites
# luc : menu new york pain baguette + frites + pepsimax
# laetitia : menu comtois pain burger + frites + ice tea
# arnaud : auvergnat burger
# kirsley : menu alpin burger ice tea + beignet poulet (petits)
# 03 88 32 02 02
proc aout {} {
set La [LesLignesDuFichier a.out]
set Lo [list]
......@@ -12407,29 +12399,40 @@ proc clau {} {
}
proc kirsley {} {
global TabSF Sequences Cons
proc kirsley {method} {
global TabSF Sequences Cons ScoreMeth TColScore Defauts
set Cons(PDB) 0
set Cons(Method) BILD
set Cons(Method) $method
LesDefauts MethodeConservation $method
set Cons(Title) ""
set Cons(OnlyGlobal) 0
e set Cons(Entry) ""
set Cons(Entry) ""
set Cons(ComboSel) ""
LanceCalculConservation
SauveConservation
set ft [SauveConservation]
foreach k [array names TabSF "*,Cons*"] {
#puts "$k"
set n [lindex [split $k ,] 0]
foreach f $TabSF($k) {
DecortiqueUneFeature $f d f col sc nt
if {$nt eq "IdenGlob"} {
puts "[string index $Sequences($n) $d] $d $f $col $nt"
}
}
# sauve scores en CSV
set file "[file rootname $Defauts(FichierClu)]_${method}.csv"
puts "file= $file"
set o [open $file w]
set Li {}
for {set i 1} {$i < [llength [lindex $TColScore($ft,Data) 0]]} {incr i} {
lappend Li $i
}
puts $o ",[join $Li ,]"
foreach gr $TColScore($ft,Owner) data $TColScore($ft,Data) {
set data [KirsleyData $data]
puts "\ngrp= $gr [llength $data]"
#plist $data %6.3f
puts $o "$gr,[join $data ,]"
}
close $o
#puts "\nTColScore :"
#parray ::TColScore
exit
}
......@@ -12715,10 +12718,12 @@ proc CreateASTRALSets {} {
set fold [join [lrange [split $T($k) .] 0 1] .]
lappend F($fold) $id
}
set sumSeqs 0
foreach f [array names F] {
if {[llength $F($f)] < 10} {
continue
}
incr sumSeqs [llength $F($f)]
if {! [file exists $f]} {
file mkdir $f
......@@ -12732,6 +12737,7 @@ proc CreateASTRALSets {} {
puts $o [join $Ltfa \n]
close $o
}
puts "Nbr of Seqs in folds : $sumSeqs"
return
}
......@@ -12795,28 +12801,24 @@ proc stagearno {} {
}
proc fye {} {
set Ld [glob -type d *]
foreach d $Ld {
if {[lsearch -glob [glob -type d -nocomplain [file join $d *]] *wobble*] > -1} {puts $d}
}
exit
}
proc ASTRALPrepareData {} {
set Ld [lsort -dictionary [glob -type d *]]
set totMax 0
set lgMax -999 ; set nbMax -999
puts " dir lmax nSeq"
foreach d $Ld {
unset -nocomplain Tseq Ln Pris
DecortiqueUnTFA $d/seqs_ori.tfa Ln Tseq
# take only fold having nseq > 100
set nSeqs [llength $Ln]
puts "$d $nSeqs"
if {$nSeqs < 100} {
continue
}
if {$nSeqs > $nbMax} {
set nbMax $nSeqs
set dnbMax $d
}
# Determine longest sequence
set lmax -999
foreach n $Ln {
......@@ -12825,9 +12827,9 @@ proc ASTRALPrepareData {} {
}
}
puts [format "%5s %4d %4d" $d $lmax $nSeqs]
if {$lmax > $totMax} {
set totMax $lmax
set dmax $d
if {$lmax > $lgMax} {
set lgMax $lmax
set dlgMax $d
}
# create training/test sets
......@@ -12866,7 +12868,8 @@ proc ASTRALPrepareData {} {
}
close $o
}
puts "\n$dmax $totMax"
puts "\nlgMax $lgMax dans $dlgMax"
puts "nbMax $nbMax dans $dnbMax"
return
}
......@@ -12951,10 +12954,25 @@ proc TestWeights {} {
set Lsali {}
foreach n $LNOrdali {
lappend Lsali $n $Tseq($n)
puts "$n $Tseq($n)"
}
puts ""
set aTPCI [CalculeLesPCIGenerique $Lsali]
array set TDesPCI $aTPCI
set m {}
foreach a $
set eps 0.01
set vec [Reigen]
set min [::tcl::mathfunc::min {*}$vec]
set vec [lmap x $vec {expr {$x - $min + $eps}}]
set sum [::tcl::mathop::+ {*}$vec]
set vec [lmap x $vec {expr {$x / $sum}}]
plist $vec %6.3f
puts ""
set LWmean [CalculeLesPoidsDesSeqs_mean]
puts "LWmean"
plist $LWmean %6.3f
......@@ -12963,8 +12981,423 @@ proc TestWeights {} {
puts "LWeigen"
puts $LWeigen
return
}
proc ASTRALFormateDataPourKeras {file} {
global Rosace
InitialiseRosace
array set T [ParseScope astral_scope_40.fa]
DecortiqueUnTFA $file Ln Tseq
set o [open ../pdb_seqres.txt r]
set i 0
while {[gets $o l] >= 0} {
if {! ($i % 2)} {
# nom du type '1a0c_A'
lappend Lnpdb [string range [lindex [split $l] 0] 1 end]
} else {
lappend Lspdb $l
}
incr i
}
puts "data loaded ...\n"
set Lout {}
set maxLength -999
set nout 0
foreach n $Ln {
if {! [info exists T($n,zone)]} {
puts "\nPas de zone : $n"
continue
}
set zone $T($n,zone)
# domaine discontinu
if {[string first "," $zone] > -1} {
continue
}
lassign [split $zone ":"] chn zone
set pdb [string tolower $T($n,pdb)]
set pdbid "${pdb}_$chn"
set iseq [lsearch $Lnpdb $pdbid]