networktestinggenius.tk

Factorial
proc Factorial {x} {
set i 1; set product 1
while {$i <= $x} {
set product [expr $product * $i]
incr i
}
return $product
}

​

Reverse string
proc string'reverse str {
   set res {}
   set i [string length $str]
   while {$i > 0} {append res [string index $str [incr i -1]]}
   set res
} 

How do you check whether a string is palindrome or not using TCL script
proc palindrome {str} {
set l [string length $str]
set i 0
incr l -1
set flag 0
while {$l>=0} {
set s [string index $str $i]
set e [string index $str $l]
if {$s==$e} {  } else {
set flag 1
break }
incr l -1
incr i 1
}
if {$flag ==0} { puts “The given string $str is palindrome” } else {
puts “The given string $str is not palindrome” }
}
palindrome “malayalam”
palindrome “welcome”

TCL Program – count letters in the given string using tcl
set str “LIHAKHDBLICIHJAADFDCSDBBBDFDB”
set l [string length $str]
puts $l
set cnt_A 0
set cnt_B 0
set cnt_C 0
set i 0
while {$i<=$l} {
if {“A”==[string index $str $i]} {
incr cnt_A   } elseif {“B”==[string index $str $i]} {
incr cnt_B   } elseif {“C”==[string index $str $i]} {
incr cnt_C   }
incr i
}
puts “The count of A is $cnt_A \n
The count of B is $cnt_B \n
The count of C is $cnt_C”

​

TCL Program- Factorial value with and without using recursion in tcl
proc fact { n } {
set f 1
while {$n>=2} {
set f [expr {$f*$n}]
incr n -1
}
return $f
}
proc recfact n {
if {$n<=1} {
return 1  }
expr $n * [recfact [expr {$n-1}]]
}
puts “The factorial value without recursion [fact 4]”
puts “The factorial value with recursion [recfact 4]”

TCL Program – Find maximum number in the given 3 numbers using tcl
set a 10
set b 20
set c 15
if {$a>$b && $a>$c} {
puts “a is bigger and value is $a” } elseif {$b>$a && $b>$c} {
puts “b is bigger and value is $b” } else {
puts “c is bigger and value is $c” }

Check given number is odd or even in tcl
proc oddeven {n} {
if {$n%2==0} {
puts “the given $n is even” } else {
puts “the given number $n is odd” }
}

TCL Program – remove duplicates in the given list using tcl
set list1 “venkat gopi prashanth mahantesh krishna nagendra venkat krishna”
set l [llength $list1]
set i 0
set result “”
foreach j $list1 {
set arr($i) $j
incr i
}
for {set k 0} {$k<$l} {incr k} {
set n 0
for {set j [expr $k+1]} {$j<$l} {incr j} {
if {$arr($k)==$arr($j)} {
incr n }
}
if {$n==0} {
lappend result $arr($k)
}
}

TCL Program – Remove the list2 elements in list1 using tcl
set list1 ” venkat praveen gopi syed ravi robert  ”
set list2 “gopi ravi ”
foreach i $list2 {
set index 0
foreach j $list1 {
if { $i==$j } {
set list1 [lreplace $list1 $index $index]
}
incr index 1
}
}
puts $list1

TCL Program – Average of given numbers using args using tcl
proc avg {args} {
set s 0
set count 0
foreach i $args {
incr count
set s [expr {$s+$i}]  }
set avg [expr {$s/$count}]
puts “count is $count and sum is $s and avg is $avg”
return $avg }
puts [avg 23 34 12 67 45]
#reverse a string in tcl
set a 12345
set b [string length $a]
puts $b
for {set i $b} {$i >= 0} {incr i -1} {
puts -nonewline [string index $a [expr $i -1]]
}

​

Another method:
set string "nawrajlekhak"
set rev [string reverse $string]
puts $rev

#reverse a list in tcl
set list "5 7 66 2 1"
set len [llength $list]
#puts $len
for {set i $len} {$i > 0} {incr i -1} {
set b [lindex $list [expr $i - 1]]
puts -nonewline "$b "
}

​

#Remove duplicate entries from the list
set list "1 2 3 4 5 6 7 8 11 17 33 3 4 8"
set b [lsort -unique $list]
puts $b

#Find the number of elements in the list without using llength
set list "1 2 3 4 5 6 7 8 11 17 33 3 4 8"
set i 0
foreach ele $list {
set b "$ele = $i"
incr i
}
puts $i

​

#Print all elements in the list using flow controls
set list "1 2 3 4 5 6 7 8 11 17 33 3 4 8"
set len [llength $list]
puts $len
for {set i 0} {$i < $len} {incr i} {
puts -nonewline "[lindex $list $i] "
}

​

#Create array and print all elements in array
array set arrayvar {1 one 2 two 3 three}
puts [parray arrayvar]
puts [array names arrayvar]
puts [array size arrayvar]
puts [array get arrayvar]
puts [array exists arrayvar]

#Reverse a string
set string "nawrajlekhak"
set rev [string reverse $string]
puts $rev

​

#Write a program to find given string is palindrome or not
set a madam
set len [string length $a]
set n [expr ($len-1)/2]
for {set i 0} {$i < $n} {incr i} {
set b [string index $a $i]
set c [expr $len - 1 - $i]
set d [string index $a $c]
if {$b != $d} {
puts "not palindrome"
exit
}
}
puts "palindrome"

​

#Sorting

set l { 1 2 4 3 5 7 9 8}

    set len [llength $l]

    set swapped true

    while {$swapped} {

        set swapped false

        for {set i 0} {$i < $len - 1} {incr i} {

            set j [expr {$i + 1}]

            if {[lindex $l $i] > [lindex $l $j]} {

                set t [lindex $l $i]

      lset l $i [lindex $l $j]

      lset l $j $t         

          

}

        }

        incr len -1

    }

puts $l