Order by pair comparisons: Difference between revisions

m
m (→‎{{header|Wren}}: Minor tidy)
 
(14 intermediate revisions by 13 users not shown)
Line 28:
* A routine that does not ask the user "too many" comparison questions should be used.
<br><br>
 
=={{header|11l}}==
{{trans|Python: Sort with custom comparator}}
 
<syntaxhighlight lang="11l">F user_cmp(String a, b)
R Int(input(‘IS #6 <, ==, or > #6 answer -1, 0 or 1:’.format(a, b)))
 
V items = ‘violet red green indigo blue yellow orange’.split(‘ ’)
V ans = sorted(items, key' cmp_to_key(user_cmp))
print("\n"ans.join(‘ ’))</syntaxhighlight>
 
{{out}}
<pre>
IS red <, ==, or > violet answer -1, 0 or 1:-1
IS green <, ==, or > red answer -1, 0 or 1:1
IS green <, ==, or > violet answer -1, 0 or 1:-1
IS green <, ==, or > red answer -1, 0 or 1:1
IS indigo <, ==, or > red answer -1, 0 or 1:1
IS indigo <, ==, or > violet answer -1, 0 or 1:-1
IS indigo <, ==, or > green answer -1, 0 or 1:1
IS blue <, ==, or > red answer -1, 0 or 1:1
IS blue <, ==, or > violet answer -1, 0 or 1:-1
IS blue <, ==, or > indigo answer -1, 0 or 1:-1
IS blue <, ==, or > green answer -1, 0 or 1:1
IS yellow <, ==, or > red answer -1, 0 or 1:1
IS yellow <, ==, or > violet answer -1, 0 or 1:-1
IS yellow <, ==, or > indigo answer -1, 0 or 1:-1
IS yellow <, ==, or > blue answer -1, 0 or 1:-1
IS yellow <, ==, or > green answer -1, 0 or 1:-1
IS yellow <, ==, or > red answer -1, 0 or 1:1
IS orange <, ==, or > red answer -1, 0 or 1:1
IS orange <, ==, or > violet answer -1, 0 or 1:-1
IS orange <, ==, or > indigo answer -1, 0 or 1:-1
IS orange <, ==, or > blue answer -1, 0 or 1:-1
IS orange <, ==, or > green answer -1, 0 or 1:-1
IS orange <, ==, or > yellow answer -1, 0 or 1:-1
IS orange <, ==, or > red answer -1, 0 or 1:1
 
red orange yellow green blue indigo violet
</pre>
 
=={{header|Action!}}==
<syntaxhighlight lang="action!">DEFINE PTR="CARD"
 
PROC PrintArray(PTR ARRAY a BYTE size)
BYTE i
 
Put('[)
FOR i=0 TO size-1
DO
IF i>0 THEN Put(' ) FI
Print(a(i))
OD
Put(']) PutE()
RETURN
 
BYTE FUNC IsBefore(CHAR ARRAY a,b)
DEFINE NO_KEY="255"
DEFINE KEY_Y="43"
DEFINE KEY_N="35"
BYTE CH=$02FC ;Internal hardware value for last key pressed
BYTE k
 
PrintF("Is %S before %S (y/n)? ",a,b)
CH=NO_KEY ;Flush the keyboard
DO
k=CH
UNTIL k=KEY_Y OR k=KEY_N
OD
CH=NO_KEY ;Flush the keyboard
IF k=KEY_Y THEN
PrintE("yes")
RETURN (1)
FI
PrintE("no")
RETURN (0)
 
PROC InteractiveInsertionSort(PTR ARRAY a BYTE size)
INT i,j
PTR value
 
FOR i=1 TO size-1
DO
value=a(i)
j=i-1
WHILE j>=0 AND IsBefore(value,a(j))=1
DO
a(j+1)=a(j)
j==-1
OD
a(j+1)=value
OD
RETURN
 
PROC Main()
DEFINE COUNT="7"
PTR ARRAY arr(COUNT)
 
arr(0)="violet" arr(1)="red"
arr(2)="green" arr(3)="indigo"
arr(4)="blue" arr(5)="yellow"
arr(6)="orange"
 
Print("Shuffled array: ")
PrintArray(arr,COUNT) PutE()
 
InteractiveInsertionSort(arr,COUNT)
PutE() Print("Sorted array: ")
PrintArray(arr,COUNT)
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Order_by_pair_comparisons.png Screenshot from Atari 8-bit computer]
<pre>
Shuffled array: [violet red green indigo blue yellow orange]
 
Is red before violet (y/n)? yes
Is green before violet (y/n)? yes
Is green before red (y/n)? no
Is indigo before violet (y/n)? yes
Is indigo before green (y/n)? no
Is blue before violet (y/n)? yes
Is blue before indigo (y/n)? yes
Is blue before green (y/n)? no
Is yellow before violet (y/n)? yes
Is yellow before indigo (y/n)? yes
Is yellow before blue (y/n)? yes
Is yellow before green (y/n)? yes
Is yellow before red (y/n)? no
Is orange before violet (y/n)? yes
Is orange before indigo (y/n)? yes
Is orange before blue (y/n)? yes
Is orange before green (y/n)? yes
Is orange before yellow (y/n)? yes
Is orange before red (y/n)? no
 
Sorted array: [red orange yellow green blue indigo violet]
</pre>
 
=={{header|Arturo}}==
 
<langsyntaxhighlight lang="rebol">lst: ["violet" "red" "green" "indigo" "blue" "yellow" "orange"]
count: 0
 
Line 50 ⟶ 187:
 
print ""
print ["sorted =>" sortedLst]</langsyntaxhighlight>
 
{{out}}
Line 66 ⟶ 203:
 
sorted => [indigo orange yellow green blue red violet]</pre>
 
=={{header|AutoHotkey}}==
<syntaxhighlight lang="autohotkey">data := ["Violet", "Red", "Green", "Indigo", "Blue", "Yellow", "Orange"]
result := [], num := 0, Questions :=""
 
for i, Color1 in data{
found :=false
if !result.count(){
result.Push(Color1)
continue
}
for j, Color2 in result {
if (color1 = color2)
continue
MsgBox, 262180,, % (Q := "Q" ++num " is " Color1 " > " Color2 "?")
ifMsgBox, Yes
Questions .= Q "`t`tYES`n"
else {
Questions .= Q "`t`tNO`n"
result.InsertAt(j, Color1)
found := true
break
}
}
if !found
result.Push(Color1)
}
for i, color in result
output .= color ", "
MsgBox % Questions "`nSorted Output :`n" Trim(output, ", ")
return</syntaxhighlight>
 
{{out}}
<pre>Q1 is Red > Violet? NO
Q2 is Green > Red? YES
Q3 is Green > Violet? NO
Q4 is Indigo > Red? YES
Q5 is Indigo > Green? YES
Q6 is Indigo > Violet? NO
Q7 is Blue > Red? YES
Q8 is Blue > Green? YES
Q9 is Blue > Indigo? NO
Q10 is Yellow > Red? YES
Q11 is Yellow > Green? NO
Q12 is Orange > Red? YES
Q13 is Orange > Yellow? NO
 
Sorted Output :
Red, Orange, Yellow, Green, Blue, Indigo, Violet</pre>
 
=={{header|C}}==
Using qsort; not very efficient
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <string.h>
#include <stdlib.h>
Line 101 ⟶ 288:
printOrder(items, sizeof(items)/sizeof(*items));
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>
Line 128 ⟶ 315:
=={{header|C++}}==
===C++: Binary search insertion sort===
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <iostream>
#include <vector>
Line 174 ⟶ 361:
PrintOrder(sortedItems);
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>
Line 201 ⟶ 388:
 
===C++: STL sort with custom comparator===
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <iostream>
#include <vector>
Line 234 ⟶ 421:
PrintOrder(items);
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>
Line 255 ⟶ 442:
 
=={{header|Commodore BASIC}}==
<langsyntaxhighlight lang="basic">100 REM SORT BY COMPARISON
110 DIM IN$(6), OU$(6)
120 FOR I=0 TO 6:READ IN$(I): NEXT I
Line 287 ⟶ 474:
410 FOR Q=0 TO N-2:PRINT OU$(Q)",";:NEXT Q
420 PRINT OU$(N-1)")"
430 RETURN</langsyntaxhighlight>
{{Out}}
<pre>
Line 306 ⟶ 493:
 
=={{header|F_Sharp|F#}}==
This task uses [https://rosettacode.org/wiki/Factorial_base_numbers_indexing_permutations_of_a_collection#F.23 Factorial base numbers indexing permutations of a collection (F#)]
<lang fsharp>
<syntaxhighlight lang="fsharp">
// Order by pair comparisons. Nigel Galloway: April 23rd., 2021
let clrs=let n=System.Random() in lN2p [|for g in 7..-1..2->n.Next(g)|] [|"Red";"Orange";"Yellow";"Green";"Blue";"Indigo";"Violet"|]
type colours= Violet |Red |Green |Indigo |Blue |Yellow |Orange
let clrsrec fG n g=printfn "EnterIs colours%s seperatedless bythan spaces%s" n g; match System.Console.ReadLine() with "Yes"-> -1|"No"->1 |_->printfn "Enter Yes or No"; fG n g
let mutable z=0 in printfn "%A sorted to %A using %d questions" clrs (clrs|>Array.sortWith(fun n g->z<-z+1; fG n g)) z
let fN g=match g with "Violet"->Some(Violet) |"Red"->Some(Red) |"Green"->Some(Green) |"Indigo"->Some(Indigo) |"Blue"->Some(Blue) |"Yellow"->Some(Yellow) |"Orange"->Some(Orange) |_->None
</syntaxhighlight>
let mutable z=0 in printfn "%s sorted to %A using %d comparisons" clrs (clrs.Split ' '|>Array.choose fN|>Array.sortWith(fun n g->z<-z+1; compare n g)) z
</lang>
{{out}}
Possible interaction:
Typical outputs:
<pre>
Is Indigo less than Orange
Enter colours seperated by spaces
Yes
Blue Red Yellow
Is Blue less than Orange
Blue Red Yellow sorted to [|Red; Blue; Yellow|] using 3 comparisons
Yes
 
Is Blue less than Indigo
Enter colours seperated by spaces
No
Red Orange Yellow Green Blue Indigo Violet
Is Yellow less than Orange
Red Orange Yellow Green Blue Indigo Violet sorted to [|Violet; Red; Green; Indigo; Blue; Yellow; Orange|] using 19 comparisons
Yes
Is Yellow less than Blue
No
Is Red less than Orange
Yes
Is Red less than Yellow
Yes
Is Red less than Blue
Yes
Is Red less than Indigo
Yes
Is Green less than Orange
Yes
Is Green less than Yellow
Yes
Is Green less than Blue
Yes
Is Green less than Indigo
Yes
Is Green less than Red
No
Is Violet less than Orange
Yes
Is Violet less than Yellow
Yes
Is Violet less than Blue
Yes
Is Violet less than Indigo
Yes
Is Violet less than Green
Yes
Is Violet less than Red
Yes
[|"Orange"; "Indigo"; "Blue"; "Yellow"; "Red"; "Green"; "Violet"|] sorted to [|"Violet"; "Red"; "Green"; "Indigo"; "Blue"; "Yellow"; "Orange"|] using 20 questions
</pre>
 
Line 328 ⟶ 549:
Asking the user for an ordering specifier inside a custom comparator:
{{works with|Factor|0.99 2021-02-05}}
<langsyntaxhighlight lang="factor">USING: formatting io kernel math.order prettyprint qw sorting ;
 
qw{ violet red green indigo blue yellow orange }
[ "Is %s > %s? (y/n) " printf readln "y" = +gt+ +lt+ ? ] sort .</langsyntaxhighlight>
{{out}}
<pre>
Line 348 ⟶ 569:
{ "red" "orange" "yellow" "green" "blue" "indigo" "violet" }
</pre>
 
 
=={{header|FreeBASIC}}==
{{trans|Commodore BASIC}}
<syntaxhighlight lang="freebasic">
Dim Shared As Byte r, n = 1
Dim Shared As String IN1, OU1
Dim Shared As String IN(6), OU(6)
Dim As Byte i, j, k
For i = 0 To 6 : Read IN(i) : Next i
Data "violet", "red", "green", "indigo", "blue", "yellow", "orange"
OU(0) = IN(0)
 
Sub PrintOrder
Print : Print "{";
If n = 1 Then Print OU(n-1);")" : Exit Sub
For q As Byte = 0 To n-2
Print OU(q);", ";
Next q
Print OU(n-1);"}"
End Sub
 
Sub InteractiveCompare
Dim As String*1 T
Print "Es "; IN1; " < "; OU1; "? (S/N) ";
Do: T = Inkey$: Loop Until T <> ""
If Instr("snSN", T) Then Print Ucase(T)
r = T = "S"
End Sub
 
For i = 1 To 6
IN1 = IN(i)
For j = 0 To n-1
OU1 = OU(j)
InteractiveCompare
If r < 0 Then
For k = n To j+1 Step -1
OU(k) = OU(k-1)
Next k
OU(j) = IN1
n += 1
Exit For, For
End If
Next j
OU(n) = IN1
n += 1
Next i
PrintOrder
Sleep
</syntaxhighlight>
 
 
=={{header|Go}}==
===Go: Binary search insertion sort===
<langsyntaxhighlight lang="go">package main
import (
Line 387 ⟶ 659:
}
fmt.Println(sortedItems)
}</langsyntaxhighlight>
{{out}}
<pre>
Line 414 ⟶ 686:
 
===Go: Standard sort with custom comparator===
<langsyntaxhighlight lang="go">package main
import (
Line 440 ⟶ 712:
sort.Sort(items)
fmt.Println(items)
}</langsyntaxhighlight>
{{out}}
<pre>
Line 456 ⟶ 728:
[red orange yellow green blue indigo violet]
</pre>
 
=={{header|Haskell}}==
 
Injection of interaction with user is not straight-forward in pure functional language. In Haskell we use monads in order to abstract the computation flow and side effects. Fortunately the monadlist library [[https://hackage.haskell.org/package/monadlist]] contains monadic variants of most popular list operations so that it becomes easy to implement our favorite sorting algorithms.
 
<syntaxhighlight lang="haskell">import Control.Monad
import Control.Monad.ListM (sortByM, insertByM, partitionM, minimumByM)
import Data.Bool (bool)
import Data.Monoid
import Data.List
 
--------------------------------------------------------------------------------
isortM, msortM, tsortM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a]
 
-- merge sort from the Control.Monad.ListM library
msortM = sortByM
 
-- insertion sort
isortM cmp = foldM (flip (insertByM cmp)) []
 
-- tree sort aka qsort (which is not)
tsortM cmp = go
where
go [] = pure []
go (h:t) = do (l, g) <- partitionM (fmap (LT /=) . cmp h) t
go l <+> pure [h] <+> go g
(<+>) = liftM2 (++)</syntaxhighlight>
 
Now we can sort lists with effects. For example, we may count number of comparisons, using writer monad:
 
<pre>*Main> let countComparisons cmp a b = (Sum 1, a `cmp` b)
*Main> msortM (countComparisons compare) [2,6,3,5,9,1,5]
(Sum {getSum = 15},[1,2,3,5,5,6,9])
 
*Main> isortM (countComparisons compare) [2,6,3,5,9,1,5]
(Sum {getSum = 15},[1,2,3,5,5,6,9])
 
*Main> tsortM (countComparisons compare) [2,6,3,5,9,1,5]
(Sum {getSum = 13},[1,2,3,5,5,6,9])</pre>
 
Or use a "database" as a reference for sorting, using reader monad
 
<pre>let fromList a b l = elemIndex a l `compare` elemIndex b l
*Main> msortM fromList [2,1,3,2,4,4,5,11,2,3,2,3] [1..]
[1,2,2,2,2,3,3,3,4,4,5,11]</pre>
 
Or even generate all possible permutations of a list making comparisons ambiguous:
 
<pre>*Main> isortM (\_ _ -> [LT, GT]) [1,2,3]
[[1,2,3],[1,3,2],[3,1,2],[2,1,3],[2,3,1],[3,2,1]]</pre>
We are ready to ask user to compare entries for us:
<syntaxhighlight lang="haskell">ask a b = do
putStr $ show a ++ " ≤ " ++ show b ++ " ? [y/n] "
bool GT LT . ("y" ==) <$> getLine
 
colors = ["Violet", "Red", "Green", "Indigo", "Blue", "Yellow", "Orange"]</syntaxhighlight>
 
<pre>*Main> isortM ask colors
"Red" ≤ "Violet" ? [y/n] y
"Green" ≤ "Red" ? [y/n] n
"Green" ≤ "Violet" ? [y/n] y
"Indigo" ≤ "Red" ? [y/n] n
"Indigo" ≤ "Green" ? [y/n] n
"Indigo" ≤ "Violet" ? [y/n] y
"Blue" ≤ "Red" ? [y/n] n
"Blue" ≤ "Green" ? [y/n] n
"Blue" ≤ "Indigo" ? [y/n] y
"Yellow" ≤ "Red" ? [y/n] n
"Yellow" ≤ "Green" ? [y/n] y
"Orange" ≤ "Red" ? [y/n] n
"Orange" ≤ "Yellow" ? [y/n] y
["Red","Orange","Yellow","Green","Blue","Indigo","Violet"]
 
*Main> msortM ask colors
"Violet" ≤ "Red" ? [y/n] n
"Red" ≤ "Green" ? [y/n] y
"Green" ≤ "Indigo" ? [y/n] y
"Indigo" ≤ "Blue" ? [y/n] n
"Blue" ≤ "Yellow" ? [y/n] n
"Yellow" ≤ "Orange" ? [y/n] n
"Red" ≤ "Green" ? [y/n] y
"Violet" ≤ "Green" ? [y/n] n
"Violet" ≤ "Indigo" ? [y/n] n
"Red" ≤ "Orange" ? [y/n] y
"Green" ≤ "Orange" ? [y/n] n
"Green" ≤ "Yellow" ? [y/n] n
"Green" ≤ "Blue" ? [y/n] y
"Indigo" ≤ "Blue" ? [y/n] n
["Red","Orange","Yellow","Green","Blue","Indigo","Violet"]
 
*Main> tsortM ask colors
"Violet" ≤ "Red" ? [y/n] n
"Violet" ≤ "Green" ? [y/n] n
"Violet" ≤ "Indigo" ? [y/n] n
"Violet" ≤ "Blue" ? [y/n] n
"Violet" ≤ "Yellow" ? [y/n] n
"Violet" ≤ "Orange" ? [y/n] n
"Red" ≤ "Green" ? [y/n] y
"Red" ≤ "Indigo" ? [y/n] y
"Red" ≤ "Blue" ? [y/n] y
"Red" ≤ "Yellow" ? [y/n] y
"Red" ≤ "Orange" ? [y/n] y
"Green" ≤ "Indigo" ? [y/n] y
"Green" ≤ "Blue" ? [y/n] y
"Green" ≤ "Yellow" ? [y/n] n
"Green" ≤ "Orange" ? [y/n] n
"Yellow" ≤ "Orange" ? [y/n] n
"Indigo" ≤ "Blue" ? [y/n] n
["Red","Orange","Yellow","Green","Blue","Indigo","Violet"]</pre>
 
It seems that insertion sort with 13 comparisons is the best one, and tree sort which needed 17 questions is the worst. But efficiency of sorting depends on the order of given list. Simple statistics could be made to compare these three methods for all possible permutations of seven elements.
 
<syntaxhighlight lang="haskell">test method = do
mapM_ showHist $ hist res
putStrLn $ "Median number of comparisons: " ++ show (median res)
putStrLn $ "Mean number of comparisons: " ++ show (mean res)
where
res = getSum . fst . method cmp <$> permutations [1..7]
cmp a b = (Sum 1, compare a b)
median lst = sort lst !! (length lst `div` 2)
mean lst = sum (fromIntegral <$> lst) / genericLength lst
hist lst = (\x -> (head x, length x)) <$> group (sort lst)
showHist (n, l) = putStrLn line
where
line = show n ++ "\t" ++ bar ++ " " ++ show perc ++ "%"
bar = replicate (max perc 1) '*'
perc = (100 * l) `div` product [1..7]</syntaxhighlight>
 
Comparing these three methods gives that for random inputs tree sort is the best choice.
<pre>*Main> test msortM
6 * 0%
7 * 0%
8 * 0%
9 * 0%
10 * 1%
11 *** 3%
12 ******* 7%
13 ******** 8%
14 **************** 16%
15 ************************ 24%
16 ************************ 24%
17 ************ 12%
Median number of comparisons: 15
Mean number of comparisons: 14.693055555555556
 
*Main> test isortM
6 * 0%
7 * 0%
8 * 0%
9 * 1%
10 *** 3%
11 ***** 5%
12 ******** 8%
13 ********** 10%
14 ************ 12%
15 ************* 13%
16 ************* 13%
17 *********** 11%
18 ******** 8%
19 ***** 5%
20 *** 3%
21 * 1%
Median number of comparisons: 15
Mean number of comparisons: 14.907142857142857
 
*Main> test tsortM
10 * 1%
11 ******************** 20%
12 ******************** 20%
13 ***************** 17%
14 ******** 8%
15 ************* 13%
16 ***** 5%
17 ****** 6%
18 ** 2%
19 * 1%
20 * 0%
21 * 1%
Median number of comparisons: 13
Mean number of comparisons: 13.485714285714286</pre>
 
=={{header|J}}==
Implementation (here we assume that ordering is transitive):<syntaxhighlight lang="j">require'general/misc/prompt'
sel=: {{ u#[ }}
 
quicksort=: {{
if. 1 >: #y do. y
else.
(u quicksort y u sel e),(y =sel e),u quicksort y u~ sel e=.y{~?#y
end.
}}
 
ptc=: {{
t=. (+. +./ .*.~)^:_ y=1
j=. I.,t+.|:t
($y)$(j{,t) j} ,y
}}
 
askless=: {{
coord=. x ,&(items&i.) y
lt=. LT {~<coord
if. 1<lt do.
lt=. 'y' e. tolower prompt 'Is ',(":;x),' less than ',(":;y),'? '
LT=: ptc (lt,-.lt) (coord;|.coord)} LT
end.
lt
}}"0
 
asksort=: {{
items=: ~.y
LT=: <:%=i.#items
askless quicksort y
}}</syntaxhighlight>
 
Task example:<syntaxhighlight lang="j"> asksort&.;:' violet red green indigo blue yellow orange'
Is indigo less than violet? yes
Is indigo less than red? no
Is indigo less than green? no
Is indigo less than blue? no
Is indigo less than yellow? no
Is indigo less than orange? no
Is yellow less than red? no
Is yellow less than green? yes
Is yellow less than blue? yes
Is yellow less than orange? no
Is green less than blue? yes
Is red less than orange? yes
red orange yellow green blue indigo violet</syntaxhighlight>
 
=={{header|Java}}==
===Java: Binary search insertion sort===
<langsyntaxhighlight lang="java">import java.util.*;
 
public class SortComp1 {
Line 483 ⟶ 984:
System.out.println(sortedItems);
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 510 ⟶ 1,011:
 
===Java: Standard sort with custom comparator===
<langsyntaxhighlight lang="java">import java.util.*;
 
public class OrderByPair {
Line 525 ⟶ 1,026:
System.out.println(items);
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 544 ⟶ 1,045:
[red, yellow, green, orange, blue, indigo, violet]
</pre>
 
=={{header|jq}}==
{{trans|Wren}}
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
 
In order for a jq program to interact with a user, prompts must be directed to stderr,
which currently means that the prompt string will be printed with quotation marks.
<syntaxhighlight lang="jq">def inputOption($prompt; $options):
def r:
$prompt | stderr
| input as $in
| if $in|test($options) then $in else r end;
r;
 
# Inserts item $x in the array input, which is kept sorted as per user input
# assuming it is already sorted. $q is the prompt number.
# Input: [$q; $a]
# Output: [$qPrime, $aPrime]
def insortRight($x):
. as [$q, $a]
| { lo: 0, hi: ($a|length), $q }
| until( .lo >= .hi;
( ((.lo + .hi)/2)|floor) as $mid
| .q += 1
| "\(.q): Is \($x) less than \($a[$mid])? y/n: " as $prompt
| (inputOption($prompt; "[yn]") == "y") as $less
| if ($less) then .hi = $mid
else .lo = $mid + 1
end)
# insert at position .lo
| [ .q, ($a[: .lo] + [x] + $a[.lo :]) ];
def order:
reduce .[] as $item ( [0, []]; insortRight($item) )
| .[1];
 
["violet red green indigo blue yellow orange"|splits(" ")]
| order as $ordered
| ("\nThe colors of the rainbow, in sorted order, are:",
$ordered )</syntaxhighlight>
 
'''Recommended Invocation Options''': -nRrc
 
'''Sample Transcript'''
<pre>
"1: Is red less than violet? y/n: "y
y
"2: Is green less than violet? y/n: "y
y
"3: Is green less than red? y/n: "n
n
"4: Is indigo less than green? y/n: "n
n
"5: Is indigo less than violet? y/n: "y
y
"6: Is blue less than indigo? y/n: "y
y
"7: Is blue less than green? y/n: "n
n
"8: Is yellow less than blue? y/n: "y
y
"9: Is yellow less than green? y/n: "y
y
"10: Is yellow less than red? y/n: "n
n
"11: Is orange less than blue? y/n: "y
y
"12: Is orange less than yellow? y/n: "y
y
"13: Is orange less than red? y/n: "n
n
 
The colors of the rainbow, in sorted order, are:
["red","orange","yellow","green","blue","indigo","violet"]
</pre>
 
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">const nrequests = [0]
const ordering = Dict("violet" => 7, "red" => 1, "green" => 4, "indigo" => 6, "blue" => 5,
"yellow" => 3, "orange" => 2)
Line 586 ⟶ 1,164:
println("Unsorted: $words")
println("Sorted: $(orderbypair!(words)). Total requests: $(nrequests[1]).")
</langsyntaxhighlight>{{out}}
<pre>
Is violet greater than indigo? (Y/N) => y
Line 604 ⟶ 1,182:
Sorted: ["red", "orange", "yellow", "green", "blue", "indigo", "violet"]. Total requests: 14.
</pre>
 
=={{header|Lua}}==
<syntaxhighlight lang="lua">colors = { "violet", "red", "green", "indigo", "blue", "yellow", "orange" }
print("unsorted: " .. table.concat(colors," "))
known, notyn, nc, nq = {}, {n="y",y="n"}, 0, 0
table.sort(colors, function(a,b)
nc = nc + 1
if not known[a] then known[a]={[a]="n"} end
if not known[b] then known[b]={[b]="n"} end
if not (known[a][b] or known[b][a]) then
io.write("Is '" .. a .. "' < '" .. b .."'? (y/n): ")
nq, known[a][b] = nq+1, io.read()
if a~=b then known[b][a] = notyn[known[a][b]] end
end
return known[a][b]=="y"
end)
print("sorted: " .. table.concat(colors," "))
print("(" .. nq .. " questions needed to resolve " .. nc .. " comparisons)")</syntaxhighlight>
{{out}}
<pre>unsorted: violet red green indigo blue yellow orange
Is 'orange' < 'violet'? (y/n): y
Is 'indigo' < 'orange'? (y/n): n
Is 'violet' < 'indigo'? (y/n): n
Is 'red' < 'indigo'? (y/n): y
Is 'green' < 'indigo'? (y/n): y
Is 'yellow' < 'indigo'? (y/n): y
Is 'blue' < 'indigo'? (y/n): y
Is 'blue' < 'orange'? (y/n): n
Is 'green' < 'orange'? (y/n): n
Is 'blue' < 'green'? (y/n): n
Is 'red' < 'green'? (y/n): y
Is 'yellow' < 'green'? (y/n): y
Is 'yellow' < 'orange'? (y/n): n
Is 'red' < 'orange'? (y/n): y
sorted: red orange yellow green blue indigo violet
(14 questions needed to resolve 18 comparisons)</pre>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">ClearAll[HumanOrderCheck]
HumanOrderCheck[opt1_,opt2_]:=ChoiceDialog[Row@{"Is {",opt1,", ", opt2, "} ordered?"},{"Yes"->True,"No"->False}]
Sort[{"violet","red","green","indigo","blue","yellow","orange"},HumanOrderCheck]</langsyntaxhighlight>
{{out}}
After some Yes/No clicks you should get:
<pre>{"red", "orange", "yellow", "green", "blue", "indigo", "violet"}</pre>
 
=={{header|MiniScript}}==
<syntaxhighlight lang="miniscript">
insertSort = function(arr, item)
lo = 0
hi = arr.len
while lo < hi
mid = floor((lo + hi) / 2)
ans = input("Is " + item + " less than " + arr[mid] + "? y/n: ")
ans = ans[0].lower
if ans == "y" then
hi = mid
else
lo = mid + 1
end if
end while
arr.insert(lo, item)
end function
 
items = "violet red green indigo blue yellow orange".split
ordered = []
for item in items
insertSort(ordered, item)
end for
print ordered
</syntaxhighlight>
{{out}}
<pre>
Is red less than violet? y/n: y
Is green less than violet? y/n: y
Is green less than red? y/n: n
Is indigo less than green? y/n: n
Is indigo less than violet? y/n: y
Is blue less than indigo? y/n: y
Is blue less than green? y/n: n
Is yellow less than blue? y/n: y
Is yellow less than green? y/n: y
Is yellow less than red? y/n: n
Is orange less than blue? y/n: y
Is orange less than yellow? y/n: y
Is orange less than red? y/n: n
["red", "orange", "yellow", "green", "blue", "indigo", "violet"]
</pre>
 
=={{header|Nim}}==
Using a list filled by binary insertion and a custom comparison function.
<langsyntaxhighlight Nimlang="nim">import algorithm, strformat, strutils
 
let list = ["violet", "red", "green", "indigo", "blue", "yellow", "orange"]
Line 637 ⟶ 1,294:
sortedList.insert(elem, sortedList.upperBound(elem, comp))
 
echo "Sorted list: ", sortedList.join(", ")</langsyntaxhighlight>
 
{{out}}
Line 659 ⟶ 1,316:
 
List:
<langsyntaxhighlight lang="ocaml">let () =
let count = ref 0 in
let mycmp s1 s2 = (
Line 669 ⟶ 1,326:
let sorted = List.sort mycmp items in
List.iter (Printf.printf "%s ") sorted;
print_newline ()</langsyntaxhighlight>
{{out}}
<pre>
Line 689 ⟶ 1,346:
 
Array:
<langsyntaxhighlight lang="ocaml">let () =
let count = ref 0 in
let mycmp s1 s2 = (
Line 699 ⟶ 1,356:
Array.sort mycmp items;
Array.iter (Printf.printf "%s ") items;
print_newline ()</langsyntaxhighlight>
{{out}}
<pre>
Line 725 ⟶ 1,382:
 
=={{header|Perl}}==
<langsyntaxhighlight lang="perl">#!/usr/bin/perl
 
use strict; # https://rosettacode.org/wiki/Order_by_pair_comparisons
Line 740 ⟶ 1,397:
 
my @sorted = sort ask qw( violet red green indigo blue yellow orange );
print "sorted: @sorted\n";</langsyntaxhighlight>
{{out}}
<pre>
Line 765 ⟶ 1,422:
I picked an initial ordering that requires a fairly easy to remember set of answers: 4Y then alternate.<br>
The builtin sort(s) use an initial gap of 10%, ultimately balancing #comparisons against cache hits, which leads to a wider range of #questions, as said best case 6, worst case 21. A better match to the narrower range of Python (I think 10..14) could probably be made using a copy of custom_sort (it is only 52 lines) with an initial 50% gap.
<!--<langsyntaxhighlight Phixlang="phix">(notonline)-->
<span style="color: #004080;">integer</span> <span style="color: #000000;">qn</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">ask</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
Line 776 ⟶ 1,433:
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">custom_sort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ask</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"violet orange red yellow green blue indigo"</span><span style="color: #0000FF;">))</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 797 ⟶ 1,454:
Uses binary search to insert successive items into a growing ordered list. Comparisons are asked for.
 
<langsyntaxhighlight lang="python">def _insort_right(a, x, q):
"""
Insert item x in list a, and keep it sorted assuming a is sorted.
Line 822 ⟶ 1,479:
items = 'violet red green indigo blue yellow orange'.split()
ans, questions = order(items)
print('\n' + ' '.join(ans))</langsyntaxhighlight>
 
{{out}}
Line 856 ⟶ 1,513:
This uses a custom comparator together with [https://docs.python.org/3/library/functools.html?highlight=cmp_to_key#functools.cmp_to_key functools.cmp_to_key] to sort the previous order in fourteen questions.
 
<langsyntaxhighlight lang="python">from functools import cmp_to_key
 
def user_cmp(a, b):
Line 864 ⟶ 1,521:
items = 'violet red green indigo blue yellow orange'.split()
ans = sorted(items, key=cmp_to_key(user_cmp))
print('\n' + ' '.join(ans))</langsyntaxhighlight>
 
{{out}}
Line 901 ⟶ 1,558:
<code>sortwith</code> sorts by insertion sort by default, of by merge sort falling back to insertion sort for nests of fewer than 16 items if the Quackery extensions are loaded. In either instance, as this is sorting a nest of seven items, it will be by insertion sort.
 
<langsyntaxhighlight Quackerylang="quackery"> [ $ "Is " swap join
$ " before " join
swap join
Line 913 ⟶ 1,570:
dup witheach [ echo$ sp ] cr cr
sortwith askuser cr
witheach [ echo$ sp ] cr</langsyntaxhighlight>
 
{{out}}
Line 942 ⟶ 1,599:
Since the calls to the comparator are minimized, and the info that the user provides is analogous to the required return values of the comparator, we just need to embed the prompt directly in the comparator.
 
<syntaxhighlight lang="raku" perl6line>my $ask_count = 0;
sub by_asking ( $a, $b ) {
$ask_count++;
Line 963 ⟶ 1,620:
die if @sorted».substr(0,1).join ne 'roygbiv';
my $expected_ask_count = @colors.elems * log(@colors.elems);
warn "Too many questions? ({:$ask_count} > {:$expected_ask_count})" if $ask_count > $expected_ask_count;</langsyntaxhighlight>
{{out}}
<pre>
Line 988 ⟶ 1,645:
 
Also note that lists in REXX start with unity, not zero.
<syntaxhighlight lang="rexx">/*REXX pgm orders some items based on (correct) answers from a carbon─based life form. */
colors= 'violet red green indigo blue yellow orange'
q= 0; #= 0; $=
Line 1,012 ⟶ 1,669:
else lo= mid + 1
end /*q*/
$= subword($, 1, lo) x subword($, lo+1); return q</langsyntaxhighlight>
{{out|output|text=&nbsp; (only showing the results and eliding the querying/answering):}}
<pre>
Line 1,034 ⟶ 1,691:
=={{header|Ruby}}==
===Ruby: Binary search insertion sort===
<langsyntaxhighlight lang="ruby">items = ["violet", "red", "green", "indigo", "blue", "yellow", "orange"]
count = 0
sortedItems = []
Line 1,046 ⟶ 1,703:
sortedItems.insert(spotToInsert, item)
}
p sortedItems</langsyntaxhighlight>
{{out}}
<pre>
Line 1,073 ⟶ 1,730:
 
===Ruby: Standard sort with custom comparator===
<langsyntaxhighlight lang="ruby">items = ["violet", "red", "green", "indigo", "blue", "yellow", "orange"]
count = 0
p items.sort {|a, b|
Line 1,079 ⟶ 1,736:
print "(#{count}) Is #{a} <, =, or > #{b}. Answer -1, 0, or 1: "
gets.to_i
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,108 ⟶ 1,765:
{{libheader|Wren-ioutil}}
{{libheader|Wren-fmt}}
<langsyntaxhighlight ecmascriptlang="wren">import "./ioutil" for Input
import "./fmt" for Fmt
 
// Inserts item x in list a, and keeps it sorted assuming a is already sorted.
Line 1,143 ⟶ 1,800:
var ordered = order.call(items)
System.print("\nThe colors of the rainbow, in sorted order, are:")
System.print(ordered)</langsyntaxhighlight>
 
{{out}}
Line 1,163 ⟶ 1,820:
The colors of the rainbow, in sorted order, are:
[red, orange, yellow, green, blue, indigo, violet]
</pre>
 
=={{header|XPL0}}==
<syntaxhighlight lang "XPL0">include xpllib; \for Print
 
int Items, Size, I, J, Gap, JG, T, C, Count;
[Items:= ["violet", "red", "green", "indigo", "blue", "yellow", "orange"];
Size:= 7;
Count:= 0;
Gap:= Size>>1;
while Gap > 0 do
[for I:= Gap to Size-1 do
[J:= I - Gap;
loop [JG:= J + Gap;
Count:= Count+1;
Print("%2d: Is %6s less than %6s (y/n)? ",
Count, Items(J), Items(JG));
repeat OpenI(1);
C:= ChIn(1);
until C=^y or C=^n;
ChOut(0, C); CrLf(0);
if C = ^y then quit;
T:= Items(J); Items(J):= Items(JG); Items(JG):= T;
J:= J - Gap;
if J < 0 then quit;
];
];
Gap:= Gap>>1;
];
Print("The colors of the rainbow, in sorted order, are:\n");
for I:= 0 to Size-2 do Print("%s, ", Items(I));
Print("%s\n", Items(I));
]</syntaxhighlight>
{{out}}
<pre>
1: Is violet less than indigo (y/n)? n
2: Is red less than blue (y/n)? y
3: Is green less than yellow (y/n)? n
4: Is violet less than orange (y/n)? n
5: Is indigo less than orange (y/n)? n
6: Is orange less than red (y/n)? n
7: Is orange less than yellow (y/n)? y
8: Is yellow less than indigo (y/n)? y
9: Is indigo less than blue (y/n)? n
10: Is yellow less than blue (y/n)? y
11: Is indigo less than green (y/n)? n
12: Is blue less than green (y/n)? n
13: Is yellow less than green (y/n)? y
14: Is indigo less than violet (y/n)? y
The colors of the rainbow, in sorted order, are:
red, orange, yellow, green, blue, indigo, violet
</pre>
9,476

edits