Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

« Newer Snippets
Older Snippets »
Showing 1-8 of 8 total  RSS 

Scripted Atom-Highlight in VMD

Tcl-procedure for VMD. Embed this function and be happy.


# Highlight a certain selection. Selection is ONLY A STRING, not an atomselection
# Example:
# set repr "Licorice 0.300000 10.000000 30.000000"
# highlighting 0 $repr $id_KcsA "segid 1SG and resid 26 to 50 and not backbone"
# 
proc highlighting { colorId representation id selection } {
   set id [[atomselect $id $selection] molid]
   puts "highlighting $id"
   mol delrep 0 $id
   mol representation $representation
   mol color ColorID $colorId
   mol selection $selection
   mol addrep $id
}

set repr "Licorice 0.300000 10.000000 30.000000"
highlighting 0 $repr $id "segid 1SG and resid 26 to 50 and not backbone"

Statistics Usage

This is a little demonstration of how to use statistics with TCL. Here, I provide two methods: 1. Trivially, some PROCS that perform statistic calulations. However, you are *NOT* supposed to use these, but use rather build-in statistics from 2. math::statistics (provided by tcllib that must be installed).

#!/usr/bin/tclsh
# statistics-usage.tcl
#
# 2005 by Sascha Tayefeh
#
# This is a little demonstration of how to use statistics
# with TCL. Here, I provide two methods: 1. Trivially, some
# PROCS that perform statistic calulations. However, you
# are *NOT* supposed to use these, but use rather build-in
# statistics from 2. math::statistics (provided by tcllib
# that must be installed).
#
# for further information read
# http://aspn.activestate.com/ASPN/docs/ActiveTcl/tcllib/math/statistics.html
#
#
package require Tcl 8.4
package require math::statistics

proc sas_sum { valist } {
    set summe 0.0
    foreach val $valist {
	set summe [ expr $summe + $val ]
    }	
    return $summe
}

proc sas_mean { valist } {
    set n [ llength $valist ]
    set sum [ sas_sum $valist ]
    set mean [ expr $sum / $n ]
    return $mean
}

proc sas_variance { valist } { 
    set variance 0.0
    set mean [ sas_mean $valist ]
    set n [ llength $valist ]
    foreach val $valist {
	set buff [ expr $val - $mean ] 
	set buff [ expr pow ($buff,2)]
	set variance [ expr $variance + $buff ]
    }
    set variance [ expr $variance / $n ]
    return $variance
}

proc sas_deviation { valist } {
    set variance [ sas_variance $valist ] 
    set deviation [ expr sqrt ($variance) ]

    return $deviation
}

#set data1 [ list 5 2.4 5.3 2.3 4.3 2.3 3.3 4.4 5.4 3.4 5.4 2.3 1.2 3.4]
#set data2 [ list 1.9 -2.4 -5.3 2.3 4.3 2.3 2.3 4.4 5.4 3.4 4.4 2.3 1.2 3.4]


# fills data1 with normal-distributed values: <mean> <stdev> <n>
set data1 [::math::statistics::random-normal 2.4 2 10]
set data2 [::math::statistics::random-normal 5.4 2 10]

set mean 	[ sas_mean $data1 ]
set variance 	[ sas_variance $data1 ]
set deviation 	[ sas_deviation $data1 ]

puts "\nFrom Custom Procs:"
puts "Mean: $mean, Variance: $variance, stDev: $deviation"

puts "\nFrom ::math::statistics:: (needs tcllib)"
set mean [  ::math::statistics::mean $data1 ]
set variance [  ::math::statistics::var $data1 ]
set deviation  [  ::math::statistics::stdev $data1 ]
set corr [::math::statistics::corr $data1 $data2 ]
set crosscorr [::math::statistics::crosscorr $data1 $data2 ]
set autocorr [::math::statistics::autocorr $data1 ]
#set confi [::math::statistics::interval-mean-stdev $data1 0.95]

puts "Mean: $mean, Variance: $variance, stDev: $deviation"
puts "Corr: $corr"

