Commit 80a47313 authored by luc.moulinier's avatar luc.moulinier

bug superposition

parent 3251bae8
......@@ -99,5 +99,3 @@ if {$retour eq ""} {
######## Ca finit ici #####################
#
#
# ordali_StrucObj.tcl
......@@ -2087,8 +2088,8 @@ proc SetupPDBObject {} {
#glMaterialfv GL_BACK GL_AMBIENT_AND_DIFFUSE {0.0 0.0 0.0 1.0}
# Recupere atomes contribuant a la surface
set Lva [list]
$db eval "select a.x, a.y, a.z, a.na from atoms as a, $obj as o where a.pk_atoms = o.pk_obj and o.surface=1" {lappend Lva [list $x $y $z $na 1]}
set Lva {}
e$db eval "select a.x, a.y, a.z, a.na from atoms as a, $obj as o where a.pk_atoms = o.pk_obj and o.surface=1" {lappend Lva [list $x $y $z $na 1]}
set Lva [lsort -unique $Lva]
#lassign [tsurf -sample 2 -expand 2 -contract 2 -smooth -connolly -filter 13 $Lva] Lv Ln
#lassign [tsurf -sample 2 -expand 2 -contract 2 -smooth -connolly $Lva] Lv Ln
......@@ -3179,6 +3180,47 @@ proc SetupPDBObject {} {
return
}
oo::define Structure method _dbEval {cmd} {
my variable db
set res [$db eval $cmd]
return $res
}
oo::define Structure method RotTrans {chn} {
my variable Rot Trans db
set nom [string range [self] 2 end]
array set TM $Rot
array set TT $Trans
set M [M_T TM]
set T [V_T TT]
lassign $M aM bM cM
lassign $T t1 t2 t3
$db eval {begin transaction}
set Lr [$db eval {select a.x,a.y,a.z,a.pk_atoms from atoms as a, chains as c, pdb as p where \
p.name = $nomm and \
c.pk_pdb = p.pk_pdb and \
c.name = $chn and \
a.pk_chains = c.pk_chains}]
foreach {x y z ix} $Lr {
set nx [VMT $x $y $z $aM $t1]
set ny [VMT $x $y $z $bM $t2]
set nz [VMT $x $y $z $cM $t3]
$db eval {update atoms set x=$nx, y=$ny, z=$nz where pk_atoms=$ix}
}
$db eval {commit}
[self] _Dimensions
[self] ResetDrawing
}
oo::define Structure method CopiePDB {new} {
my variable db
......@@ -3193,7 +3235,7 @@ proc SetupPDBObject {} {
}
oo::define Structure export CPK CopiePDB CoordsSeq2PDB CoordsPDB2Seq _SetB _EtatDeObjet ObjetOn ObjetOff _ListeObjets _mapfeat _dellist Ind2Obj AddPicked AtomXYZ _chains _chainIs _resnumber _resname _Dimensions SecStr PDBInfos SSBin CoordsDeAtom AddVar GiveVar ClearPicked SetVar _SetupPicking AllLabels ResetDrawing ResidueCDM dbref _seqres title _seqadv _lookup _source _RemplitLeSQL
oo::define Structure export _dbEval CPK CopiePDB CoordsSeq2PDB CoordsPDB2Seq _SetB _EtatDeObjet ObjetOn ObjetOff _ListeObjets _mapfeat _dellist Ind2Obj AddPicked AtomXYZ _chains _chainIs _resnumber _resname _Dimensions SecStr PDBInfos SSBin CoordsDeAtom AddVar GiveVar ClearPicked SetVar _SetupPicking AllLabels ResetDrawing ResidueCDM dbref _seqres title _seqadv _lookup _source _RemplitLeSQL RotTrans
return
}
......@@ -3382,7 +3424,7 @@ proc InfosDesPDB {} {
if {$::Defauts(DownloadPDB) eq "dont"} {
return
}
foreach e $::ListePDB {
set mol [DonneIdDeAccessPDB $e]
set chn [DonneChainDeAccessPDB $e]
......
......@@ -957,11 +957,11 @@ proc TraitePDBDeLAlignement {} {
global ListePDB BadPDB HashPDB Sequences LNOrdali PBV PBW PipeCollection Warn LSOrdali SDG Defauts
set ListePDB {}
set BadPDB {}
set BadPDB {}
set HashPDB(iHmax) 0
set ix -1
set PBW "Treating PDB sequences ...."
set PBV 0.
set PBW "Processing PDB sequences ...."
set PBV 0.0
set Nseq [llength $LNOrdali]
set LNtmp $LNOrdali
set ToChange [list]
......@@ -979,15 +979,16 @@ proc TraitePDBDeLAlignement {} {
if {[set Defauts(DownloadPDB)] eq "dont"} {
# PDB should not be seeen as PDBs
lappend ToChange [list $ix $pdbid $chn 1]
continue
}
set ChgN 0 ; set ChgC 0
# try DownloadPDB dont
if {$pdbid ni [info commands] && $Defauts(DownloadPDB) ne "dont"} {
if {[string toupper $pdbid] ni [info commands]} {
set cok [LoadNouveauPDB $pdbid]
if {$cok == 0} {
lappend BadPDB $ix
......@@ -1018,10 +1019,18 @@ proc TraitePDBDeLAlignement {} {
lappend ListePDB $newname
# update names in group array
if {$cok == 1} {
lappend ToChange [list $ix [string toupper $pdbid] $chn 0]
}
if {0 && [info exists Sequences($seq)]} {
set Sequences($newname) $Sequences($seq)
#unset Sequences($seq)
}
if {[info exists SDG]} {
foreach grp [array names SDG] {
if {[set isdg [lsearch [set SDG($grp)] $seq]] != -1} {
set SDG($grp) [lreplace [set SDG($grp)] $isdg $isdg $newname]
lset SDG($grp) $isdg $newname
}
}
}
......@@ -1043,7 +1052,7 @@ proc TraitePDBDeLAlignement {} {
puts "old $old newn $newn"
}
set LNtmp [lreplace $LNtmp $i $i $newn]
lset LNtmp $i $newn
set seq [lindex $LSOrdali $i]
unset Sequences($old)
set Sequences($newn) $seq
......@@ -1625,6 +1634,7 @@ proc InitSequences {} {
}
# sec. str., setups ... des PDB
puts "\nFINAL\n[lsearch -inline -all $LNOrdali *ekg*]"
InfosDesPDB
# not implemented yet ...
......@@ -2902,13 +2912,6 @@ invoked from within
("after" script)
}
proc tbug {} {
LoadTkAndPackages
set out [DemandeEtSauveFichier "tfa" 1]
exit
}
proc CalculeLesPoidsDesSeqs_mean {{normalise 1}} {
# Argos and Vingron
......@@ -3148,3 +3151,16 @@ proc Reigen {} {
return $vec
}
proc lslr {} {
set L [list totosldkfj slmdkfj qsdlkmfj aupe jqsdklf auior fqjk qsdfjk qsklfj qm fjkd zoie jfkdlsl sdk skdfj q qs sq sdf qsdff klqsdf sdfmjklsdfq sdfq sdf qsfjhzeeiofsjksdf]
set t1 [time {lset L 3 armada} 100000]
puts "t1 $t1"
set t2 [time {set L [lreplace $L 3 3 armada]} 100000]
puts "t2 $t2"
exit
}
......@@ -1444,7 +1444,13 @@ proc eFetchREST {db Lid {what ""}} {
set query [::http::formatQuery {*}$Loptions]
# HttpCopy returns a text string
set ddb [HttpCopy $url "" $query]
package require TclCurl
if {[catch {set out [curl::transfer -followlocation 1 -url $url -bodyvar ddb -post 1 -postfields $query]}]} {
puts "Error while transfering data !"
set ddb ""
}
#set ddb [HttpCopy $url "" $query]
if {$ddb eq ""} {
return ""
}
......@@ -1851,7 +1857,28 @@ proc eSearchProcessXML {Lxml} {
}
proc eSummaryREST {db Lid {GetXml ""}} {
proc eSummaryGetInfo {Lid Ltab what} {
set Lres {}
array set T $Ltab
foreach id $Lid {
set Lix [lsearch -all -nocase $Ltab $id]
if {$Lix != {} } {
lassign [split [lindex $Ltab [lindex $Lix 0]-1] ,] GI tmp
if {[info exists T($GI,$what)]} {
lappend Lres $T($GI,$what)
} else {
lappend Lres ""
}
} else {
lappend Lres ""
}
}
return $Lres
}
proc eSummaryREST {db Lid {What ""} {GetXml ""}} {
# Part of eUtils from NCBI
#
# ==> WARNING !!!!
......@@ -1861,7 +1888,7 @@ proc eSummaryREST {db Lid {GetXml ""}} {
#
# proceed by 200 IDs batches
set url "https://eutils.ncbi.nlm.nih.gov/entrez/eutils/esummary.fcgi"
set Lres [list]
set Lres {}
set Paquet 200
set ni [expr {int([llength $Lid]/$Paquet)+1}]
set LesXml {}
......@@ -1874,13 +1901,23 @@ proc eSummaryREST {db Lid {GetXml ""}} {
id [lrange $Lid $d $f] \
retmax 1000]
set ddb [HttpCopy $url "" $query]
if {$GetXml=="GetXml"} {
if {$GetXml eq "GetXml"} {
lappend LesXml $ddb
continue
}
lappend Lres {*}[eSummaryProcessXML $ddb]
}
if {$GetXml=="GetXml"} { return $LesXml }
if {$GetXml eq "GetXml"} {
return $LesXml
}
# get desired info
if {$What ne ""} {
set Lres [eSummaryGetInfo $Lid $Lres $What]
}
return $Lres
}
......@@ -3901,9 +3938,72 @@ proc tatta {} {
proc mm {} {
array set t [eSummaryREST protein NP_001297087]
parray t
exit
}
# changer HttpCopy par
# curl::transfer -nobody 1 -header 1 -headervar head_var -url $url
proc getlc {} {
#set id NP_001297087
set id XP_029851736.1
#set Lt [eSummaryREST protein $id]
#set Lt [eSummaryREST protein $id Length]
set o [eFetchREST protein $id]
DecortiqueGenBank "" "" "" $o "" "" "" ref
puts $ref ; exit
puts "$Lt" ; exit
array set t $Lt
foreach k [array names t] {
lassign [split $k ,] tmp key
lappend Lkey $key
}
parray t
puts ""
puts [join [lsort $Lkey] \n]
puts ""
set Lix [lsearch -all $Lt $id]
foreach i $Lix {
puts "[lindex $Lt $i-1] [lindex $Lt $i]"
}
#puts [join [lsearch -all -inline -nocase $Lt "geneid"] \n]
exit
}
proc pl {} {
set Li [LesLignesDuFichier ~/l.txt]
cd /commun/bics/IDMapping/production
set Lrs [LesLignesDuFichier REFSEQ.dat]
puts "file loaded"
foreach id $Li {
set id [string toupper [file rootname $id]]
set o [lsearch -inline -all $Lrs $id]
puts "$id $o"
}
return
}
proc pl2 {} {
set Lid XP_029851736.1
set Lid XP_001297087
set l [eFetchREST protein $Lid]
#puts $l ; exit
DecortiqueGenBank "" "" "" $l "" "" "" ref
puts "\ndb_xref : $ref"
exit
}
......@@ -758,14 +758,18 @@ proc Luc_bgerror {err} {
} else {
set user "unknown"
}
set msg "[DonneDateEtHeure]
File : $::Defauts(Fichier[TypeAli])
$::errorInfo
"
catch {send_simple_message luc.moulinier@unistra.fr localhost "\[Bug-Ordalie\] $user: $err" $msg}
if {$user eq "moumou"} {
puts "\n$msg\n"
} else {
catch {send_simple_message luc.moulinier@unistra.fr localhost "\[Bug-Ordalie\] $user: $err" $msg}
}
set errorInfo $old_errorInfo
Old_bgerror $err
......
......@@ -237,36 +237,10 @@ proc AppliqueSuperposition {} {
foreach nmch [lrange $StrucAVoir 1 end] {
set elt [DonneIdDeAccessPDB $nmch]
set chn [DonneChainDeAccessPDB $nmch]
array set TM [$elt GiveVar Rot]
array set TT [$elt GiveVar Trans]
set M [M_T TM]
set T [V_T TT]
lassign $M aM bM cM
lassign $T t1 t2 t3
set pdb $elt
set dbPDB "root[string toupper $elt]"
$dbPDB eval {begin transaction}
set Lr [$dbPDB eval {select a.x,a.y,a.z,a.pk_atoms from atoms as a, chains as c, pdb as p where \
p.name=$pdb and \
c.pk_pdb=p.pk_pdb and \
c.name=$chn and \
a.pk_chains=c.pk_chains}]
foreach {x y z ix} $Lr {
set nx [VMT $x $y $z $aM $t1]
set ny [VMT $x $y $z $bM $t2]
set nz [VMT $x $y $z $cM $t3]
$dbPDB eval {update atoms set x=$nx, y=$ny, z=$nz where pk_atoms=$ix}
}
$dbPDB eval {commit}
$elt _Dimensions
$elt ResetDrawing
$elt RotTrans $chn
}
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