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

debuggae PCI mode

parent 2ae56b05
......@@ -77,7 +77,16 @@ set VariablesAuDepart [info globals]
### Launch ORDALIE ######
# Main program
InitLesDefauts
trace add variable ::Defauts(DownloadPDB) write GetTrace
proc GetTrace {a b op} {
global $a
puts "a= $a b= $b"
puts "\n@@@@@@@"
puts "${a}($b)"
catch {puts [info level 0]}
catch {puts [info level -1]}
return
}
set retour [InterpreteLaLigneDeCommande $argv]
if {[ModeI]} {
LoadTkAndPackages
......
#
# ordali_StrucObj.tcl
#
proc SetupPDBObject {} {
......@@ -57,7 +60,6 @@ proc SetupPDBObject {} {
set nom [string range [self] 2 end]
set cok [my _DecortiqueUnPdbObject $Llignes $nom]
if {$cok == 0} {
return 0
}
......@@ -197,9 +199,9 @@ proc SetupPDBObject {} {
$db eval {insert into pdb values(NULL,$nom,$source,$Header)}
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
}
......@@ -364,7 +366,9 @@ proc SetupPDBObject {} {
set Obsolete 0
set lignesPDB [ExtraitLignesAtomesDuPDB $Llignes]
set Header [ExtraitHeadDuPDB $Llignes]
if {$lignesPDB == -1} {return 0}
if {$lignesPDB == -1} {
return 0
}
# Is this entry superseeded ?
set Superseeded [my _superseed $Header]
......@@ -374,7 +378,7 @@ proc SetupPDBObject {} {
return $Obsolete
}
set ChnIdn [list]
set ChnIdn {}
# Traite chaines apres chaines
set Lter [lsearch -regexp -all $lignesPDB {^TER}]
set Lter [linsert $Lter 0 "0"]
......@@ -392,13 +396,17 @@ proc SetupPDBObject {} {
set d $f
continue
}
if {[lsearch -regexp $LLignesChn {^ATOM }] != -1} {set polymer 1} {set polymer 0}
if {[lsearch -regexp $LLignesChn {^ATOM }] != -1} {
set polymer 1
} else {
set polymer 0
}
my _LectureDeChainePdbObject $LLignesChn $polymer
set d $f
}
# Traitement des chaines
set ChnIdn [lunique $ChnIdn]
......
......@@ -3383,12 +3383,14 @@ proc ComputeIdentity {} {
proc CherchePCI {w args} {
global TPCI nsq1 nsq2 pciLbl pl1Lbl pl2Lbl
global TDesPCI TPCI nsq1 nsq2 pciLbl pl1Lbl pl2Lbl
if {$nsq1 eq "" || $nsq2 eq "" || $nsq1 eq "Select" || $nsq2 eq "Select"} {return}
if {$nsq1 eq "" || $nsq2 eq "" || $nsq1 eq "Select" || $nsq2 eq "Select"} {
return
}
set pair1 "$nsq1,$nsq2"
if {! [info exists TDesPCI($pair1)]} {
if {! [info exists TPCI($pair1)]} {
CalculeLesPCI "" "" $nsq1 $nsq2
update
}
......@@ -3396,11 +3398,11 @@ proc CherchePCI {w args} {
set pci [lindex $val 0]
set pl1 [lindex $val 1]
set pl2 [lindex $val 2]
set pci [format "%5.1f" [expr {$pci*100.}]]
set pci [format "%5.1f" [expr {$pci * 100.}]]
set pciLbl "Identity : $pci %"
set pl1Lbl "length 1 : $pl1"
set pl2Lbl "lenght 2 : $pl2"
set pl1Lbl "length seq 1 : $pl1"
set pl2Lbl "lenght seq 2 : $pl2"
return
}
......@@ -8814,7 +8816,6 @@ proc InitSeqsOut {{Etat ""}} {
proc AfficheFenetreOrdali {} {
global Defauts NomFenetreOrdali
#set w [winfo toplevel $NomFenetreOrdali]
set w $NomFenetreOrdali
grid rowconfig $w {0 1 3 4 5} -weight 0
......@@ -8844,6 +8845,7 @@ proc LanceOrdali {{behave slave} {aNomFenetreOrdali ""}} {
# init compulsory variables and arrays
set Threshold [set Defauts(Threshold)]
set ListeTypesDeFeatures {}
set FrmBtnFea {}
set ListeDesFragments {}
set NomSeqSel {}
set BufferSeq {}
......@@ -9440,12 +9442,12 @@ proc CheckInfosSeqs {{Liste ""}} {
return
}
array set Res $out
puts "\nOUTPUT:\n"
foreach k [array names Res "*,currAC"] {
puts "$k $Res($k)"
}
exit
set LaccNew [list]
foreach k [array names Res "*,currAC"] {
......
......@@ -975,7 +975,7 @@ proc RunRPCA {Ld} {
set NbRow [llength $Ld]
Rpipe "rm(list = ls())"
Rpipe "set.seed($::Defs(RSeed))"
Rpipe "set.seed($::Defauts(RSeed))"
Rpipe "data <- c([join [concat {*}$Ld] ,])"
Rpipe "data <- matrix(data,nrow=$NbRow,byrow=T)"
......
#
# ordali_misc.tcl
#
proc transpa {} {
LoadTkAndPackages
......@@ -234,6 +234,102 @@ proc Laetst {} {
}
proc WeightEigen {} {
# calcule les poids par eigen cf Valdar
global TDesPCI LNOrdali
# cree matrice distance
set nSeq 0 ; set Lnom {}
foreach n1 $LNOrdali {
if {$n1 eq ""} {
continue
}
lappend Lnom $n1
set t {}
foreach n2 $LNOrdali {
if {$n2 eq ""} {
continue
}
lappend t [expr {[lindex $TDesPCI($n1,$n2) 0] - 0.0}]
}
lappend M $t
incr nVal
}
# affiche matrice
set fmt "%7.3f"
foreach ligne $M nom $Lnom {
set aff "$nom "
foreach x $ligne {
append aff [format $fmt $x]
}
puts $aff
}
puts ""
package require Rtcl
lassign [RunRPCA $M] Lval Lvec Lx
#package require math::PCA
#lassign [RunTclPCA $M] Lval Lvec Lx
set Ldata [lindex Lvec 0]
set Ldata $Lval
set min 99999.0 ; set sum 0.0
set v0 {}
foreach v $Lval {
set v [expr {1.0/$v}]
lappend v0 $v
if {$v < $min} {set min $v}
}
set v1 {}
set delta 0.001
foreach v [lindex $Lvec 0] {
set nv [expr {$v - $min + $delta}]
lappend v1 $nv
set sum [expr {$sum + $nv}]
}
foreach v $v1 {
lappend v2 [expr {$v / $sum}]
}
# moyenne des PCI
set sum 0.0
foreach n $LNOrdali {
if {$n eq ""} {
continue
}
set s 0.0
foreach k [array names TDesPCI "$n,*"] {
set s [expr {$s + [lindex $TDesPCI($k) 0]}]
}
set s [expr {($s - 1) / ($nVal - 1.)}]
lappend tmp [format "%7.3f " $s]
set sum [expr {$sum + $s}]
}
set vm [lmap x $tmp {expr {$x / $sum}}]
set n 0
set l0 "" ; set l1 "" ; set l2 ""
foreach x0 $v0 x1 $v1 x2 $v2 xm $vm {
if {! ($n % 5)} {
puts $l0 ; puts $l1 ; puts $l2
puts ""
set l0 "" ; set l1 "" ; set l2 "" ; set lm ""
}
append l0 [format "%7.3f " $x0]
append l1 [format "%7.3f " $x1]
append l2 [format "%7.3f " $x2]
append lm [format "%7.3f " $xm]
incr n
}
puts $l0 ; puts $l1 ; puts $l2 ; puts $lm
return
}
proc PlotRScores {} {
global TableScore ListeScore
......@@ -286,27 +382,27 @@ proc tstdbP {} {
set Nc [d eval {select c.pk_chaines from pdb as p, chaines as c where p.nom=$nom and c.pk_pdb=p.pk_pdb and c.nom=$chn}]
puts "Nchn [llength $Nc] | $Nc"
set Nr [d eval {select r.pk_residues from pdb as p, chaines as c, residues as r where \
p.nom=$nom and \
c.pk_pdb=p.pk_pdb and \
c.nom=$chn and \
r.pk_chaines=c.pk_chaines and \
r.type=$rtype}]
p.nom=$nom and \
c.pk_pdb=p.pk_pdb and \
c.nom=$chn and \
r.pk_chaines=c.pk_chaines and \
r.type=$rtype}]
puts "Nres [llength $Nr] | [llength [lunique $Nr]]"
foreach anom {" CA " " C " " O "} {
set Na [d eval {select a.pk_atomes from pdb as p, chaines as c, residues as r, atomes as a where \
p.nom=$nom and \
c.pk_pdb=p.pk_pdb and \
c.nom=$chn and \
r.pk_chaines=c.pk_chaines and \
r.type=$rtype and \
a.pk_residues=r.pk_residues and \
a.anom=$anom}]
p.nom=$nom and \
c.pk_pdb=p.pk_pdb and \
c.nom=$chn and \
r.pk_chaines=c.pk_chaines and \
r.type=$rtype and \
a.pk_residues=r.pk_residues and \
a.anom=$anom}]
puts "Natm $anom [llength $Na] | [llength [lunique $Na]]"
}
exit
exit
set Lca [d eval "select r.pk_residues from atomes as a, $o as o, residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
......@@ -349,7 +445,7 @@ exit
}
puts ""
}
exit
exit
set bit [d eval "select ribbon, atomes, pearl, cpk from $o where pk_residues in ([join $lor ,])"]
puts "bit [expr {[llength $bit]/4}]"
foreach {r a p c} $bit {
......@@ -431,8 +527,8 @@ proc canid {} {
set y1 [expr {$j*10}]
set y2 [expr {($j+1)*10-1}]
$w create rectangle $x1 $y1 $x2 $y2 \
-fill blue \
-tags [list R$idx toto]
-fill blue \
-tags [list R$idx toto]
incr idx
}
}
......@@ -472,36 +568,36 @@ proc tdbl {} {
namespace import ::tcl::mathfunc::*
set L [list [list 24.2 57.9 18.0] \
[list 32.8 45.4 21.8] \
[list 51.3 28.1 20.5] \
[list 28.4 51.0 20.7] \
[list 63.6 27.9 8.5] \
[list 39.1 34.9 26.0] \
[list 56.1 21.7 22.2] \
[list 35.7 36.3 28.0] \
[list 46.2 42.4 11.4] \
[list 34.0 38.5 27.5] \
[list 35.4 38.3 26.3] \
[list 35.3 39.6 25.1] \
[list 56.4 29.2 14.4] \
[list 41.1 54.1 4.8] \
[list 25.8 7.4 66.8]]
[list 32.8 45.4 21.8] \
[list 51.3 28.1 20.5] \
[list 28.4 51.0 20.7] \
[list 63.6 27.9 8.5] \
[list 39.1 34.9 26.0] \
[list 56.1 21.7 22.2] \
[list 35.7 36.3 28.0] \
[list 46.2 42.4 11.4] \
[list 34.0 38.5 27.5] \
[list 35.4 38.3 26.3] \
[list 35.3 39.6 25.1] \
[list 56.4 29.2 14.4] \
[list 41.1 54.1 4.8] \
[list 25.8 7.4 66.8]]
set Le2 [list \
[list 61. 39. 0.] \
[list 60. 35. 5.] \
[list 59. 30. 9.] \
[list 58. 24. 18.] \
[list 57. 21.5 21.5] \
[list 55. 5. 40.] \
[list 55.1 10. 24.9] \
[list 65.2 0. 34.8] \
[list 65.3 5. 29.7] \
[list 65.4 10. 24.6] \
[list 65.5 15. 19.5] \
[list 45. 45. 10.] \
[list 50. 15. 35.] \
[list 48. 42. 10.]]
[list 61. 39. 0.] \
[list 60. 35. 5.] \
[list 59. 30. 9.] \
[list 58. 24. 18.] \
[list 57. 21.5 21.5] \
[list 55. 5. 40.] \
[list 55.1 10. 24.9] \
[list 65.2 0. 34.8] \
[list 65.3 5. 29.7] \
[list 65.4 10. 24.6] \
[list 65.5 15. 19.5] \
[list 45. 45. 10.] \
[list 50. 15. 35.] \
[list 48. 42. 10.]]
set Ls [list]
foreach e $L {
......@@ -559,17 +655,17 @@ proc tdbl {} {
proc Tlts {} {
set L [list \
[list 60. 40. 0.] \
[list 60. 35. 5.] \
[list 60. 30. 10.] \
[list 55. 5. 40.] \
[list 60. 20. 20.] \
[list 60. 25. 15.] \
[list 55. 10. 35.] \
[list 65. 0. 35.] \
[list 65. 5. 30.] \
[list 65. 10. 25.] \
[list 65. 15. 20.]]
[list 60. 40. 0.] \
[list 60. 35. 5.] \
[list 60. 30. 10.] \
[list 55. 5. 40.] \
[list 60. 20. 20.] \
[list 60. 25. 15.] \
[list 55. 10. 35.] \
[list 65. 0. 35.] \
[list 65. 5. 30.] \
[list 65. 10. 25.] \
[list 65. 15. 20.]]
set Ls [list]
foreach e $L {
......@@ -640,7 +736,7 @@ proc TrieDoubles {a b} {
return 0
}
proc vvide {} {
InitChemicals
......@@ -658,7 +754,7 @@ proc vvide {} {
append S "vdw\[$na\]=[set ::Chm(${na},vdw)]; "
if {! ($k%3
)} {
)} {
puts $S
set S ""
}
......@@ -935,33 +1031,33 @@ proc ViewerPourClonage {} {
set w $FrmBouton
button $w.fin -text "Accept limits" \
-command "EnvoieZoneACloner" \
-background green1 \
-width 7 -height 2
-command "EnvoieZoneACloner" \
-background green1 \
-width 7 -height 2
pack $w.fin -expand 1 -side left
button $w.dis -text "Dismiss" \
-command "AdieuOrdali" \
-background red \
-width 7 \
-height 2
-command "AdieuOrdali" \
-background red \
-width 7 \
-height 2
pack $w.dis -expand 1 -side left
button $w.cle -text "Clear" \
-command "DeselectToutesLesColonnes " \
-background cyan \
-width 7 \
-height 2
-command "DeselectToutesLesColonnes " \
-background cyan \
-width 7 \
-height 2
pack $w.cle -expand 1 -side left
button $w.sal -text "Select All" \
-command "SelectionneToutesColonnes" \
-background cyan \
-width 7 \
-height 2
-command "SelectionneToutesColonnes" \
-background cyan \
-width 7 \
-height 2
pack $w.sal -expand 1 -side left
button $w.hlp -text "Help" \
-command {eval source [file join $OrdHlpDir superposition.tcl]} \
-background magenta \
-width 7 \
-height 2
-command {eval source [file join $OrdHlpDir superposition.tcl]} \
-background magenta \
-width 7 \
-height 2
pack $w.hlp -expand 1 -side left
tkwait variable Retour
......@@ -1025,6 +1121,9 @@ proc TermineSelection {} {
CreeLesPiliers $LeGrpDesPiliersAcreer
set PilPoint [string repeat "." [llength $LNOrdali]]
set Encore 1
while {$Encore} {
set Idx [lsearch -exact $ListeDesPiliersDuGroupe(GroupeToutLeMonde) $PilPoint]
......@@ -1965,8 +2064,8 @@ proc InitWLC {lfile} {
set c $w.fc.c
set CanvasLC $c
canvas $c -scrollregion "0 0 $WinX $WinY" \
-width $WinX -height $WinY \
-relief raise -borderwidth 2 -background black
-width $WinX -height $WinY \
-relief raise -borderwidth 2 -background black
grid $c -row 0 -column 0 -sticky news
set x1 $Delta
......@@ -1990,8 +2089,8 @@ proc InitWLC {lfile} {
set tf [file rootname $f]
button $FBout.b$tf -text " $tf " \
-bg $col \
-command [list TraceVecLC $f $col]
-bg $col \
-command [list TraceVecLC $f $col]
grid $FBout.b$tf -row $cl -column 0 -sticky ew
incr cl
}
......@@ -2733,7 +2832,7 @@ proc Claudine {args} {
catch { eval exec $Commande} Message]
exit
exit
}
......@@ -2829,7 +2928,7 @@ proc DecortiqueGenBankLuc {aDE aOS aOC aSeqADN {FichierOuListe ""} {OffsetADN 0}
[regexp {^ORIGIN( |$)} $Ligne] || \
([regexp {[^0-9]\.\. *$} $Ligne] && ! [regexp {^ +/} $Ligne])} {
if { ! [regexp {[^0-9]\.\. *$} $Ligne] || \
[OuiOuNon "Please answer Yes if the line \n$Ligne\nis the last line of non DNA information ?"]} {
[OuiOuNon "Please answer Yes if the line \n$Ligne\nis the last line of non DNA information ?"]} {
set LaSuiteEstPourADN 1
continue
}
......@@ -2953,7 +3052,7 @@ proc DecortiqueGenBankLuc {aDE aOS aOC aSeqADN {FichierOuListe ""} {OffsetADN 0}
}
if {[expr ($Fin-$Debut+1)%3] \
&& ($RognerEnDebut && $RognerEnFin || \
! $RognerEnDebut && ! $RognerEnFin )} {
! $RognerEnDebut && ! $RognerEnFin )} {
if {$RogneEnDebutSIlFaut} {
set RognerEnDebut 1
set RognerEnFin 0
......@@ -4097,7 +4196,7 @@ proc DrawScore {{Lmeth ""}} {
proc VectDeLaRosace {} {
global OrdEtcDir TBlosum ListeDesAcidesAmines
# set f [file join $OrdEtcDir pam250.bla]
# set f [file join $OrdEtcDir pam250.bla]
set f [file join $OrdEtcDir blosum62.dat]
InitTBlosum $f
array set TPam [array get TBlosum]
......@@ -4210,11 +4309,11 @@ proc CorrelationAxe {Lref} {
proc Testlib {} {
global OrdEtcDir TBlosum ListeDesAcidesAmines
# set f [file join $OrdEtcDir pam250.bla]
# set f [file join $OrdEtcDir pam250.bla]
set f [file join $OrdEtcDir blosum62.dat]
InitTBlosum $f
# sans parametres --> gonnet250
# InitTBlosum
# InitTBlosum
array set TPam [array get TBlosum]
#set laa [lrange $ListeDesAcidesAmines 0 end-1]
set laa [split "ARNDCQEGHILKMFPSTWYV" ""]
......@@ -4233,7 +4332,7 @@ proc Testlib {} {
incr i
}
# set M [CentreReduitMatrice $M]
# set M [CentreReduitMatrice $M]
set M [CentreMatrice $M]
set Lv [eigenvectorsSVD $M]
......@@ -4288,15 +4387,17 @@ proc AnalyseValeursPropres {Le} {
proc AnalyseVecteursPropres {Ev {Cen 0}} {
puts ""
if {$Cen} {set Ev [CentreVecteur $Ev}
if {$Cen} {
set Ev [CentreVecteur $Ev]
}
set iPaaP [CorrelationAxe $Ev]
set Av [VecteurDeAAIndex $iPaaP]
set ccp [CoefficientCorrelation $Ev $Av]
puts [format "%s %6.3f" "Coef.Corr = " $ccp]
puts ""
return [list $iPaaP $ccp]
}
......@@ -4311,7 +4412,7 @@ proc FittingParRotation {Ev1 Ev2 Ev3 Av1 Av2 Av3 {Cen 0} {MAE 0}} {
}
}
}
set i 1
foreach x1 $Ev1 y1 $Ev2 z1 $Ev3 x2 $Av1 y2 $Av2 z2 $Av3 {
set W($i) 1.
......@@ -4352,13 +4453,13 @@ proc FittingParRotation {Ev1 Ev2 Ev3 Av1 Av2 Av3 {Cen 0} {MAE 0}} {
foreach x $NVa1 y $NVa2 z $NVa3 a $laa {
puts [format "%s | %7.4f" $a [S_nV [list $x $y $z]]]
}
puts ""
puts "V1 $NVa1"
puts "V2 $NVa2"
puts "V3 $NVa3"
puts ""
return
}
......@@ -4367,7 +4468,7 @@ proc RPCA {} {
global OrdEtcDir TBlosum ListeDesAcidesAmines
set laa [split "ARNDCQEGHILKMFPSTWYV" ""]
# set f [file join $OrdEtcDir pam250.bla]
# set f [file join $OrdEtcDir pam250.bla]
set f [file join $OrdEtcDir blosum62.dat]
InitTBlosum $f
puts "\nREFERENCE $f"
......@@ -4704,7 +4805,7 @@ proc TestPosPfam {{file ""}} {
foreach n $LNOrdali {
lappend LSOrdali [set Sequences($n)]
}
# ::profiler::reset
# ::profiler::reset
MetAJourGroupes
set NSqs [llength $SDG(GroupeToutLeMonde)]
......@@ -5023,7 +5124,7 @@ proc NewLiu {} {
set TBLiu(B,B) 10
set TBLiu(Z,Z) 10
set TBLiu(J,J) 10
# B <-> J
set vBJ 0
foreach a [list D N] {
......@@ -5366,11 +5467,11 @@ proc tpca {} {
package require math::linearalgebra
set lX [list \
[list 0.0 0.1 0.2 0.1 0.2] \
[list 0.1 0.0 0.1 0.2 0.1] \
[list 0.2 0.1 0.0 0.8 0.9] \
[list 0.1 0.2 0.8 0.0 0.9] \
[list 0.2 0.1 0.9 0.9 0.0]]
[list 0.0 0.1 0.2 0.1 0.2] \
[list 0.1 0.0 0.1 0.2 0.1] \
[list 0.2 0.1 0.0 0.8 0.9] \
[list 0.1 0.2 0.8 0.0 0.9] \
[list 0.2 0.1 0.9 0.9 0.0]]
#nist_pca $X
......@@ -5393,7 +5494,7 @@ proc tpca {} {
}
lappend 1mX $v
}
set R [::math::linearalgebra::eigenvectorsSVD $1mX]
lassign $R V1 V2
puts "V1\n[join $V1 \n]"
......@@ -5735,7 +5836,7 @@ proc sE {} {
lappend Ldel [list $d $f $n]
}
}
set g [set ::GroupeDeLaSequence(PDB_2dxi_A)]
puts "PDB_2dxi_A $g"
foreach nm [set ::SDG($g)] {
......@@ -5749,13 +5850,13 @@ proc sE {} {
incr f -1
set res [$db eval {select fi.pk_featali from featali as fi, seqali as si, ln_seqali_featali as ln where \
si.pk_seqinfo=$pkf and \
ln.pk_seqali=si.pk_seqali and \
fi.pk_featali=ln.pk_featali and \
fi.ftype='Discri' and \
fi.fstart=$d and \
fi.fstop=$f and \
fi.fnote=$n}]
si.pk_seqinfo=$pkf and \