puts "Autocorr: $autocorr\nCrosscorr: $crosscorr"


shell-to-array

Demonstration: How to obtain variables / arrays from unix shell

#!/usr/bin/tclsh
# Demonstration: How to obtain variables / arrays from unix shell
#

proc tokenize {buf} {
   set exp {[^ \t]*[ \t]*}
   # use "-indices" if you just care about the indices
   return [regexp -all -inline -- $exp $buf]
}

# get a number from shell
set p [exec ls -1 | grep "" -c ]
puts "Got a number from shell: $p"

set v [exec ls -1]

# the RegExp way: Matches everything from the beginning to the end of a line
set exp {^.*$} 

# create an array of files
set filelist [regexp -line -all -inline -- $exp $v]

# The ancient C-Way would have looked like this:
#for { set i 0} {$i < $p} { incr i } {
#   scan $v "%s%n" file length
#   lappend filelist $file
#   set v [string range $v $length end]
#}
#

# show list
foreach file $filelist  {
   puts $file
}

# and tell me the length
puts [llength $filelist ]

Calculate Argument

Calculate the argument of a complex number using math:: class.

#!/usr/bin/tclsh
package require Tcl 8.4
package require math::complexnumbers
package require math::constants
package require math::statistics

# Create Constants
::math::constants::constants radtodeg 
::math::constants::constants pi

# Perform Operations
set z 		[ ::math::complexnumbers::complex -2 12]
set zstring 	[ ::math::complexnumbers::tostring $z]
set comp 	[ ::math::complexnumbers::arg $z ]
set dcomp 	[ expr $comp * $radtodeg]

# Results
puts "::math::complexnumbers::arg returned $comp rad ($dcomp deg) for the complex number $zstring"

Parse Data-File and Do some Maths (Alternate)

An alternate (but SLOW) way to proceed tabular data from a textfile
This one uses fileutil for proceeding the file.

#!/usr/bin/tclsh
#
# fileutils.tcl
# 
# An alternate (but SLOW) way to proceed tabular data from a textfile
# This one uses fileutil for proceeding the file
# 
#
#
package require Tcl 8.4
package require fileutil 
package require textutil
package require math::statistics

namespace import ::fileutil::*
namespace import ::textutil::*
namespace import ::math::statistics::*

set filename "data.dat"
puts "Reading file $filename"

foreachLine line $filename { 
	set vdata  [ splitx $line "\t"]
	lappend x [ lindex $vdata 0]
	lappend y [ lindex $vdata 1]
}

puts "Lines read:"
puts [llength $x] 
puts "Calculating statistics"
#puts "\nx-column:"
#foreach dx $x { puts $dx }

#puts "\ny-column:"
#foreach dy $y { puts $dy }

set meany [mean $y]
set vary [var $y]
set stdevy [stdev $y]

puts "Mean y: $meany, Var x: $vary, StDev x: $stdevy"


Parse Data-File and Do some Maths

A FAST way to proceed tabular data from a textfile. Also, do some statistics with tcl-math class. The data-file must look like this:

1 -62805
2 -62468
3 -62351
4 -62408
5 -62256
6 -62473
7 -62759
8 -62768

#!/usr/bin/tclsh
#
# fileio.tcl
# 
# A FAST way to proceed tabular data from a textfile
# Also, do some statistics with tcl-math class. The
# data-file must look like this:
#
# 1	-62805
# 2	-62468
# 3	-62351
# 4	-62408
# 5	-62256
# 6	-62473
# 7	-62759
# 8	-62768
# 

package require Tcl 8.4
package require textutil
package require math::statistics

namespace import ::textutil::*
namespace import ::math::statistics::*

set filename "data.dat"
puts "Reading file $filename"

if [catch {open $filename RDONLY} f] {
	puts $f 
} else {
	while {1} {
		gets $f line
		if [eof $f] break
		set vdata  [ splitx $line "\t"]
		lappend x [ lindex $vdata 0]
		lappend y [ lindex $vdata 1]
	}
  close $f
}

puts "Lines read:"
puts [llength $x] 
puts "Calculating statistics"

