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

debuggae PCI mode

parent 2ae56b05
...@@ -77,7 +77,16 @@ set VariablesAuDepart [info globals] ...@@ -77,7 +77,16 @@ set VariablesAuDepart [info globals]
### Launch ORDALIE ###### ### Launch ORDALIE ######
# Main program # Main program
InitLesDefauts 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] set retour [InterpreteLaLigneDeCommande $argv]
if {[ModeI]} { if {[ModeI]} {
LoadTkAndPackages LoadTkAndPackages
......
#
# ordali_StrucObj.tcl
#
proc SetupPDBObject {} { proc SetupPDBObject {} {
...@@ -57,7 +60,6 @@ proc SetupPDBObject {} { ...@@ -57,7 +60,6 @@ proc SetupPDBObject {} {
set nom [string range [self] 2 end] set nom [string range [self] 2 end]
set cok [my _DecortiqueUnPdbObject $Llignes $nom] set cok [my _DecortiqueUnPdbObject $Llignes $nom]
if {$cok == 0} { if {$cok == 0} {
return 0 return 0
} }
...@@ -197,9 +199,9 @@ proc SetupPDBObject {} { ...@@ -197,9 +199,9 @@ proc SetupPDBObject {} {
$db eval {insert into pdb values(NULL,$nom,$source,$Header)} $db eval {insert into pdb values(NULL,$nom,$source,$Header)}
set pkp [$db last_insert_rowid] set pkp [$db last_insert_rowid]
foreach n $ChnIdn { foreach n $ChnIdn {
set Ct [set TypChn($n)] set Ct [set TypChn($n)]
puts "$n $Ct"
if {$Ct eq "DNA" || $Ct eq "Water"} { if {$Ct eq "DNA" || $Ct eq "Water"} {
continue continue
} }
...@@ -364,7 +366,9 @@ proc SetupPDBObject {} { ...@@ -364,7 +366,9 @@ proc SetupPDBObject {} {
set Obsolete 0 set Obsolete 0
set lignesPDB [ExtraitLignesAtomesDuPDB $Llignes] set lignesPDB [ExtraitLignesAtomesDuPDB $Llignes]
set Header [ExtraitHeadDuPDB $Llignes] set Header [ExtraitHeadDuPDB $Llignes]
if {$lignesPDB == -1} {return 0} if {$lignesPDB == -1} {
return 0
}
# Is this entry superseeded ? # Is this entry superseeded ?
set Superseeded [my _superseed $Header] set Superseeded [my _superseed $Header]
...@@ -374,7 +378,7 @@ proc SetupPDBObject {} { ...@@ -374,7 +378,7 @@ proc SetupPDBObject {} {
return $Obsolete return $Obsolete
} }
set ChnIdn [list] set ChnIdn {}
# Traite chaines apres chaines # Traite chaines apres chaines
set Lter [lsearch -regexp -all $lignesPDB {^TER}] set Lter [lsearch -regexp -all $lignesPDB {^TER}]
set Lter [linsert $Lter 0 "0"] set Lter [linsert $Lter 0 "0"]
...@@ -392,13 +396,17 @@ proc SetupPDBObject {} { ...@@ -392,13 +396,17 @@ proc SetupPDBObject {} {
set d $f set d $f
continue 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 my _LectureDeChainePdbObject $LLignesChn $polymer
set d $f set d $f
} }
# Traitement des chaines # Traitement des chaines
set ChnIdn [lunique $ChnIdn] set ChnIdn [lunique $ChnIdn]
......
...@@ -3383,12 +3383,14 @@ proc ComputeIdentity {} { ...@@ -3383,12 +3383,14 @@ proc ComputeIdentity {} {
proc CherchePCI {w args} { 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" set pair1 "$nsq1,$nsq2"
if {! [info exists TDesPCI($pair1)]} { if {! [info exists TPCI($pair1)]} {
CalculeLesPCI "" "" $nsq1 $nsq2 CalculeLesPCI "" "" $nsq1 $nsq2
update update
} }
...@@ -3396,11 +3398,11 @@ proc CherchePCI {w args} { ...@@ -3396,11 +3398,11 @@ proc CherchePCI {w args} {
set pci [lindex $val 0] set pci [lindex $val 0]
set pl1 [lindex $val 1] set pl1 [lindex $val 1]
set pl2 [lindex $val 2] 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 pciLbl "Identity : $pci %"
set pl1Lbl "length 1 : $pl1" set pl1Lbl "length seq 1 : $pl1"
set pl2Lbl "lenght 2 : $pl2" set pl2Lbl "lenght seq 2 : $pl2"
return return
} }
...@@ -8814,7 +8816,6 @@ proc InitSeqsOut {{Etat ""}} { ...@@ -8814,7 +8816,6 @@ proc InitSeqsOut {{Etat ""}} {
proc AfficheFenetreOrdali {} { proc AfficheFenetreOrdali {} {
global Defauts NomFenetreOrdali global Defauts NomFenetreOrdali
#set w [winfo toplevel $NomFenetreOrdali]
set w $NomFenetreOrdali set w $NomFenetreOrdali
grid rowconfig $w {0 1 3 4 5} -weight 0 grid rowconfig $w {0 1 3 4 5} -weight 0
...@@ -8844,6 +8845,7 @@ proc LanceOrdali {{behave slave} {aNomFenetreOrdali ""}} { ...@@ -8844,6 +8845,7 @@ proc LanceOrdali {{behave slave} {aNomFenetreOrdali ""}} {
# init compulsory variables and arrays # init compulsory variables and arrays
set Threshold [set Defauts(Threshold)] set Threshold [set Defauts(Threshold)]
set ListeTypesDeFeatures {} set ListeTypesDeFeatures {}
set FrmBtnFea {}
set ListeDesFragments {} set ListeDesFragments {}
set NomSeqSel {} set NomSeqSel {}
set BufferSeq {} set BufferSeq {}
...@@ -9440,12 +9442,12 @@ proc CheckInfosSeqs {{Liste ""}} { ...@@ -9440,12 +9442,12 @@ proc CheckInfosSeqs {{Liste ""}} {
return return
} }
array set Res $out array set Res $out
puts "\nOUTPUT:\n" puts "\nOUTPUT:\n"
foreach k [array names Res "*,currAC"] { foreach k [array names Res "*,currAC"] {
puts "$k $Res($k)" puts "$k $Res($k)"
} }
exit
set LaccNew [list] set LaccNew [list]
foreach k [array names Res "*,currAC"] { foreach k [array names Res "*,currAC"] {
......
...@@ -975,7 +975,7 @@ proc RunRPCA {Ld} { ...@@ -975,7 +975,7 @@ proc RunRPCA {Ld} {
set NbRow [llength $Ld] set NbRow [llength $Ld]
Rpipe "rm(list = ls())" Rpipe "rm(list = ls())"
Rpipe "set.seed($::Defs(RSeed))" Rpipe "set.seed($::Defauts(RSeed))"
Rpipe "data <- c([join [concat {*}$Ld] ,])" Rpipe "data <- c([join [concat {*}$Ld] ,])"
Rpipe "data <- matrix(data,nrow=$NbRow,byrow=T)" Rpipe "data <- matrix(data,nrow=$NbRow,byrow=T)"
......
This diff is collapsed.
...@@ -90,7 +90,7 @@ proc ChangeMode {{mode ""}} { ...@@ -90,7 +90,7 @@ proc ChangeMode {{mode ""}} {
ChangeMode $modcou ChangeMode $modcou
} }
"donnepci" { "donnepci" {
if {$modcou ne "ordali" && $modcou ne "feature"} { if {$modcou ni {"ordali" "feature"}} {
set pmod [string totitle $mode] set pmod [string totitle $mode]
FaireLire "Please leave $pmod mode first !" FaireLire "Please leave $pmod mode first !"
return return
...@@ -379,13 +379,15 @@ proc AfficheBoutonsAnnotation {} { ...@@ -379,13 +379,15 @@ proc AfficheBoutonsAnnotation {} {
proc AfficheBoutonsPCI {} { proc AfficheBoutonsPCI {} {
global LNOrdali FrmBouton OrdEtcDir nsq1 nsq2 pciLbl pl1Lbl pl2Lbl LesPCI ListeTypesDeFeatures ZoneSelect ZonePCI global LNOrdali FrmBouton OrdEtcDir nsq1 nsq2 pciLbl pl1Lbl pl2Lbl TDesPCI TPCI ListeTypesDeFeatures ZoneSelect ZonePCI
if {[TypeAli] eq "pasdali"} {return} if {[TypeAli] eq "pasdali"} {return}
set LNoms "Select" set LNoms "Select"
foreach n $LNOrdali { foreach n $LNOrdali {
if {$n ne ""} {lappend LNoms $n} if {$n ne ""} {
lappend LNoms $n
}
} }
set LMx [PlusLongEltDe $LNoms] set LMx [PlusLongEltDe $LNoms]
...@@ -430,16 +432,16 @@ proc AfficheBoutonsPCI {} { ...@@ -430,16 +432,16 @@ proc AfficheBoutonsPCI {} {
grid columnconfig $wp.falcl 1 -weight 1 grid columnconfig $wp.falcl 1 -weight 1
button $wp.bdo \ button $wp.bdo \
-background yellow \
-text "Compute" \ -text "Compute" \
-background yellow \
-command [list ComputeIdentity] -command [list ComputeIdentity]
grid $wp.bdo -row 0 -column 1 -sticky nsw -padx 20 -pady 5 grid $wp.bdo -row 0 -column 1 -sticky nsw -padx 20 -pady 5
set nsq1 [lindex $LNoms 0] set nsq1 [lindex $LNoms 0]
set nsq2 [lindex $LNoms 0] set nsq2 [lindex $LNoms 0]
set pciLbl "Identity :" set pciLbl "Identity :"
set pl1Lbl "length 1 :" set pl1Lbl "length seq 1 :"
set pl2Lbl "length 2 :" set pl2Lbl "length seq 2 :"
frame $wp.fse frame $wp.fse
label $wp.fse.ls1 \ label $wp.fse.ls1 \
...@@ -510,6 +512,7 @@ proc AfficheBoutonsPCI {} { ...@@ -510,6 +512,7 @@ proc AfficheBoutonsPCI {} {
} }
AfficheZonesSelectionnees $ZonePCI AfficheZonesSelectionnees $ZonePCI
StockPosition StockPosition
array set TPCI [array get TDesPCI]
tkwait window $FrmBouton.fpci tkwait window $FrmBouton.fpci
......
...@@ -956,6 +956,77 @@ proc DonneListeCleValeur {options} { ...@@ -956,6 +956,77 @@ proc DonneListeCleValeur {options} {
} }
proc ConvertAliHelp {} {
puts "\nUsage : convertali <input-file> <output-file> ?-convert <format>?\n"
puts "The output file format may be specified using the file extension or by specifying a format after the -convert keyworkd. Valid extensions and format are :"
puts " - .tfa, .fasta, .fa : fasta format"
puts " - .macsim, .macsims, .xml : macsims format"
puts " - .msf : msf format"
puts " - .ord : ordalie format"
puts ""
exit
}
proc InterpreteArgv0 {ligne} {
set Largs [split $ligne " "]
set prog [file tail $::argv0]
switch $prog {
"ordali" -
"ordalie" {
if {$Largs == {}} {
puts "\ntype 'ordalie help' to access on-line arguments\n"
LoadTclPackages
}
}
"convertali" {
if {$Largs == {}} {
ConvertAliHelp
}
if {[llength $Largs] ni {2 4}} {
puts "Error :\nWrong number of arguments !"
ConvertAliHelp
}
if {[llength $Largs] == 2} {
lassign $Largs in out
set ext [string tolower [string range [file extension $out] 1 end]]
switch $ext {
"fasta" -
"tfa" -
"fa" {set format "tfa"}
"macsims" -
"macsim" -
"xml" {set format xml}
"aln" -
"clustal" {set format aln}
"msf" {set format msf}
default {
puts "\nError :\nUndefined output format !"
ConvertAliHelp
}
}
} else {
# file-in file-out -convert format
if {[lindex $Largs 2] ne "-convert"} {
puts "\nError :\nBad keyword [lindex $Largs 2]"
ConvertAliHelp
}
set format [lindex $Largs 3]
if {$format ni {tfa aln xml msf}} {
puts "Error :\nBad format >$format< !"
ConvertAliHelp
}
}
set ligne "$in -convert $format $out"
}
}
return [split $ligne " "]
}
proc InterpreteLaLigneDeCommande {Ligne} { proc InterpreteLaLigneDeCommande {Ligne} {
global env AExecuter APutser global env AExecuter APutser
...@@ -969,18 +1040,16 @@ proc InterpreteLaLigneDeCommande {Ligne} { ...@@ -969,18 +1040,16 @@ proc InterpreteLaLigneDeCommande {Ligne} {
Espionne "options : $::argv" Espionne "options : $::argv"
Espionne "---------------------------------------------------" Espionne "---------------------------------------------------"
Espionne "" Espionne ""
# Pour Julie, enleve les = au cas ou ... # Pour Julie, enleve les = au cas ou ...
set Ligne [string map {= " "} $Ligne] set Ligne [string map {= " "} $Ligne]
regsub -all { +} $Ligne " " Ligne regsub -all { +} $Ligne " " Ligne
set Ligne [string trim $Ligne] set Ligne [string trim $Ligne]
set Ligne [InterpreteArgv0 $Ligne]
# Pas d'arguments # Pas d'arguments
if {$Ligne eq ""} { if {$Ligne eq ""} {
puts "\ntype 'ordalie help' to access on-line arguments\n"
LoadTclPackages
return return
} }
...@@ -1160,7 +1229,6 @@ proc InterpreteLaLigneDeCommande {Ligne} { ...@@ -1160,7 +1229,6 @@ proc InterpreteLaLigneDeCommande {Ligne} {
LesDefauts DownloadPDB dont LesDefauts DownloadPDB dont
LesDefauts Mode Batch LesDefauts Mode Batch
LesDefauts Exit 1 LesDefauts Exit 1
LesDefauts DownloadPDB none
set AExecuter "SauveLAlignement $fmt JLeSauveAs" set AExecuter "SauveLAlignement $fmt JLeSauveAs"
} }
"-project" { "-project" {
...@@ -4754,3 +4822,15 @@ proc LogProc {name args} { ...@@ -4754,3 +4822,15 @@ proc LogProc {name args} {
update idletasks update idletasks
} }
proc plist {liste format} {
set out {}
foreach v $liste {
lappend out [format $format $v]
}
puts [join $out]
return
}
...@@ -1403,140 +1403,6 @@ proc DefineGapThreshold {nseq} { ...@@ -1403,140 +1403,6 @@ proc DefineGapThreshold {nseq} {
} }
proc WeightsDeLuc {Ln LPCI} {
# circular weights
#
# wi = sum_i!=j wj x d(si,sj)
# w = D x w
# (1 - D)x w = 0
#
# D = distance matrix
# w = vector of weights
#
# solved using eigen decomposition
# weights are coordinates of eigenvector of the
# highest eigenvalue
#
package require math::linearalgebra
set Ns [llength $Ln]
set b [::math::linearalgebra::mkVector $Ns 1.0]
set mt [::math::linearalgebra::mkMatrix $Ns $Ns 0.]
set mf [::math::linearalgebra::mkMatrix $Ns $Ns 0.]
# Matrix (1-D)
# D = 1 - pci so 1 - D = pci
array set T $LPCI
set Md [list]
foreach a $Ln {
set Lv [list]
foreach b $Ln {
lappend Lv [lindex [set T($a,$b)] 0]
}
lappend Md $Lv
}
# eigen decomposition
set Msg ""
catch {set R [::math::linearalgebra::eigenvectorsSVD $Md]} Msg
if {$Msg ne ""} {
set Ns [llength $Ln]
set v [expr {1.0/$Ns}]
set Lw [lrepeat $Ns $v]
FaireLire "Error while computing Eigen decomposition !\nAll weights are set to $v"
puts "Error while computing Eigen decomposition !\nAll weights are set to $v"
return $Lw
}
lassign $R V1 V2
# vector with highest eigenvalue ranks 0
set Lv [lindex $V1 0]
# puts weights so that sum wi = 1.
set b [lsort -real $Lv]
set min [lindex $b 0]
set max [lindex $b end]
set eps 0.01
set s 0.0
foreach v $Lv {
set x [expr {($v - $min + $eps)/($max - $min + $eps)}]
lappend Lx $x
set s [expr {$s + $x}]
}
set sum 0.0
set Lw [list]
foreach x $Lx {
set n [expr {$x / $s}]
lappend Lw $n
set sum [expr {$sum + $n}]
}
return $Lw
}
proc WeightDeHenikoff {ListePil} {
# Henikoff and Henikoff
#
# wi= 1/L sum 1/(Kx.Nx)
# L = alignment length
# Kx = number of amino acid types at position x
# Nx = number of amino acid at pos x that
# are the same as seq i
# inits
set NbSeq [string length [lindex $ListePil 0]]
for {set i 0} {$i < $ns} {incr i} {
set w($i) 0.0
}
# loop over all positions
foreach p $ListePil {
# number of elements
set lp [split $p ""]
set kx [llength [lsort -unique $lp]]
set i -1
foreach a $lp {
incr i
if {$a ne "."} {
set na [expr {$NbSeq - [string length [string map [list $a ""] $p]]}]
set w($i) [expr {[set w($i)] + 1./($na*$kx)}]
}
}
}
set Lw [list]
set len [expr {double([llength $Lpil])}]
for {set i 0} {$i < $NbSeq} {incr i} {
lappend Lw [expr {[set w($i)]/$len}]
}
return $Lw
}
proc WeightDeVingron {Ln LPCI} {
# Argos and Vingron
# wi = 1/(N-1) sum_i!=j d(si,sj)
# moyenne des distance de seq j aux autres
array set T $LPCI
set Ns [llength $Ln]
foreach a $Ln {
set sum 0.0
foreach b $Ln {
if {$a eq $b} {continue}
# Attention ! distance, pas PCI
set sum [expr {$sum + (1. - [lindex [set T($a,$b)] 0])}]
}
lappend Lw [expr {$sum/($Ns-1)}]
}
return $Lw
}
########################################## ##########################################
# #
# SCORING FUNCTIONS # SCORING FUNCTIONS
......
...@@ -1799,24 +1799,21 @@ proc TraiteAABizarres {{force 0}} { ...@@ -1799,24 +1799,21 @@ proc TraiteAABizarres {{force 0}} {
proc AssigneLePoidsDesSeqs {} { proc AssigneLePoidsDesSeqs {} {
global LePoidsDesSeqs IdXml LesPoidsDesSequences FichierXML FichierMSF LNOrdali
global LePoidsDesSeqs
global IdXml
global LesPoidsDesSequences
global LNOrdali
global FichierMSF
global FichierXML
set LePoidsDesSeqs {} set LePoidsDesSeqs {}
if {[info exists FichierMSF]} { if {[info exists FichierMSF]} {
LitLesPoidsDuMSF $FichierMSF LitLesPoidsDuMSF $FichierMSF
foreach n $LNOrdali { foreach n $LNOrdali {
if {$n eq ""} {
continue
}
set p [set LesPoidsDesSequences($n)] set p [set LesPoidsDesSequences($n)]
lappend LePoidsDesSeqs $p lappend LePoidsDesSeqs $p
} }
} }
if {[info exists FichierXML]} { if {[info exists FichierXML]} {
ExtraitLesPoids $IdXml LePoidsDesSeqs ExtraitLesPoidsDuXML $IdXml LePoidsDesSeqs
} }
return return
...@@ -2914,5 +2911,173 @@ proc tbug {} { ...@@ -2914,5 +2911,173 @@ proc tbug {} {
} }
proc CalculeLesPoidsDesSeqs_mean {{normalise 1}} {
# Argos and Vingron
# wi = 1/(N-1) sum_i!=j d(si,sj)
# moyenne des distance de seq j aux autres
global LPCI TDesPCI LNOrdali
set Lwgt {}
set nSeqs 0
foreach n $LNOrdali {
if {$n eq ""} {
continue
}
incr nseqs
set sum 0.0
foreach n1 $LNOrdali {
if {$n1 eq "" || $n eq $n1} {
continue
}
set sum [expr {$sum + (1. - [lindex $TDesPCI($n,$n1) 0])}]
}
lappend Lsum $sum
}