Tk Library Source Code

Artifact 74c5b69fe29b9b01afdbd6a3c022176f385360acc0e74941a407f292ddaf231c:

Attachment "plotviolin.tcl" to ticket [136008e68b] added by arjenmarkus 2023-03-19 10:11:17.

---

# plotviolin.tcl --
#     Prototype for violin plots
#

set scaleX   200.0
set offsetX -100.0
set scaleY   200.0
set offsetY  700.0

# violinPlot --
#     Plot a violin shape based on the distribution of the y data
#
# Arguments:
#     x      X-coordinate
#     ydata  List of  data
#
proc violinPlot {widget x ydata} {

    global scaleX scaleY offsetX offsetY

    #
    # There is nothing we can do ...
    #
    if { [llength $ydata] == 0 } {
        return
    }

    set maxExtent      25
    set extraRange     0.05
    set numberClasses 10

    #
    # Determine the extremes - increase the range by a small margin
    #
    set miny [lindex $ydata 0]
    set maxy [lindex $ydata 0]

    foreach value $ydata {
        if { $miny > $value } {
            set miny $value
        }
        if { $maxy < $value } {
            set maxy $value
        }
    }
    set range [expr {$maxy - $miny}]

    if { $range == 0.0 } {
        set x    [expr {$scaleX * $x + $offsetX}]
        set miny [expr {$offsetY - $scaleY * $miny}]
        $widget create oval [expr {$x-$maxExtent}] [expr {$miny=$maxExtent}] [expr {$x+$maxExtent}] [expr {$miny+$maxExtent}]

        return
    } else {
        set miny [expr {$miny - $extraRange * $range}]
        set maxy [expr {$maxy + $extraRange * $range}]
    }

    set dy [expr {($maxy - $miny) / $numberClasses}]

    #
    # Determine the distribution
    #
    set classCount [lrepeat $numberClasses [expr {0}]]

    foreach value $ydata {
        set class [expr {int( ($value-$miny) / $dy)}]
        lset classCount $class [expr {[lindex $classCount $class] + 1}]
    }

    set xcoordB [list 0]
    set ycoordB [list 0]
    set xcoordE [list]
    set ycoordE [list]

    set yi       0
    set maxCount 0
    foreach class $classCount {
        if { $maxCount < $class } {
            set maxCount $class
        }

        incr yi
        lappend xcoordB $class
        lappend ycoordB $yi

        set xcoordE [concat [expr {-$class}] $xcoordE]
        set ycoordE [concat $yi              $ycoordE]
    }

    set xcoordB [concat $xcoordB 0              $xcoordE 0]
    set ycoordB [concat $ycoordB $numberClasses $ycoordE 0]

    set scaleV [expr {$maxExtent / double($maxCount)}]

    console show

#    foreach {x y} $xyCoords {
#        puts "$x -- $y"
#    }

    set xyCoords [list]
    foreach xc $xcoordB yc $ycoordB {
        lappend xyCoords [expr {$scaleX * $x - $offsetX + $scaleV * $xc + 2}] \
                         [expr {$offsetY - $scaleY * ($miny + $yc * $dy)}]

        puts "$xc -- $yc"
    }

    $widget create polygon $xyCoords -smooth 1 -fill red -outline black

    foreach {x y} $xyCoords {
        puts "$x -- $y"
    }
}

pack [canvas .c -width 400 -height 800]

set data {1 1 3}

violinPlot .c 1 $data

violinPlot .c 0.5 {0.5 0.54 1.0 1.1 1.0 2.0 2.0 2.0 2.0 3.0}