implement insRight function in search-list.sml

This commit is contained in:
2024-11-12 03:05:14 +00:00
parent 287dc5548d
commit 8bf0b64ef3
3 changed files with 91 additions and 63 deletions

View File

@@ -15,23 +15,59 @@ struct
fun joinEndOfLeft (new, left) = fun joinEndOfLeft (new, left) =
case left of case left of
hd :: tail => hd :: tail =>
if isLessThanTarget (new, hd) then (hd ^ new) :: tail else new :: left if isLessThanTarget (new, hd) then
let val newHd = Vector.concat [hd, new]
in newHd :: tail
end
else
new :: left
| [] => new :: left | [] => new :: left
fun joinStartOfRight (new, right) = fun joinStartOfRight (new, right) =
case right of case right of
hd :: tail => hd :: tail =>
if isLessThanTarget (new, hd) then (new ^ hd) :: tail else new :: right if isLessThanTarget (new, hd) then
let val newHd = Vector.concat [new, hd]
in newHd :: tail
end
else
new :: right
| [] => new :: right | [] => new :: right
fun preferInsertLeft (new, left, right) = fun insMiddle (new, hd, tl, left, right) =
case left of let
hd :: tail => val middle = BinSearch.equalOrMore (new, hd)
if isLessThanTarget (hd, new) then val leftSlice = VectorSlice.slice (hd, 0, SOME middle)
{left = (hd ^ new) :: tail, right = right} val rightLength = Vector.length hd - middle
else val rightSlice = VectorSlice.slice (hd, middle, SOME rightLength)
{left = left, right = joinStartOfRight (new, right)}
| [] => {left = left, right = joinStartOfRight (new, right)} val new = Vector.fromList [new]
val new = VectorSlice.full new
in
if Vector.length hd < targetLength then
let val newHd = VectorSlice.concat [leftSlice, new, rightSlice]
in {left = joinEndOfLeft (newHd, tl), right = right}
end
else if middle < targetLength then
(* leftSlice is less than targetLength *)
let
val hd1 = VectorSlice.concat [leftSlice, new]
val hd2 = VectorSlice.vector rightSlice
in
{ left = joinEndOfLeft (hd1, tl)
, right = joinStartOfRight (hd2, right)
}
end
else
let
val hd1 = VectorSlice.vector leftSlice
val hd2 = VectorSlice.concat [new, rightSlice]
in
{ left = joinEndOfLeft (hd1, tl)
, right = joinStartOfRight (hd2, right)
}
end
end
fun insLeft (new, left, right) = fun insLeft (new, left, right) =
case left of case left of
@@ -39,67 +75,58 @@ struct
let let
val first = Vector.sub (hd, 0) val first = Vector.sub (hd, 0)
in in
if first > new then if new < first then
insLeft (new, tl, joinStartOfRight (hd, right)) insLeft (new, tl, joinStartOfRight (hd, right))
else if first < new then else if new > first then
let let
val last = Vector.sub (hd, Vector.length hd - 1) val last = Vector.sub (hd, Vector.length hd - 1)
in in
if last > new then if new < last then
(* have to insert in middle *) (* have to insert in middle *)
let insMiddle (new, hd, tl, left, right)
val middle = BinSearch.equalOrMore (new, hd) else if new > last then
val leftSlice = VectorSlice.slice (hd, 0, SOME middle) (* have to insert new at end of left
val rightLength = Vector.length hd - middle * or start of right (both are equivalent) *)
val rightSlice = { left = left
VectorSlice.slice (hd, middle, SOME rightLength) , right = joinStartOfRight (Vector.fromList [new], right)
}
val new = Vector.fromList [new]
val new = VectorSlice.full new
in
if Vector.length hd < targetLength then
let
val newHd =
VectorSlice.concat [leftSlice, new, rightSlice]
in
{left = joinEndOfLeft (newHd, tl), right = right}
end
else if middle < targetLength then
(* leftSlice is less than targetLength *)
let
val hd1 = VectorSlice.concat [leftSlice, new]
val hd2 = VectorSlice.vector rightSlice
in
{ left = joinEndOfLeft (hd1, tl)
, right = joinStartOfRight (hd2, right)
}
end
else
let
val hd1 = VectorSlice.vector leftSlice
val hd2 = VectorSlice.concat [new, rightSlice]
in
{ left = joinEndOfLeft (hd1, tl)
, right = joinStartOfRight (hd2, right)
}
end
end
else if last < new then
(* have to insert new at end *)
if Vector.length hd < targetLength then
let val newHd = Vector.concat [hd, Vector.fromList [new]]
in {left = joinEndOfLeft (newHd, tl), right = right}
end
else
{ left = left
, right = joinStartOfRight (Vector.fromList [hd], right)
}
else else
(* last = new so just return *) (* new = last so just return *)
{left = left, right = right} {left = left, right = right}
end end
else else
(* first = new *) (* new = first *)
{left = left, right = right}
end
| [] => {left = left, right = right}
fun insRight (new, left, right) =
case right of
hd :: tl =>
let
val last = Vector.sub (hd, Vector.length hd - 1)
in
if new > last then
insRight (new, joinEndOfLeft (hd, left), tl)
else if new < last then
let
val first = Vector.sub (hd, 0)
in
if new > first then
(* have to insert in middle *)
insMiddle (new, hd, tl, left, right)
else if new < first then
(* have to insert new at start of right
* or end of left (both are equivalent) *)
{ left = left
, right = joinStartOfRight (Vector.fromList [new], right)
}
else
(* new = first so just return *)
{left = left, right = right}
end
else
(* new = last *)
{left = left, right = right} {left = left, right = right}
end end
| [] => {left = left, right = right} | [] => {left = left, right = right}

BIN
shf

Binary file not shown.

View File

@@ -5,7 +5,6 @@ lib/brolib-sml/src/line_gap.sml
lib/cozette-sml/fonts/cozette-ascii.mlb lib/cozette-sml/fonts/cozette-ascii.mlb
(* FUNCTIONAL CORE *) (* FUNCTIONAL CORE *)
fcore/bin-search.sml
message-types/input-msg.sml message-types/input-msg.sml
message-types/draw-msg.sml message-types/draw-msg.sml
message-types/mailbox-type.sml message-types/mailbox-type.sml
@@ -13,6 +12,8 @@ message-types/mailbox-type.sml
fcore/app-type.sml fcore/app-type.sml
fcore/app-with.sml fcore/app-with.sml
fcore/bin-search.sml
fcore/search-list.sml
fcore/text-constants.sml fcore/text-constants.sml
ann ann
"allowVectorExps true" "allowVectorExps true"