DZone Snippets: tcl code

change

dleony (dleony) — Fri, 18 Jul 2008 17:21:15 GMT

// description of your code here

change this:



        db_dml revision_add {

            insert into mfp_notesi (item_id, revision_id, title)

            values (:item_id, :revision_id, :title)

        }

for this:



        db_exec_plsql revision_add {

            select content_revision__new(:title, null, null, null, null, :title, :item_id, :revision_id, null, null, null)

        }



        db_dml insert_note {

            insert into mfp_notes (note_id) values (:revision_id)

        }

Scripted Atom-Highlight in VMD

stayefeh (Sascha Tayefeh) — Fri, 19 Jan 2007 22:13:16 GMT

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

stayefeh (Sascha Tayefeh) — Wed, 17 Jan 2007 20:38:25 GMT

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:   

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

stayefeh (Sascha Tayefeh) — Wed, 17 Jan 2007 20:36:50 GMT

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

stayefeh (Sascha Tayefeh) — Wed, 17 Jan 2007 20:33:02 GMT

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)

stayefeh (Sascha Tayefeh) — Wed, 17 Jan 2007 20:31:06 GMT

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

stayefeh (Sascha Tayefeh) — Wed, 17 Jan 2007 20:29:36 GMT

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

frontera000 (bob bae) — Fri, 08 Sep 2006 01:42:47 GMT

// 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  {destroy .fivwin}")

  ;;(tk "bind .fivwin  {destroy .fivwin}")

  ;;(tk "bind .fivwin

Hello World Tcl

danostuporstar (Dano Stuporstar) — Thu, 16 Jun 2005 01:34:51 GMT

Mostly just playing with this site which seems pretty cool.



#!/bin/sh



# Next line restarts using tclsh \

exec tclsh "$0" "$@"



puts "Hello World."

exit