proc almostIncreasingSequence {sequence} {
    set list1 [lindex $sequence 0]
    set list2 [lindex $sequence 0]
    for {set i 1} {$i < [llength $sequence]} {incr i} {
        if {[lindex $sequence $i] <= [lindex $list1 end]} {
            set list1 [lreplace $list1 end end]
        }
        lappend list1 [lindex $sequence $i]

        if {[lindex $sequence $i] > [lindex $list2 end]} {
            lappend list2 [lindex $sequence $i]
        }
        puts [lindex $sequence $i]
    }
    set correct1 [expr [llength $list1] >= [expr [llength $sequence] -1 ]]
    set correct2 [expr [llength $list2] >= [expr [llength $sequence] -1 ]]
    puts "[llength $list1] >= [expr [llength $sequence]-1 ]"
    puts "[llength $list2] >= [expr [llength $sequence]-1 ]"
    return [expr $correct1 || $correct2 ]
}