Prev: How to load large images in memory ?
Next: http question
From: Ruchir on 29 Jul 2010 08:19

> can someone please help with this?



#!/usr/bin/tclsh

set ilist {
{0 1 2}
{0 1 3}
{0 2 1}
{1 1 2}
{1 2 3}
}

# assume size of each row to be same
set num_col [llength [lindex $ilist 0]]
set i 0
set nlist {}
foreach r $ilist {
puts "$i -> $r"
set j 0
foreach c $r {
if {$i == 0} {
lappend nlist [list $c]
} else {
set l [lindex $nlist $j]
lappend l $c
lset nlist $j $l
}
incr j
}
incr i
}
puts "\ntransposed list --->"
set i 0
foreach ele $nlist {
puts "$i -> $ele"
incr i
}

From: tomk on 29 Jul 2010 11:52
On Jul 28, 10:52 pm, ashneerson <ashneer...(a)gmail.com> wrote:
> hi, have a puzzle with rotating a list like below
>
> {{ht a3 pr2} {ht a2 pr1} {lt a1 pr2} {lt a3 pr4} {ht a2 pr2}}
>
> into a list like this one:
>
> {{ht ht ht lt lt}  {a2 a2 a1 a3}  {pr1 pr2 pr2 pr2 pr4}}
>
> so that to rotate the columns to rows and retain original
> correspondence between the list elements.
>
> can someone please help me figure out the trick?
> -a.

For the case given you could do the following (assuming the first list
is in a variable named alist).

foreach a b c d e {*}${alist} {
lappend result [list $a $b $c $d $e]
}

The result isn't exactly the same result suggested because it appears
the elements is the suggested result appear to have been sorted while
my example is a rotation.

tomk
From: hae on 29 Jul 2010 14:54
On 29 Jul., 12:56, Uwe Klein <uwe_klein_habertw...(a)t-online.de> wrote:
> hae wrote:
> > here a version of prettyprintlist that works.
>
> so where is your improvement ( except partly
> fixing the issues some(your?) MUA inserted )?
>
> uwe

Your version had a trailing \ with some puts that did not work for me.
For example
Compare 'puts -nonewline \t\{\'
with 'puts -nonewline \t\{'

That is the change.

Rüdiger
From: Uwe Klein on 29 Jul 2010 15:06
hae wrote:
> Your version had a trailing \ with some puts that did not work for me.
> For example
> Compare 'puts -nonewline \t\{\'
> with 'puts -nonewline \t\{'
>
> That is the change.
>
> R�diger

what I posted was 'puts -nonewline \t\{\<space>'
"\t\{ " would have been equivalent for the payload

Not quite sure who had the <space> for dinner.