# Uncomment here to print the columns to screen.
# foreach does a good job, here.
#puts "\nx-column:"
#foreach dx $x { puts $dx }
#puts "\ny-column:"
#foreach dy $y { puts $dy }

set meany [mean $y]
set vary [var $y]
set stdevy [stdev $y]

puts "Mean y: $meany, Var x: $vary, StDev x: $stdevy"

newLISP code to fetch flickr interesting photos and display on screen via TK

// simple newLISP code to fetch interesting pictures from
// flickr and display on the monitor using TK

(set 'api "/services/rest")
(set 'apikey "YOUR-OWN-KEY-HERE")
(set 'host "http://flickr.com")
(set 'email "")
(set 'password "")

(define (doget method auth params)
  (setq url (append host api "/?api_key=" apikey "&method=" method))
  (if (list? params) 
   (setq url (append url "&" (urlencode params))))
  (if (not (nil? auth)) 
   (setq url (append url "&email=" email "&password=" password)))
  (setq xmldata (get-url url)))


(define (urlencode params)
  (setq urlstring "")
  (dolist (param1 params) 
   (if (not (= urlstring "")) 
    (setq urlstring (append urlstring "&"))) 
   (setq urlstring (append urlstring (nth 0 param1) "=" (nth 1 param1)))))

(define (xmlconvert data)
  (xml-type-tags nil nil nil nil)
  (setq sxmldata (xml-parse data (+ 1 2 4 8 16))))
  
(define (getphotos data)
  (if (ref 'photo sxmldata) 
   (setq photolist (slice (data (chop (ref 'photo data) 2)) 2 -1)) 
   (setq photolist '())))

(define (handlephotos sxmldata)
  (dolist (aphoto (getphotos sxmldata)) 
   (setq pr (first (rest aphoto))) 
   (print (format "http://static.flickr.com/%s/%s_%s_o.jpg" (lookup 
      'server pr) 
     (lookup 'id pr) 
     (lookup 'secret pr)))))

(define (fiv)
  (tk "package require Img")
  (tk "destroy .fivwin")
  (tk "toplevel  .fivwin")
  
  (tk "wm geometry .fivwin [winfo screenwidth .]x[winfo screenheight .]+0+0")
  
  ;; uncomment the following lines to make display "fullscreen"
  ;;(tk "bind .fivwin <Key> {destroy .fivwin}")
  ;;(tk "bind .fivwin <Motion> {destroy .fivwin}")
  ;;(tk "bind .fivwin <Button> {destroy .fivwin}")
  ;;(tk "wm overrideredirect .fivwin yes; focus -force .fivwin")

  (setq picture (tk "image create photo "))
  (tk (append "label .fivwin.picture  -image " picture))
  (tk "pack .fivwin.picture")

  (setq xmldata
            (doget "flickr.interestingness.getList" nil  
             '(("per_page" "100")("page" "1"))))		;; how many per page , from which page
  (setq sxmldata (xmlconvert xmldata))
  
  (if (ref 'photo sxmldata) 
   (setq photolist (slice (sxmldata (chop (ref 'photo sxmldata) 2)) 2 -1)) 
   (exit))
   
  (dolist (aphoto photolist)
  	(if (= "0" (tk "winfo exists .fivwin"))
  		(exit))
    (setq photodesc (first (rest aphoto)))
    (setq photourl (format "http://static.flickr.com/%s/%s_%s_o.jpg" 
                            (lookup 'server photodesc)
                            (lookup 'id photodesc)
                            (lookup 'secret photodesc)))
    (tk "update idletasks")

    (setq file (last (parse photourl "/")))
    (write-file file (get-url photourl))
    (tk (append picture " configure -file " file))
     (delete-file file)))
 

Hello World Tcl

Mostly just playing with this site which seems pretty cool.

#!/bin/sh

# Next line restarts using tclsh \
exec tclsh "$0" "$@"

puts "Hello World."
exit
« Newer Snippets
Older Snippets »
Showing 1-8 of 8 total  RSS