| removeNode tree |

removeNode := [:root :elem |
    | node branch left middle right target neighbor merged keys
     bIndex eIndex path branchOf keysOf fixKeysOf |

    root first == #L
        ifTrue: [
            eIndex := root indexOf: elem.
            eIndex = 0 ifTrue: [^nil] ifFalse: [root := root copyWithoutIndex: eIndex]]
        ifFalse: [
            path := OrderedCollection new.
            node := root.
            keysOf := [:val | val first == #L ifTrue: [nil] ifFalse: [val second]].
            branchOf := [:val | val first == #L ifTrue: [val] ifFalse: [val third]].
            fixKeysOf := [:nde |
                (keysOf value: nde) ifNotNilDo: [:kys |
                    kys become: {#K}, (((branchOf value: nde) allButFirst: 2) collect: [:br |
                        [br first == #L] whileFalse: [br := (branchOf value: br) second].
                        br second])]].
            [   keys := keysOf value: node.
                keys ifNil: [target := node] ifNotNil: [
                    branch := branchOf value: node.
                    bIndex := keys findLast: [:key | (key isSymbol ifTrue: [0] ifFalse: [key]) <= elem].
                    bIndex = 0 ifTrue: [^nil].
                    target := branch at: bIndex + 1].
                target first = #L] whileFalse: [path add: node. node := target].

            eIndex := target indexOf: elem ifAbsent: [^nil].
            target become: (target copyWithoutIndex: eIndex).
            (bIndex > 2 and: [eIndex = 2]) ifTrue: [keys at: bIndex put: target second].

            [   left := branch second.
                middle := branch size > 2 ifTrue: [branch third] ifFalse: [nil].
                right := branch size = 4 ifTrue: [branch fourth] ifFalse: [nil].

                (branchOf value: target) size = 2 ifTrue: [
                    neighbor := target caseOf: {[left]->[middle]. [middle]->[left]. [right]->[middle]}.
                    merged := target == left
                        ifTrue: [(branchOf value: target), (branchOf value: neighbor) allButFirst]
                        ifFalse: [(branchOf value: neighbor), (branchOf value: target) allButFirst].
                    (branchOf value: neighbor) size = 3
                        ifTrue: [
                            (branchOf value: neighbor) become: merged.
                            branch become: (branch copyWithout: target)]
                        ifFalse: [
                            target == left ifTrue: [target := neighbor flag: (neighbor := target)].
                            (branchOf value: target) become: ({target first}, (merged allButFirst: 3)).
                            fixKeysOf value: target.
                            (branchOf value: neighbor) become: (merged allButLast: 2)].
                        fixKeysOf value: neighbor].
                fixKeysOf value: node.
                branch size = 2 ifFalse: [false] ifTrue: [
                    path ifEmpty: [node become: branch last. false] ifNotEmpty: [
                        target := node.
                        node := path removeLast.
                        branch := node third.
                        true]]
            ] whileTrue].
    root].

World findATranscript: nil.
tree := #(N (K 28 55)
   (B (N (K 10 19)
         (B (N (K 4 7)
               (B (L  1  2  3) (L  4  5  6) (L  7  8  9)))
            (N (K 13 16)
               (B (L 10 11 12) (L 13 14 15) (L 16 17 18)))
            (N (K 22 25)
               (B (L 19 20 21) (L 22 23 24) (L 25 26 27)))))
      (N (K 37 46)
         (B (N (K 31 34)
               (B (L 28 29 30) (L 31 32 33) (L 34 35 36)))
            (N (K 40 43)
               (B (L 37 38 39) (L 40 41 42) (L 43 44 45)))
            (N (K 49 52)
               (B (L 46 47 48) (L 49 50 51) (L 52 53 54)))))
      (N (K 64 73)
         (B (N (K 58 61)
               (B (L 55 56 57) (L 58 59 60) (L 61 62 63)))
            (N (K 67 70)
               (B (L 64 65 66) (L 67 68 69) (L 70 71 72)))
            (N (K 76 79)
               (B (L 73 74 75) (L 76 77 78) (L 79 80 81))))))).

(1 to: 81) asArray shuffled do: [:each |
    tree := removeNode value: tree value: each.
    Transcript cr; show: each asString, ', ', (tree printString copyWithout: $#)]