uwe
From: mark anthony on 30 Jul 2010 16:17
i wanted to see how my matrix lib performs in comparison to your
suggestions... anyway let me share my timings. either i'm to stupid
to use struct::matrix or its awfully slow for this operation (or since
struct::matrix does it in place, we actually flip the same matrix so
this could be the cause but shouldn't).

anyway, your suggestions used only half the time of struct::matrix.
also i wonder why my code is so much faster....


timing results:
tomk 2078.416 microseconds per iteration
ruchir 2002.312 microseconds per iteration
uwe 1921.835 microseconds per iteration
kob 1043.529 microseconds per iteration
::struct::matrix 4082.555 microseconds per iteration

for your convenience find the script used for testing bellow

cheers,
mark

p.s. feedback is appreciated

--- code follows ---
#!/usr/bin/tclsh
::puts "transpose \nUsage:"
::puts "transpose ?--time?"

::set mi 20
::set mj 50

::package require struct::matrix

::set clist {
{0 1 2 }
{0 1 3 }
{0 2 1 }
{1 1 2 }
{1 2 3 }
}

::struct::matrix mycmatrix
mycmatrix deserialize [::list 5 3 $clist]

## prepare the test data
::puts "init"
::proc getnum {} {
::return [::expr {100000*rand()}]
}

::struct::matrix mymatrix
::set mymatrixlist [::list]
::for {::set i 0 } {$i < $mi } {::incr i } {
::set row [::list]
::for {::set j 0 } {$j < $mj } {::incr j } {
::lappend row [getnum]
}
::lappend mymatrixlist $row
}
mymatrix deserialize [::list $mi $mj $mymatrixlist]
## procs

## tcllib
proc transpose { } {
mymatrix transpose
}
::proc tomk { alist } {
set i 0
foreach a ${alist} {
lappend args a${i} ${a}
incr i
}

set res ""
foreach {a b} ${args} {
append res " \$${a}"
}

foreach {*}${args} {
lappend result [eval list $res]
}

return $result

}
::proc ttranspose {} {
tomk $::mymatrixlist
}

## ashneerson
::proc rotate_list { list } {
::set W [::llength $list]
::set H [::llength [::lindex $list 0]]

::set w $H
::set h $W

::set lst [::list ]

::for {::set i 0 } {$i < $h} {incr i} {
::set case [::list ]

::for {::set j 0} {$j < $w} {incr j} {
::lappend case [::lindex $list [::expr {($w-$j
-1)}] $i]
}
::lappend lst $case
}
::return $lst
}
::proc arotate { } {
::rotate_list $::mymatrixlist
}
## uwe
::proc listrot list {
::set columns {}
::set col 0
::foreach line $list {
::if {!$col} {
::foreach item $line {
::lappend columns c::$col
::incr col
}
}
::set col 0
::foreach item $line {
::lappend c(c::$col) $item
::incr col
}
}
::foreach tok $columns {
::lappend ret $c($tok)
}
::return $ret
}
::proc utranspose {} {
listrot $::mymatrixlist
}


## kob
## taken from my matrix namespace
::proc dim { A } {
::set i [::llength $A ]
::set j [::llength [::lindex $A 0] ]
::return [::list $i $j ]
}
::proc Mat { dai x daj } {
::for {::set i 0} {$i<$daj } {::incr i} {
::lappend list 0
}
::for {::set i 0} {$i<$dai} {::incr i} {
::lappend C $list
}
::return $C
}
::proc T { A } {
::foreach [::list dai daj ] [dim $A] ::break
::set B [Mat $daj x $dai]
::set i 0
::foreach a $A {
::set j 0
::foreach aij $a {
::lset B $j $i $aij
::incr j
}
::incr i
}
::return $B
}

##
::proc ktranspose { } {
T $::mymatrixlist
}
## ruchir
::proc ruchir { A } {
::set i 0
::set nlist [::list ]
::foreach r $A {
::set j 0
::foreach c $r {
::if {$i == 0 } {
::lappend nlist [::list $c]
} else {
::set l [::lindex $nlist $j]
::lappend l $c
::lset nlist $j $l
}
::incr j
}
::incr i
}
::return $nlist
}
::proc rtranspose {} {
ruchir $::mymatrixlist
}

::if {[::lsearch $argv --time]>=0} {
## cache
::puts "prepare bytecode"
rtranspose
utranspose
ktranspose
ttranspose
transpose

## time
::puts "timing results:"
::puts -nonewline "tomk "
::puts [::time {
ttranspose
} 1000]


::puts -nonewline "ruchir "
::puts [::time {
rtranspose
} 1000]

::puts -nonewline "uwe "
::puts [::time {
utranspose
} 1000]
::puts -nonewline "kob "
::puts [::time {
ktranspose
} 1000]
::puts -nonewline "::struct::matrix "
::puts [::time {
transpose
} 1000]
}
::puts "correctness"
::puts -nonewline "solution: "
::puts [::list {0 0 0 1 1} {1 1 2 1 2} {2 3 1 2 3} ]
::puts -nonewline "tomk "
::puts [tomk $clist]
::puts -nonewline "ruchir "
::puts [ruchir $clist]
::puts -nonewline "uwe "
::puts [listrot $clist]
::puts -nonewline "kob "
::puts [T $clist]
::puts -nonewline "struct::matrix "
mycmatrix transpose
::puts [::lindex [mycmatrix serialize ] 2]

First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4
Prev: How to load large images in memory ?
Next: http question