Compare a list of strings
You are encouraged to solve this task according to the task description, using any language you may know.
- Task
Given a list of arbitrarily many strings, show how to:
- test if they are all lexically equal
- test if every string is lexically less than the one after it (i.e. whether the list is in strict ascending order)
Each of those two tests should result in a single true or false value, which could be used as the condition of an if statement or similar.
If the input list has less than two elements, the tests should always return true.
There is no need to provide a complete program and output.
Assume that the strings are already stored in an array/list/sequence/tuple variable (whatever is most idiomatic) with the name strings, and just show the expressions for performing those two tests on it (plus of course any includes and custom functions etc. that it needs), with as little distractions as possible.
Try to write your solution in a way that does not modify the original list, but if it does then please add a note to make that clear to readers.
If you need further guidance/clarification, see #Perl and #Python for solutions that use implicit short-circuiting loops, and #Raku for a solution that gets away with simply using a built-in language feature.
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contains most consonants
- Find words which contains more than 3 vowels
- Find words which first and last three letters are equals
- Find words which odd letters are consonants and even letters are vowels or vice_versa
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 Bottles of Beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
11l
<lang 11l>L(strings_s) [‘AA AA AA AA’, ‘AA ACB BB CC’]
V strings = strings_s.split(‘ ’) print(strings) print(all(zip(strings, strings[1..]).map(a -> a[0] == a[1]))) print(all(zip(strings, strings[1..]).map(a -> a[0] < a[1]))) print()</lang>
360 Assembly
The program uses one ASSIST macro (XPRNT) to keep the code as short as possible. <lang 360asm>* Compare a list of strings 31/01/2017 COMPLIST CSECT
USING COMPLIST,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) prolog
ST R13,4(R15) " <-
ST R15,8(R13) " ->
LR R13,R15 " addressability
MVC SNAME,=C'ABC'
LA R1,SNAME
LA R2,ABC
BAL R14,TEST call test('ABC',abc)
MVC SNAME,=C'AAA'
LA R1,SNAME
LA R2,AAA
BAL R14,TEST call test('AAA',aaa)
MVC SNAME,=C'ACB'
LA R1,SNAME
LA R2,ACB
BAL R14,TEST call test('ACB',acb)
L R13,4(0,R13) epilog
LM R14,R12,12(R13) " restore
XR R15,R15 " rc=0
BR R14 exit
- ------- ---- test(name,xlist) -----------------------
TEST MVC NAME,0(R1) store argument #1
MVC XLIST(6),0(R2) store argument #2
MVI ALLEQ,X'01' alleq=true
MVI INCRE,X'01' incre=true
LA R6,1 i=1
LOOPI LA R2,NXLIST hbound(xlist)
BCTR R2,0 -1
CR R6,R2 do i to hbound(xlist)-1
BH ELOOPI
MVC XBOOL,ALLEQ
OC XBOOL,INCRE or
CLI XBOOL,X'01' and while alleq or incre
BNE ELOOPI
LA R2,1(R6) i+1
SLA R2,1 *2
LA R3,XLIST-2(R2) @xlist(i+1)
LR R1,R6 i
SLA R1,1 *2
LA R4,XLIST-2(R1) @xlist(i)
CLC 0(2,R3),0(R4) if xlist(i+1)=xlist(i)
BNE SEL1B
MVI INCRE,X'00' incre=false
B SEL1END
SEL1B CLC 0(2,R3),0(R4) if xlist(i+1)<xlist(i)
BNL SEL1OTH
MVI INCRE,X'00' incre=false
MVI ALLEQ,X'00' alleq=false
B SEL1END
SEL1OTH MVI ALLEQ,X'00' alleq=false SEL1END LA R6,1(R6) i=i+1
B LOOPI
ELOOPI CLI ALLEQ,X'01' if alleq
BNE SEL2B
MVC TXT,=CL40'all elements are equal'
B SEL2END
SEL2B CLI INCRE,X'01' if incre
BNE SEL2OTH
MVC TXT,=CL40'elements are in increasing order'
B SEL2END
SEL2OTH MVC TXT,=CL40'neither equal nor in increasing order' SEL2END MVI PG,C' '
MVC PG+1(79),PG clear buffer
MVC PG(3),NAME
MVC PG+3(3),=C' : '
MVC PG+6(40),TXT
XPRNT PG,L'PG
BR R14 return to caller
- ---- ----------------------------------------
SNAME DS CL3 ABC DC CL2'AA',CL2'BB',CL2'CC' AAA DC CL2'AA',CL2'AA',CL2'AA' ACB DC CL2'AA',CL2'CC',CL2'BB' NAME DS CL3 XLIST DS 3CL2 NXLIST EQU (*-XLIST)/L'XLIST ALLEQ DS X INCRE DS X TXT DS CL40 XBOOL DS X PG DS CL80
YREGS
END COMPLIST</lang>
- Output:
ABC : elements are in increasing order AAA : all elements are equal ACB : neither equal nor in increasing order
Action!
<lang Action!>DEFINE PTR="CARD"
BYTE FUNC AreEqual(PTR ARRAY a BYTE len)
INT i
FOR i=1 TO len-1
DO
IF SCompare(a(0),a(i))#0 THEN
RETURN (0)
FI
OD
RETURN (1)
BYTE FUNC IsAscendingOrder(PTR ARRAY a BYTE len)
INT i
FOR i=1 TO len-1
DO
IF SCompare(a(i-1),a(i))>=0 THEN
RETURN (0)
FI
OD
RETURN (1)
PROC Test(PTR ARRAY a BYTE len)
INT i
Print("Input array: [")
FOR i=0 TO len-1
DO
Print(a(i))
IF i<len-1 THEN
Put(32)
FI
OD
PrintE("]")
IF AreEqual(a,len) THEN
PrintE("All strings are lexically equal.")
ELSE
PrintE("Not all strings are lexically equal.")
FI
IF IsAscendingOrder(a,len) THEN
PrintE("The list is in strict ascending order.")
ELSE
PrintE("The list is not in strict ascending order.")
FI
PutE()
RETURN
PROC Main()
PTR ARRAY a1(4),a2(4),a3(4),a4(1)
a1(0)="aaa" a1(1)="aaa" a1(2)="aaa" a1(3)="aaa" Test(a1,4)
a2(0)="aaa" a2(1)="aab" a2(2)="aba" a2(3)="baa" Test(a2,4)
a3(0)="aaa" a3(1)="aab" a3(2)="aba" a3(3)="aba" Test(a3,4)
a4(0)="aaa" Test(a4,1)
RETURN</lang>
- Output:
Screenshot from Atari 8-bit computer
Input array: [aaa aaa aaa aaa] All strings are lexically equal. The list is not in strict ascending order. Input array: [aaa aab aba baa] Not all strings are lexically equal. The list is in strict ascending order. Input array: [aaa aab aba aba] Not all strings are lexically equal. The list is not in strict ascending order. Input array: [aaa] All strings are lexically equal. The list is in strict ascending order.
Ada
We will store the "list" of strings in a vector. The vector will hold "indefinite" strings, i.e., the strings can have different lengths. <lang Ada> package String_Vec is new Ada.Containers.Indefinite_Vectors
(Index_Type => Positive, Element_Type => String); use type String_Vec.Vector;</lang>
The equality test iterates from the first to the last-but one index. For index Idx, it checks checks if Strings(Idx) and Strings(Idx+1) are different. If the answer is yes for any Idx, the function immediately returns False. If the answer is no for all Idx, the function finally returns True. <lang Ada> function All_Are_The_Same(Strings: String_Vec.Vector) return Boolean is
begin
for Idx in Strings.First_Index .. Strings.Last_Index-1 loop
if Strings(Idx) /= Strings(Idx+1) then return False; end if;
end loop;
return True;
end All_Are_The_Same;</lang>
Similarily, the strictly ascending test checks if Strings(Idx) is greater or equal Strings(Idx+1). <lang Ada> function Strictly_Ascending(Strings: String_Vec.Vector) return Boolean is
begin
for Idx in Strings.First_Index+1 .. Strings.Last_Index loop
if Strings(Idx-1) >= Strings(Idx) then return False; end if;
end loop;
return True;
end Strictly_Ascending;</lang>
If the variable Strings is of the type String_Vec.vector, one can call these two functions as usual. <lang Ada>Put_Line(Boolean'Image(All_Are_The_Same(Strings)) & ", " &
Boolean'Image(Strictly_Ascending(Strings)));</lang>
If Strings holds two or more strings, the result will be either of TRUE, FALSE, or FALSE, TRUE, or FALSE, FALSE, indicating all strings are the same, or they are strictly ascending, or neither.
However, if Strings only holds zero or one string, the result will be TRUE, TRUE.
ALGOL 68
<lang ALGOL68>[]STRING list1 = ("AA","BB","CC"); []STRING list2 = ("AA","AA","AA"); []STRING list3 = ("AA","CC","BB"); []STRING list4 = ("AA","ACB","BB","CC"); []STRING list5 = ("single_element");
[][]STRING all lists to test = (list1, list2, list3, list4, list5);
PROC equal = ([]STRING list) BOOL:
BEGIN
BOOL ok := TRUE;
FOR i TO UPB list - 1 WHILE ok DO
ok := list[i] = list[i+1]
OD;
ok
END;
PROC less than = ([]STRING list) BOOL:
BEGIN
BOOL ok := TRUE;
FOR i TO UPB list - 1 WHILE ok DO
ok := list[i] < list[i + 1]
OD;
ok
END;
FOR i TO UPB all lists to test DO
[]STRING list = all lists to test[i];
print (("list:", (STRING s; FOR i TO UPB list DO s +:= " " + list[i] OD; s), new line));
IF equal (list) THEN
print (("...is lexically equal", new line))
ELSE
print (("...is not lexically equal", new line))
FI;
IF less than (list) THEN
print (("...is in strict ascending order", new line))
ELSE
print (("...is not in strict ascending order", new line))
FI
OD</lang>
- Output:
list: AA BB CC ...is not lexically equal ...is in strict ascending order list: AA AA AA ...is lexically equal ...is not in strict ascending order list: AA CC BB ...is not lexically equal ...is not in strict ascending order list: AA ACB BB CC ...is not lexically equal ...is in strict ascending order list: single_element ...is lexically equal ...is in strict ascending order
ALGOL W
<lang algolw> % returns true if all elements of the string array a are equal, false otherwise %
% As Algol W procedures cannot determine the bounds of an array, the bounds %
% must be specified in lo and hi %
logical procedure allStringsEqual ( string(256) array a ( * )
; integer value lo, hi
) ;
begin
logical same;
integer listPos;
same := true;
listPos := lo + 1;
while same and listPos <= hi do begin
same := a( lo ) = a( listPos );
listPos := listPos + 1
end;
same
end allStringsEqual ;
% returns true if the elements of the string array a are in ascending order, %
% false otherwise %
% As Algol W procedures cannot determine the bounds of an array, the bounds %
% must be specified in lo and hi %
logical procedure ascendingOrder ( string(256) array a ( * )
; integer value lo, hi
) ;
begin
logical ordered;
integer listPos;
ordered := true;
listPos := lo + 1;
while ordered and listPos <= hi do begin
ordered := a( listPos - 1 ) < a( listPos );
listPos := listPos + 1
end;
ordered
end ascendingOrder ;</lang>
AppleScript
(ES6 Functional example)
<lang AppleScript>-- allEqual :: [String] -> Bool
on allEqual(xs)
_and(zipWith(my _equal, xs, rest of xs))
end allEqual
-- azSorted :: [String] -> Bool on azSorted(xs)
_and(zipWith(my azBeforeOrSame, xs, rest of xs))
end azSorted
-- _equal :: a -> a -> Bool on _equal(a, b)
a = b
end _equal
-- azBefore :: String -> String -> Bool on azBeforeOrSame(a, b)
a ≥ b
end azBeforeOrSame
-- _and :: [a] -> Bool on _and(xs)
foldr(_equal, true, xs)
end _and
-- TEST
on run
set lstA to ["isiZulu", "isiXhosa", "isiNdebele", "Xitsonga", "Tshivenda", ¬
"Setswana", "Sesotho sa Leboa", "Sesotho", "English", "Afrikaans"]
set lstB to ["Afrikaans", "English", "Sesotho", "Sesotho sa Leboa", "Setswana", ¬
"Tshivenda", "Xitsonga", "isiNdebele", "isiXhosa", "isiZulu"]
set lstC to ["alpha", "alpha", "alpha", "alpha", "alpha", "alpha", "alpha", ¬
"alpha", "alpha", "alpha"]
{allEqual:map(allEqual, [lstA, lstB, lstC]), azSorted:map(azSorted, [lstA, lstB, lstC])}
-- > {allEqual:{false, false, true}, azSorted:{false, true, true}}
end run
-- GENERIC FUNCTIONS
-- foldr :: (a -> b -> a) -> a -> [b] -> a on foldr(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from lng to 1 by -1
set v to lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldr
-- map :: (a -> b) -> [a] -> [b] on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] on zipWith(f, xs, ys)
set nx to length of xs
set ny to length of ys
if nx < 1 or ny < 1 then
{}
else
set lng to cond(nx < ny, nx, ny)
set lst to {}
tell mReturn(f)
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, item i of ys)
end repeat
return lst
end tell
end if
end zipWith
-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) on cond(bool, f, g)
if bool then
f
else
g
end if
end cond
-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn</lang>
- Output:
{allEqual:{false, false, true}, azSorted:{false, true, true}}
Arturo
<lang rebol>allEqual?: function [lst] -> 1 = size unique lst ascending?: function [lst] -> lst = sort lst
lists: [
["abc" "abc" "abc"] ["abc" "abd" "abc"] ["abc" "abd" "abe"] ["abc" "abe" "abd"]
]
loop lists 'l [
print ["list:" l] print ["allEqual?" allEqual? l] print ["ascending?" ascending? l "\n"]
]</lang>
- Output:
list: [abc abc abc] allEqual? true ascending? true list: [abc abd abc] allEqual? false ascending? false list: [abc abd abe] allEqual? false ascending? true list: [abc abe abd] allEqual? false ascending? false
AWK
<lang AWK>
- syntax: GAWK -f COMPARE_A_LIST_OF_STRINGS.AWK
BEGIN {
main("AA,BB,CC")
main("AA,AA,AA")
main("AA,CC,BB")
main("AA,ACB,BB,CC")
main("single_element")
exit(0)
} function main(list, arr,i,n,test1,test2) {
test1 = 1 # elements are identical
test2 = 1 # elements are in ascending order
n = split(list,arr,",")
printf("\nlist:")
for (i=1; i<=n; i++) {
printf(" %s",arr[i])
if (i > 1) {
if (arr[i-1] != arr[i]) {
test1 = 0 # elements are not identical
}
if (arr[i-1] >= arr[i]) {
test2 = 0 # elements are not in ascending order
}
}
}
printf("\n%d\n%d\n",test1,test2)
} </lang>
- Output:
list: AA BB CC 0 1 list: AA AA AA 1 0 list: AA CC BB 0 0 list: AA ACB BB CC 0 1 list: single_element 1 1
BQN
If grade up matches grade down, then all elements are equal.
If all are not equal and the list is invariant under sorting, then it is in ascending order. <lang bqn>AllEq ← ⍋≡⍒ Asc ← ¬∘AllEq∧∧≡⊢
•Show AllEq ⟨"AA", "AA", "AA", "AA"⟩ •Show Asc ⟨"AA", "AA", "AA", "AA"⟩
•Show AllEq ⟨"AA", "ACB", "BB", "CC"⟩ •Show Asc ⟨"AA", "ACB", "BB", "CC"⟩</lang> <lang bqn>1 0 0 1</lang>
Bracmat
Some explanation of the tests:
test1 and test2 are functions that return their input, but, more importantly, either succeed or fail.
first and x are local variables in test1 and test2, respectively.
The bodies of the two functions consist of pattern matching operations that either succeed or fail. The pattern matching operator is the colon :. This operator, like all Bracmat's operators, is binary. The operand on the left hand side is the subject, the operand on the right hand side is the pattern.
The symbols ?, !, %, @, >, and ~ are prefixes.
? when prefixed to a symbol like first or x, makes the symbol a variable that receives the value of the subject or of part of te subject, without constraining what can be received. When prefixed to a zero length symbol (the empty string), it matches anything, like a wildcard.
! when prefixed to a symbol like first or x, evaluates to the value that was bound to the symbol. So it complements the ? prefix. A symbol is a variable if and only if it is prefixed with ? or !.
% is a prefix that modifies a pattern component such that it can match one or more elements from the subject. So it is more restrictive than ?.
@ is a prefix that modifies a pattern component such that it can match zero or one elements from the subject. So it is (much) more restrictive than ?. The combination %@ means: this subpattern can only match exactly one element.
> is a prefix that modifies a pattern component to only match values that are greater than the value of the pattern component.
~ is a prefix used to negate what comes after it. In test1, the first ~ negates the outcome of a pattern matching operation. In the subpattern ~!first it says: match anything that is not the value of !first. In ~>!x it is negates the prefix >. Together, ~> means: "not greater than" or, equivalently, "less than or equal to".
If a pattern match operator occurs inside a pattern as in %@:~>!x, then both operands are patterns. So this expression is to be read as:"match exactly one element of the subject and require that it is less than or equal to the value of x".
In words, the tests do the following: test1 assigns the first element of the argument to the "first" and then looks for another element that is not equal to "first". If the search succeeds, test1 fails and if the search fails, test1 succeeds. Test2 searches for two consecutive elements where the second element is not greater than the first elemnt. If the search succeeds, test2 fails and if the search fails, test2 succeeds.
<lang Bracmat> (test1=first.~(!arg:%@?first ? (%@:~!first) ?))
& (test2=x.~(!arg:? %@?x (%@:~>!x) ?))</lang>
Demonstration <lang Bracmat>( ( lstA
. isiZulu
isiXhosa
isiNdebele
Xitsonga
Tshivenda
Setswana
"Sesotho sa Leboa"
Sesotho
English
Afrikaans
)
( lstB
. Afrikaans
English
Sesotho
"Sesotho sa Leboa"
Setswana
Tshivenda
Xitsonga
isiNdebele
isiXhosa
isiZulu
)
( lstC
. alpha
alpha
alpha
alpha
alpha
alpha
alpha
alpha
alpha
alpha
)
: ?lists
& map
$ ( (
= name list
. !arg:(?name.?list)
& out
$ ( test1
!name
(test1$!list&succeeds|fails)
)
& out
$ ( test2
!name
(test2$!list&succeeds|fails)
)
)
. !lists
)
) </lang> Output
test1 lstA fails test2 lstA fails test1 lstB fails test2 lstB succeeds test1 lstC succeeds test2 lstC fails
C
<lang c>#include <stdbool.h>
- include <string.h>
static bool strings_are_equal(const char **strings, size_t nstrings) {
for (size_t i = 1; i < nstrings; i++)
if (strcmp(strings[0], strings[i]) != 0)
return false;
return true;
}
static bool strings_are_in_ascending_order(const char **strings, size_t nstrings) {
for (size_t i = 1; i < nstrings; i++)
if (strcmp(strings[i - 1], strings[i]) >= 0)
return false;
return true;
}</lang>
C#
<lang csharp>public static (bool lexicallyEqual, bool strictlyAscending) CompareAListOfStrings(List<string> strings) =>
strings.Count < 2 ? (true, true) :
(
strings.Distinct().Count() < 2,
Enumerable.Range(1, strings.Count - 1).All(i => string.Compare(strings[i-1], strings[i]) < 0)
);</lang>
C++
Assuming that the strings variable is of type T<std::string> where T is an ordered STL container such as std::vector:
<lang cpp>#include <algorithm>
- include <string>
// Bug: calling operator++ on an empty collection invokes undefined behavior. std::all_of( ++(strings.begin()), strings.end(),
[&](std::string a){ return a == strings.front(); } ) // All equal
std::is_sorted( strings.begin(), strings.end(),
[](std::string a, std::string b){ return !(b < a); }) ) // Strictly ascending</lang>
Clojure
Used similar approach as the Python solution
<lang clojure>
- Checks if all items in strings list are equal (returns true if list is empty)
(every? (fn a nexta (= a nexta)) (map vector strings (rest strings))))
- Checks strings list is in ascending order (returns true if list is empty)
(every? (fn a nexta (<= (compare a nexta) 0)) (map vector strings (rest strings))))
</lang>
COBOL
<lang cobol> identification division.
program-id. CompareLists.
data division.
working-storage section.
78 MAX-ITEMS value 3.
77 i pic 9(2).
01 the-list.
05 list-items occurs MAX-ITEMS.
10 list-item pic x(3).
01 results.
05 filler pic 9(1).
88 equal-strings value 1 when set to false is 0.
05 filler pic 9(1).
88 ordered-strings value 1 when set to false is 0.
procedure division.
main.
move "AA BB CC" to the-list
perform check-list
move "AA AA AA" to the-list
perform check-list
move "AA CC BB" to the-list
perform check-list
move "AA ACBBB CC" to the-list
perform check-list
move "AA" to the-list
perform check-list
stop run
.
check-list.
display "list:"
set equal-strings to true
set ordered-strings to true
perform varying i from 1 by 1 until i > MAX-ITEMS
if list-item(i) <> spaces
display function trim(list-item(i)), " " no advancing
if i < MAX-ITEMS and list-item(i + 1) <> spaces
if list-item(i + 1) <> list-item(i)
set equal-strings to false
end-if
if list-item(i + 1) <= list-item(i)
set ordered-strings to false
end-if
end-if
end-if
end-perform
display " "
if equal-strings
display "... is lexically equal"
else
display "... is not lexically equal"
end-if
if ordered-strings
display "... is in strict ascending order"
else
display "... is not in strict ascending order"
end-if
display " "
.</lang>
- Output:
list: AA BB CC ... is not lexically equal ... is in strict ascending order list: AA AA AA ... is lexically equal ... is not in strict ascending order list: AA CC BB ... is not lexically equal ... is not in strict ascending order list: AA ACB BB ... is not lexically equal ... is in strict ascending order list: AA ... is lexically equal ... is in strict ascending order
Common Lisp
<lang Lisp> (defun strings-equal-p (strings)
(null (remove (first strings) (rest strings) :test #'string=)))
(defun strings-ascending-p (strings)
(loop for string1 = (first strings) then string2
for string2 in (rest strings)
always (string-lessp string1 string2)))
</lang>
D
<lang d>void main() {
import std.stdio, std.algorithm, std.range, std.string;
foreach (const strings; ["AA AA AA AA", "AA ACB BB CC"].map!split) {
strings.writeln;
strings.zip(strings.dropOne).all!(ab => ab[0] == ab[1]).writeln;
strings.zip(strings.dropOne).all!(ab => ab[0] < ab[1]).writeln;
writeln;
}
}</lang>
- Output:
["AA", "AA", "AA", "AA"] true false ["AA", "ACB", "BB", "CC"] false true
Delphi
<lang Delphi> program Compare_a_list_of_strings;
{$APPTYPE CONSOLE}
uses
System.SysUtils;
type
// generic alias for use helper. The "TArray<string>" will be work too TListString = TArray<string>;
TListStringHelper = record helper for TListString function AllEqual: boolean; function AllLessThan: boolean; function ToString: string; end;
{ TListStringHelper }
function TListStringHelper.AllEqual: boolean; begin
Result := True; if Length(self) < 2 then exit;
var first := self[0];
for var i := 1 to High(self) do
if self[i] <> first then
exit(False);
end;
function TListStringHelper.AllLessThan: boolean; begin
Result := True; if Length(self) < 2 then exit;
var last := self[0];
for var i := 1 to High(self) do
begin
if not (last < self[i]) then
exit(False);
last := self[i];
end;
end;
function TListStringHelper.ToString: string; begin
Result := '[';
Result := Result + string.join(', ', self);
Result := Result + ']';
end;
var
lists: TArray<TArray<string>>;
begin
lists := [['a'], ['a', 'a'], ['a', 'b']];
for var list in lists do
begin
writeln(list.ToString);
writeln('Is AllEqual: ', list.AllEqual);
writeln('Is AllLessThan: ', list.AllLessThan, #10);
end;
readln;
end.</lang>
- Output:
[a] Is AllEqual: TRUE Is AllLessThan: TRUE [a, a] Is AllEqual: TRUE Is AllLessThan: FALSE [a, b] Is AllEqual: FALSE Is AllLessThan: TRUE
Dyalect
<lang Dyalect>func isSorted(xs) {
var prev
for x in xs {
if prev && !(x > prev) {
return false
}
prev = x
}
true
}
func isEqual(xs) {
var prev
for x in xs {
if prev && x != prev {
return false
}
prev = x
}
true
}</lang>
Elena
ELENA 5.0 : <lang elena>import system'collections; import system'routines; import extensions;
extension helper {
isEqual()
= nil == self.seekEach(self.FirstMember, (n,m => m.equal:n.Inverted ));
isAscending()
{
var former := self.enumerator();
var later := self.enumerator();
later.next();
^ nil == former.zipBy(later, (prev,next => next <= prev )).seekEach:(b => b)
}
}
testCases
= new string[][]{
new string[]{"AA","BB","CC"},
new string[]{"AA","AA","AA"},
new string[]{"AA","CC","BB"},
new string[]{"AA","ACB","BB","CC"},
new string[]{"single_element"}};
public program() {
testCases.forEach:(list)
{
console.printLine(list.asEnumerable()," all equal - ",list.isEqual());
console.printLine(list.asEnumerable()," ascending - ",list.isAscending())
};
console.readChar()
}</lang>
- Output:
AA,BB,CC all equal - false AA,BB,CC ascending - true AA,AA,AA all equal - true AA,AA,AA ascending - false AA,CC,BB all equal - false AA,CC,BB ascending - false AA,ACB,BB,CC all equal - false AA,ACB,BB,CC ascending - true single_element all equal - true single_element ascending - true
Elixir
<lang elixir>defmodule RC do
def compare_strings(strings) do
{length(Enum.uniq(strings))<=1, strict_ascending(strings)}
end
defp strict_ascending(strings) when length(strings) <= 1, do: true
defp strict_ascending([first, second | _]) when first >= second, do: false
defp strict_ascending([_, second | rest]), do: strict_ascending([second | rest])
end
lists = [ ~w(AA AA AA AA), ~w(AA ACB BB CC), ~w(AA CC BB), [], ["XYZ"] ] Enum.each(lists, fn list ->
IO.puts "#{inspect RC.compare_strings(list)}\t<= #{inspect list} "
end)</lang>
- Output:
{true, false} <= ["AA", "AA", "AA", "AA"]
{false, true} <= ["AA", "ACB", "BB", "CC"]
{false, false} <= ["AA", "CC", "BB"]
{true, true} <= []
{true, true} <= ["XYZ"]
Erlang
<lang erlang> -module(compare_strings).
-export([all_equal/1,all_incr/1]).
all_equal(Strings) -> all_fulfill(fun(S1,S2) -> S1 == S2 end,Strings).
all_incr(Strings) -> all_fulfill(fun(S1,S2) -> S1 < S2 end,Strings).
all_fulfill(Fun,Strings) -> lists:all(fun(X) -> X end,lists:zipwith(Fun, lists:droplast(Strings), tl(Strings)) ). </lang>
F#
<lang fsharp>let allEqual strings = Seq.isEmpty strings || Seq.forall (fun x -> x = Seq.head strings) (Seq.tail strings) let ascending strings = Seq.isEmpty strings || Seq.forall2 (fun x y -> x < y) strings (Seq.tail strings)</lang>
Actually allEqual is a shortcut and ascending is a general pattern. We can make a function
out of it which constructs a new function from a comparision function
<lang fsharp>let (!) f s = Seq.isEmpty s || Seq.forall2 f s (Seq.tail s)</lang>
and define the 2 task functions that way
<lang fsharp>let allEqual = !(=) let ascending = !(<)</lang>
getting something similar as the builtin in Raku
Factor
Assuming the list is on top of the data stack, testing for lexical equality: <lang factor>USE: grouping all-equal?</lang> Testing for ascending order: <lang factor>USING: grouping math.order ; [ before? ] monotonic?</lang>
Forth
Raw Forth
Note: This will work under some ANS-Forth systems. It assumes that WORD stores its string at HERE --- this isn't guaranteed by ANS-Forth.
Raw Forth is a very low level language and has no Native lists so we have to build from scratch. Remarkably by concatenating these low level operations and using the simple Forth parser we can build the linked lists of strings and the list operators quite simply. The operators and lists that we create become extensions to the language. <lang forth>\ linked list of strings creators
- ," ( -- ) [CHAR] " WORD c@ 1+ ALLOT ; \ Parse input stream until " and write into next available memory
- [[ ( -- ) 0 C, ; \ begin a list. write a 0 into next memory byte (null string)
- ]] ( -- ) [[ ; \ end list with same null string
- nth ( n list -- addr) swap 0 do count + loop ; \ return address of the Nth item in a list
- items ( list -- n ) \ return the number of items in a list
0 >R
BEGIN
COUNT + DUP
R> 1+ >R
0= UNTIL
DROP
R> 1- ;
- compare$ ( $1 $2 -- -n|0|n ) count rot count compare ; \ compare is an ANS Forth word. returns 0 if $1=$2
- compare[] ( list n1 n2 -- flag) \ compare items n1 and n2 in list
ROT dup >R nth ( -- $1)
swap r> nth ( -- $1 $2)
compare$ ;
\ create our lexical operators
- LEX= ( list -- flag)
0 \ place holder for the flag
over items 1
DO
over I I 1+ compare[] + \ we sum the comparison results on the stack
LOOP
nip 0= ;
- LEX< ( list -- flag)
0 \ place holder for the flag
over items 1
DO
over I I 1+ compare[] 0< NOT +
LOOP
nip 0= ;
\ make some lists create strings ," ENTRY 4" ," ENTRY 3" ," ENTRY 2" ," ENTRY 1" create strings2 ," the same" ," the same" ," the same" create strings3 ," AAA" ," BBB" ," CCC" ," DDD" </lang>
Test at the Forth console (-1 is the result for TRUE)
- Output:
STRINGS lex= . 0 ok STRINGS2 lex= . -1 ok STRINGS3 lex= . 0 ok STRINGS lex< . 0 ok STRINGS2 lex< . 0 ok STRINGS3 lex< . -1 ok
novice-package
This depends upon having the novice-package available --- the novice-package is ANS-Forth, as is this code.
I don't think it is a good idea to write "Raw Forth" as described above. Application code is hard to write and hard to read when low-level code is mixed in with application code. It is better to hide low-level code in general-purpose code-libraries so that the application code can be simple. Here is my solution using LIST.4TH from my novice-package: http://www.forth.org/novice.html <lang forth>
- test-equality ( string node -- new-string bad? )
over count \ -- string node adr cnt rot .line @ count compare ;
- test-ascending ( string node -- new-string bad? )
.line @ >r count r@ count compare -1 <> \ -- bad? r> swap ;
- test-seq { seq 'test -- flag } \ 'TEST picture: string node -- new-string bad?
seq length 2 < if true exit then
seq .line @ seq 2nd 'test find-node
nip 0= ;
</lang> Here is a test of the above code:
- Output:
(( c" aaa" new-seq >> c" aaa" new-seq >> c" aaa" new-seq )) drop ok-1 dup ' test-equality test-seq . -1 ok-1 kill-seq ok (( c" aaa" new-seq >> c" bbb" new-seq >> c" aaa" new-seq )) drop ok-1 dup ' test-equality test-seq . 0 ok-1 kill-seq ok (( c" aaa" new-seq >> c" bbb" new-seq >> c" ccc" new-seq )) drop ok-1 dup ' test-ascending test-seq . -1 ok-1 kill-seq ok (( c" aaa" new-seq >> c" bbb" new-seq >> c" aaa" new-seq )) drop ok-1 dup ' test-ascending test-seq . 0 ok-1 kill-seq ok
Fortran
Fortran does not offer a "string" item, which is to say, a sequence of items plus the length as one entity as in Pascal, among others. It does offer a CHARACTER variable, having some specified number of characters so the usual approach is to choose a length that is "long enough". In character comparisons, trailing spaces are ignored so that "xx" and "xx " are deemed equal. Similarly, it does not offer a list-of-thingies item, so again the usual approach is to provide an array of a size "long enough". One could develop a scheme with auxiliary counters stating how many elements are in use and so forth, but for this example, the parameterisation will do. Inspection of such arrays of character entities requires explicit DO-loops and IF-statements, and functions ALLINORDER and ALLEQUAL could be devised. Earlier Fortrans (prior to 77) lack a CHARACTER type, and so one must struggle with integer arrays.
Later Fortran (90 et seq) offers the special function ALL (and its associate, ANY) for testing multiple logical expressions, and also syntax allowing multiple elements of an array to be specified, as in A(3:7) to access elements 3, 4, 5, 6, 7 of array A. The ALL function has the special feature that if no logical expressions exist, then they, er, ... all ... are true and the result of ALL(nothing) is true. Well, none of them are false... Whatever the rationalisations this delivers the required result when the list has but one element and so there are no pairs to produce logical expressions, so, none of them are false, so the result is true, as specified.
On the other hand a function such as ALLINORDER would show the sound of one hand clapping. It would also reveal the order in which comparisons were made, and whether the loop would quit on the first failure or blockheadedly slog on through the lot regardless. Alas, on these questions the documentation for ALL is suspiciously silent.
<lang Fortran>
INTEGER MANY,LONG
PARAMETER (LONG = 6,MANY = 4) !Adjust to suit.
CHARACTER*(LONG) STRINGS(MANY) !A list of text strings.
STRINGS(1) = "Fee"
STRINGS(2) = "Fie"
STRINGS(3) = "Foe"
STRINGS(4) = "Fum"
IF (ALL(STRINGS(1:MANY - 1) .LT. STRINGS(2:MANY))) THEN
WRITE (6,*) MANY," strings: strictly increasing in order."
ELSE
WRITE (6,*) MANY," strings: not strictly increasing in order."
END IF
IF (ALL(STRINGS(1:MANY - 1) .EQ. STRINGS(2:MANY))) THEN
WRITE (6,*) MANY," strings: all equal."
ELSE
WRITE (6,*) MANY," strings: not all equal."
END IF
END
</lang>
And yes, if MANY is set to one and the extra texts are commented out, the results are both true, and ungrammatical statements are made. Honest. Possibly, another special function, as in COUNT(STRINGS(1:MANY - 1) .LT. STRINGS(2:MANY))) would involve less one-hand-clapping when there are no comparisons to make, but the production of a report that would use it is not in the specification.
F2003-F2008
F2008 standard ([ISO 2010], 4.4.3) defines the character variable of the character type as a set of values composed of character strings and a character string is a sequence of characters, numbered from left to right 1, 2, 3, ... up to the number of characters in the string. The number of characters in the string is called the length of the string. The length is a type parameter; its kind is processor dependent and its value is greater than or equal to zero. I.e in declaration <lang Fortran>
character (len=12) :: surname
</lang> keyword len is NOT a size of array, it is an intrinsic parameter of character type, and character type is in fortran a first-class type: they can be assigned as objects or passed as parameters to a subroutine.
In summary, the character data type in Fortran is a real, first class data type. Fortran character strings are not hacked-up arrays! <lang Fortran> program compare_char_list
implicit none
character(len=6), allocatable, dimension(:) :: ss
integer :: many
ss = ["Fee","Fie","Foe","Fum"]
many = size(ss)
if (all(ss(1:many - 1) .lt. ss(2:many))) then
write (*,*) many," strings: strictly increasing in order."
else
write (*,*) many," strings: not strictly increasing in order."
end if
if (all(ss(1:many - 1) .eq. ss(2:many))) then
write (*,*) many," strings: all equal."
else
write (*,*) many," strings: not all equal."
end if
end program compare_char_list </lang>
FreeBASIC
<lang freebasic> ' FB 1.05.0 Win64
Function AllEqual(strings() As String) As Boolean
Dim length As Integer = UBound(strings) - LBound(strings) + 1
If length < 2 Then Return False
For i As Integer = LBound(strings) + 1 To UBound(strings)
If strings(i - 1) <> strings(i) Then Return False
Next
Return True
End Function
Function AllAscending(strings() As String) As Boolean
Dim length As Integer = UBound(strings) - LBound(strings) + 1
If length < 2 Then Return False
For i As Integer = LBound(strings) + 1 To UBound(strings)
If strings(i - 1) >= strings(i) Then Return False
Next
Return True
End Function </lang>
Fōrmulæ
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.
Programs in Fōrmulæ are created/edited online in its website, However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
In this page you can see the program(s) related to this task and their results.
Go
<lang go>package cmp
func AllEqual(strings []string) bool { for _, s := range strings { if s != strings[0] { return false } } return true }
func AllLessThan(strings []string) bool { for i := 1; i < len(strings); i++ { if !(strings[i - 1] < s) { return false } } return true }</lang> See Compare_a_list_of_strings/GoTests for validation tests.
Note also there is the function sort.StringsAreSorted in the Go standard library. This function tests that the list is ordered by less than or equal to, but not strictly less than.
Gosu
<lang gosu>var list = {"a", "b", "c", "d"}
var isHomogeneous = list.toSet().Count < 2 var isOrderedSet = list.toSet().order().toList() == list</lang>
Haskell
<lang haskell>allEqual :: Eq a => [a] -> Bool allEqual xs = and $ zipWith (==) xs (tail xs)
allIncr :: Ord a => [a] -> Bool allIncr xs = and $ zipWith (<) xs (tail xs)</lang>
Alternatively, using folds:
<lang haskell>allEqual
:: Eq a => [a] -> Bool
allEqual [] = True allEqual (h:t) = foldl (\a x -> a && x == h) True t
allIncreasing
:: Ord a => [a] -> Bool
allIncreasing [] = True allIncreasing (h:t) = fst $ foldl (\(a, x) y -> (a && x < y, y)) (True, h) t</lang>
or seeking earlier exit (from longer lists) with until, but in fact, perhaps due to lazy execution, the zipWith at the top performs best.
<lang haskell>allEq
:: Eq a => [a] -> Bool
allEq [] = True allEq (h:t) =
null . snd $ until (\(x, xs) -> null xs || x /= head xs) (\(_, x:xs) -> (x, xs)) (h, t)
allInc
:: Ord a => [a] -> Bool
allInc [] = True allInc (h:t) =
null . snd $ until (\(x, xs) -> null xs || x >= head xs) (\(_, x:xs) -> (x, xs)) (h, t)</lang>
Icon and Unicon
Icon and Unicon expressions either succeed and return a value (which may be &null) or fail.
<lang unicon>#
- list-compare.icn
link fullimag
procedure main()
L1 := ["aa"] L2 := ["aa", "aa", "aa"] L3 := ["", "aa", "ab", "ac"] L4 := ["aa", "bb", "cc"] L5 := ["cc", "bb", "aa"]
every L := (L1 | L2 | L3 | L4 | L5) do {
writes(fullimage(L))
writes(": equal ")
writes(if allequal(L) then "true" else "false")
writes(", ascending ")
write(if ascending(L) then "true" else "false")
}
end
- test for all identical
procedure allequal(L)
if *L < 2 then return
a := L[1]
every b := L[2 to *L] do {
if a ~== b then fail
a := b
}
return
end
- test for strictly ascending
procedure ascending(L)
if *L < 2 then return
a := L[1]
every b := L[2 to *L] do {
if a >>= b then fail
a := b
}
return
end</lang>
- Output:
prompt$ unicon -s list-compare.icn -x ["aa"]: equal true, ascending true ["aa","aa","aa"]: equal true, ascending false ["","aa","ab","ac"]: equal false, ascending true ["aa","bb","cc"]: equal false, ascending true ["cc","bb","aa"]: equal false, ascending false
J
Solution (equality test):<lang j> allEq =: 1 = +/@~: NB. or 1 = #@:~. or -: 1&|. or }.-:}:</lang> Solution (order test):<lang j> asc =: /: -: i.@# NB. or -: (/:~) etc.</lang> Notes: asc indicates whether y is monotonically increasing, but not necessarily strictly monotonically increasing (in other words, it allows equal elements if they are adjacent to each other).
Java
<lang java5>import java.util.Arrays;
public class CompareListOfStrings {
public static void main(String[] args) {
String[][] arr = {{"AA", "AA", "AA", "AA"}, {"AA", "ACB", "BB", "CC"}};
for (String[] a : arr) {
System.out.println(Arrays.toString(a));
System.out.println(Arrays.stream(a).distinct().count() < 2);
System.out.println(Arrays.equals(Arrays.stream(a).distinct().sorted().toArray(), a));
}
}
}</lang>
- Output:
[AA, AA, AA, AA] true false [AA, ACB, BB, CC] false true
JavaScript
ES5
Iterative
<lang JavaScript>function allEqual(a) {
var out = true, i = 0;
while (++i<a.length) {
out = out && (a[i-1] === a[i]);
} return out;
}
function azSorted(a) {
var out = true, i = 0;
while (++i<a.length) {
out = out && (a[i-1] < a[i]);
} return out;
}
var e = ['AA', 'AA', 'AA', 'AA'], s = ['AA', 'ACB', 'BB', 'CC'], empty = [], single = ['AA']; console.log(allEqual(e)); // true console.log(allEqual(s)); // false console.log(allEqual(empty)); // true console.log(allEqual(single)); // true console.log(azSorted(e)); // false console.log(azSorted(s)); // true console.log(azSorted(empty)); // true console.log(azSorted(single)); // true </lang>
ES6
Functional
Using a generic zipWith, and functionally composed predicates: <lang JavaScript>(() => {
'use strict';
// allEqual :: [String] -> Bool let allEqual = xs => and(zipWith(equal, xs, xs.slice(1))),
// azSorted :: [String] -> Bool
azSorted = xs => and(zipWith(azBefore, xs, xs.slice(1))),
// equal :: a -> a -> Bool
equal = (a, b) => a === b,
// azBefore :: String -> String -> Bool
azBefore = (a, b) => a.toLowerCase() <= b.toLowerCase();
// GENERIC
// and :: [Bool] -> Bool let and = xs => xs.reduceRight((a, x) => a && x, true),
// zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith = (f, xs, ys) => {
let ny = ys.length;
return (xs.length <= ny ? xs : xs.slice(0, ny))
.map((x, i) => f(x, ys[i]));
};
// TEST
let lists = [
['isiZulu', 'isiXhosa', 'isiNdebele', 'Xitsonga',
'Tshivenda', 'Setswana', 'Sesotho sa Leboa', 'Sesotho',
'English', 'Afrikaans'
],
['Afrikaans', 'English', 'isiNdebele', 'isiXhosa',
'isiZulu', 'Sesotho', 'Sesotho sa Leboa', 'Setswana',
'Tshivenda', 'Xitsonga',
],
['alpha', 'alpha', 'alpha', 'alpha', 'alpha', 'alpha',
'alpha', 'alpha', 'alpha', 'alpha', 'alpha', 'alpha'
]
];
return {
allEqual: lists.map(allEqual),
azSorted: lists.map(azSorted)
};
})();</lang>
- Output:
<lang JavaScript>{
"allEqual": [ false, false, true ], "azSorted": [ false, true, true ]
}</lang>
jq
For both the following functions, the input is assumed to be a (possibly empty) array of strings. In both cases also, the implementations are fast but could be improved at the expense of complexity. <lang jq># Are the strings all equal? def lexically_equal:
. as $in
| reduce range(0;length-1) as $i
(true; if . then $in[$i] == $in[$i + 1] else false end);
- Are the strings in strictly ascending order?
def lexically_ascending:
. as $in
| reduce range(0;length-1) as $i
(true; if . then $in[$i] < $in[$i + 1] else false end);</lang>
Examples: <lang jq>[] | lexically_equal #=> true</lang> <lang jq>["a", "ab"] | lexically_ascending #=> true</lang>
Jsish
Code from Javascript, ES5.
<lang javascript>/* Compare list of strings, in Jsish */ function allEqual(a) {
var out = true, i = 0;
while (++i<a.length) {
out = out && (a[i-1] === a[i]);
} return out;
}
function allAscending(a) {
var out = true, i = 0;
while (++i<a.length) {
out = out && (a[i-1] < a[i]);
} return out;
}
if (allEqual(strings)) puts("strings array all equal"); else puts("strings array not all equal");
if (allAscending(strings)) puts("strings array in strict ascending order"); else puts("strings array not in strict ascending order");</lang>
- Output:
None, task requirement asks for an assumed preloaded strings array, no full program, and little other distractions.
Julia
<lang julia>allequal(arr::AbstractArray) = isempty(arr) || all(x -> x == first(arr), arr)
test = [["RC", "RC", "RC"], ["RC", "RC", "Rc"], ["RA", "RB", "RC"],
["RC"], String[], ones(Int64, 4), 1:4]
for v in test
println("\n# Testing $v:")
println("The elements are $("not " ^ !allequal(v))all equal.")
println("The elements are $("not " ^ !issorted(v))strictly increasing.")
end</lang>
- Output:
# Testing String["RC", "RC", "RC"]: The elements are all equal. The elements are strictly increasing. # Testing String["RC", "RC", "Rc"]: The elements are not all equal. The elements are strictly increasing. # Testing String["RA", "RB", "RC"]: The elements are not all equal. The elements are strictly increasing. # Testing String["RC"]: The elements are all equal. The elements are strictly increasing. # Testing String[]: The elements are all equal. The elements are strictly increasing. # Testing [1, 1, 1, 1]: The elements are all equal. The elements are strictly increasing. # Testing 1:4: The elements are not all equal. The elements are strictly increasing.
Klong
<lang K>
{:[2>#x;1;&/=:'x]}:(["test" "test" "test"])
1
{:[2>#x;1;&/<:'x]}:(["bar" "baz" "foo"])
1 </lang>
Kotlin
<lang scala>// version 1.0.6
fun areEqual(strings: Array<String>): Boolean {
if (strings.size < 2) return true
return (1 until strings.size).all { strings[it] == strings[it - 1] }
}
fun areAscending(strings: Array<String>): Boolean {
if (strings.size < 2) return true
return (1 until strings.size).all { strings[it] > strings[it - 1] }
}
// The strings are given in the command line arguments
fun main(args: Array<String>) {
println("The strings are : ${args.joinToString()}")
if (areEqual(args)) println("They are all equal")
else if (areAscending(args)) println("They are in strictly ascending order")
else println("They are neither equal nor in ascending order")
}</lang> Sample input/output:
- Output:
The strings are : first, second, third They are in strictly ascending order
Lambdatalk
<lang scheme> {def allsame
{def allsame.r
{lambda {:s :n :i}
{if {= :i :n}
then true
else {if {not {W.equal? {A.get :i :s} {A.get 0 :s}}}
then false
else {allsame.r :s :n {+ :i 1}} }}}}
{lambda {:s}
{allsame.r :s {- {A.length :s} 1} 0} }}
-> allsame
{def strict_order
{def strict_order.r
{lambda {:s :n :i}
{if {= :i :n}
then true
else {if {W.inforequal? {A.get :i :s} {A.get {- :i 1} :s}}
then false
else {strict_order.r :s :n {+ :i 1}}}} }}
{lambda {:s}
{if {= {A.length :s} 1}
then true
else {strict_order.r :s {A.length :s} 1} }}}
-> strict_order
{S.map allsame
{A.new AA BB CC}
{A.new AA AA AA}
{A.new AA CC BB}
{A.new AA ACB BB CC}
{A.new single}
} -> false true false false true
{S.map strict_order
{A.new AA BB CC}
{A.new AA AA AA}
{A.new AA CC BB}
{A.new AA ACB BB CC}
{A.new single}
} -> true false false true true
</lang>
Lua
<lang lua>function identical(t_str)
_, fst = next(t_str)
if fst then
for _, i in pairs(t_str) do
if i ~= fst then return false end
end
end
return true
end
function ascending(t_str)
prev = false
for _, i in ipairs(t_str) do
if prev and prev >= i then return false end
prev = i
end
return true
end
function check(str)
t_str = {}
for i in string.gmatch(str, "[%a_]+") do
table.insert(t_str, i)
end
str = str .. ": "
if not identical(t_str) then str = str .. "not " end
str = str .. "identical and "
if not ascending(t_str) then str = str .. "not " end
print(str .. "ascending.")
end
check("ayu dab dog gar panda tui yak") check("oy oy oy oy oy oy oy oy oy oy") check("somehow somewhere sometime") check("Hoosiers") check("AA,BB,CC") check("AA,AA,AA") check("AA,CC,BB") check("AA,ACB,BB,CC") check("single_element")</lang>
- Output:
ayu dab dog gar panda tui yak: not identical and ascending. oy oy oy oy oy oy oy oy oy oy: identical and not ascending. somehow somewhere sometim: not identical and not ascending. Hoosiers: identical and ascending. AA,BB,CC: not identical and ascending. AA,AA,AA: identical and not ascending. AA,CC,BB: not identical and not ascending. AA,ACB,BB,CC: not identical and ascending. single_element: identical and ascending.
M2000 Interpreter
<lang M2000 Interpreter> Module CheckIt {
Function Equal(Strings){
k=Each(Strings, 2, -1)
a$=Array$(Strings, 0)
=True
While k {
=False
if a$<>array$(k) then exit
=True
}
}
Function LessThan(Strings){
=True
if len(Strings)<2 then exit
k=Each(Strings, 2)
a$=Array$(Strings, 0)
While k {
=False
if a$>=array$(k) then exit
a$=array$(k)
=True
}
}
Print Equal(("alfa","alfa","alfa", "alfa"))=True
Print Equal(("alfa",))=True
Dim A$(10)="alfa"
Print Equal(A$())=True
Print Equal(("alfa1","alfa2","alfa3", "alfa4"))=False
Print LessThan(("alfa1","alfa2","alfa3", "alfa4"))=True
Print LessThan(("alfa1",))=true
alfa$=Lambda$ k=1 ->{=String$("*", k) : k++}
Dim A$(20)<<alfa$()
Print LessThan(A$())=True
A$(5)=""
Print LessThan(A$())=False
} Checkit </lang>
Maple
<lang Maple>lexEqual := proc(lst) local i: for i from 2 to numelems(lst) do if lst[i-1] <> lst[i] then return false: fi: od: return true: end proc: lexAscending := proc(lst) local i: for i from 2 to numelems(lst) do if StringTools:-Compare(lst[i],lst[i-1]) then return false: fi: od: return true: end proc: tst := ["abc","abc","abc","abc","abc"]: lexEqual(tst): lexAscending(tst):</lang>
- Examples:
true false
Mathcad
Mathcad is a non-text-based programming environment. The expressions below are an approximations of the way that they are entered (and) displayed on a Mathcad worksheet. The worksheet is available at xxx_tbd_xxx
This particular version of "Compare a list of strings" was created in Mathcad Prime Express 7.0, a free version of Mathcad Prime 7.0 with restrictions (such as no programming or symbolics). All Mathcad numbers are complex doubles. There is a recursion depth limit of about 4,500. Strings are a distinct data and are not conceptually a list of integers.
<lang Mathcad>-- define list of list of strings (nested vector of vectors of strings) -- Mathcad vectors are single column arrays. -- The following notation is for convenience in writing arrays in text form. -- Mathcad array input is normally via Mathcad's array operator or via one of the -- array-builder functions, such as stack or augment. -- "," between vector elements indicates a new row. -- " " between vector elements indicates a new column.
list:=["AA","AA","AA"],["AA","BB","CC"],["AA","CC","BB"],["CC","BB","AA"],["AA","ACB","BB","CC"],["AA"]]
-- define functions head and rest that return the first value in a list (vector) -- and the list excluding the first element, respectively.
head(v):=if(IsArray(v),v[0,v) rest(v):=if(rows(v)>1,submatrix(v,1,rows(v)-1,0,0),0)
-- define a function oprel that iterates through a list (vector) applying a comparison operator op to each pair of elements at the top of the list. -- Returns immediately with false (0) if a comparison fails.
oprel(op,lst,val):=if(op(val,head(lst)),if(rows(lst)>1,oprel(op,rest(lst),head(lst)),1),0)
oprel(op,lst):=if(rows(lst)>1,oprel(op,rest(lst),head(lst)),1)
-- define a set of boolean comparison functions -- transpose represents Mathcad's transpose operator -- vectorize represents Mathcad's vectorize operator
eq(a,b):=a=b (transpose(vectorize(oprel,list))) = [1 0 0 0 0 1] -- equal lt(a,b):=a<b (transpose(vectorize(oprel,list))) = [0 1 0 0 1 1] -- ascending
-- oprel, eq and lt also work with numeric values
list:=[11,11,11],[11,22,33],[11,33,22],[33,22,11],[11,132,22,33],[11]] </lang>
Mathematica/Wolfram Language
<lang Mathematica>data1 = {"aaa", "aaa", "aab"}; Apply[Equal, data] OrderedQ[data]</lang>
- Output:
False True
MATLAB / Octave
Only the first task is implemented. <lang Matlab>alist = {'aa', 'aa', 'aa'} all(strcmp(alist,alist{1}))</lang>
Nanoquery
<lang Nanoquery>// a function to test if a list of strings are equal def stringsEqual(stringList) // if the list is empty, return true if (len(stringList) = 0) return true end
// otherwise get the first value and check for equality toCompare = stringList[0] equal = true for (i = 1) (equal && (i < len(stringList))) (i = i + 1) equal = (toCompare = stringList[i]) end for
// return whether the strings are equal or not
return equal
end
// a function to test if a list of strings are are less than each other def stringsLessThan(stringList) // if the list is empty, return true if (len(stringList) = 0) return true end
// otherwise get the first value and check for less than toCompare = stringList[0] lessThan = true for (i = 1) (lessThan && (i < len(stringList))) (i = i + 1) lessThan = (toCompare < stringList[i]) toCompare = stringList[i] end for
// return whether the string were less than each other or not return lessThan end</lang>
NetRexx
<lang NetRexx>/* NetRexx */ options replace format comments java crossref symbols nobinary
runSample(arg) return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ method isEqual(list = Rexx[]) public static binary returns boolean
state = boolean (1 == 1) -- default to true loop ix = 1 while ix < list.length state = list[ix - 1] == list[ix] if \state then leave ix end ix return state
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ method isAscending(list = Rexx[]) public static binary returns boolean
state = boolean (1 == 1) -- default to true loop ix = 1 while ix < list.length state = list[ix - 1] << list[ix] if \state then leave ix end ix return state
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ method runSample(arg) private static
samples = [ -
['AA', 'BB', 'CC'] -
, ['AA', 'AA', 'AA'] -
, ['AA', 'CC', 'BB'] -
, ['single_element'] -
]
loop ix = 0 while ix < samples.length
sample = samples[ix]
if isEqual(sample) then eq = 'elements are identical'
else eq = 'elements are not identical'
if isAscending(sample) then asc = 'elements are in ascending order'
else asc = 'elements are not in ascending order'
say 'List:' Arrays.toString(sample)
say ' 'eq
say ' 'asc
end ix
return
</lang>
- Output:
List: [AA, BB, CC] elements are not identical elements are in ascending order List: [AA, AA, AA] elements are identical elements are not in ascending order List: [AA, CC, BB] elements are not identical elements are not in ascending order List: [single_element] elements are identical elements are in ascending order
Nim
This is the obvious (and more efficient way) to compare strings in Nim:
<lang Nim> func allEqual(s: openArray[string]): bool =
for i in 1..s.high:
if s[i] != s[0]:
return false
result = true
func ascending(s: openArray[string]): bool =
for i in 1..s.high:
if s[i] <= s[i - 1]:
return false
result = true
doAssert allEqual(["abc", "abc", "abc"]) doAssert not allEqual(["abc", "abd", "abc"])
doAssert ascending(["abc", "abd", "abe"]) doAssert not ascending(["abc", "abe", "abd"])
doAssert allEqual(["abc"]) doAssert ascending(["abc"])</lang>
For “allEqual”, there is another simple way using template “allIt” from standard module “sequtils”:
<lang Nim>import sequtils
func allEqual(s: openArray[string]): bool =
allIt(s, it == s[0])
doAssert allEqual(["abc", "abc", "abc"]) doAssert not allEqual(["abc", "abd", "abc"]) doAssert allEqual(["abc"])</lang>
There are other less obvious and less efficient ways, using hash sets, sorting or “map” and “zip”.
OCaml
<lang Ocaml> open List;;
let analyze cmp l =
let rec analyze' l prevs = match l with [] -> true | [s] -> cmp prevs s | s::rest -> (cmp prevs s) && (analyze' rest s) in analyze' (List.tl l) (List.hd l)
let isEqual = analyze (=) ;; let isAscending = analyze (<) ;;
let test sample =
List.iter print_endline sample;
if (isEqual sample)
then (print_endline "elements are identical")
else (print_endline "elements are not identical");
if (isAscending sample)
then print_endline "elements are in ascending order"
else print_endline "elements are not in ascending order";;
let lasc = ["AA";"BB";"CC";"EE"];;
let leq = ["AA";"AA";"AA";"AA"];;
let lnoasc = ["AA";"BB";"EE";"CC"];;
List.iter test [lasc;leq;lnoasc];; </lang>
- Output:
AA BB CC EE elements are not identical elements are in ascending order AA AA AA AA elements are identical elements are not in ascending order AA BB EE CC elements are not identical elements are not in ascending order
Oforth
<lang oforth>: lexEqual asSet size 1 <= ;
- lexCmp(l) l l right( l size 1- ) zipWith(#<) and ;</lang>
ooRexx
<lang oorexx>/* REXX ---------------------------------------------------------------
- 28.06.2014 Walter Pachl
- --------------------------------------------------------------------*/
Call test 'ABC',.list~of('AA','BB','CC') Call test 'AAA',.list~of('AA','AA','AA') Call test 'ACB',.list~of('AA','CC','BB') Exit
test: Procedure Use Arg name,list all_equal=1 increasing=1 Do i=0 To list~items-2
i1=i+1
Select
When list[i1]==list[i] Then increasing=0
When list[i1]<<list[i] Then Do
all_equal=0
increasing=0
End
When list[i1]>>list[i] Then all_equal=0
End
End
Select
When all_equal Then Say 'List' name': all elements are equal' When increasing Then Say 'List' name': elements are in increasing order' Otherwise Say 'List' name': neither equal nor in increasing order' End
Return</lang>
- Output:
List ABC: elements are in increasing order List AAA: all elements are equal List ACB: neither equal nor in increasing order
PARI/GP
Easiest is to use Set():
<lang parigp>allEqual(strings)=#Set(strings)<2
inOrder(strings)=Set(strings)==strings</lang>
More efficient: <lang parigp>allEqual(strings)=for(i=2,#strings,if(strings[i]!=strings[i-1], return(0))); 1 inOrder(strings)=for(i=2,#strings,if(strings[i]>strings[i-1], return(0))); 1</lang>
Perl
<lang perl>use List::Util 1.33 qw(all);
all { $strings[0] eq $strings[$_] } 1..$#strings # All equal all { $strings[$_-1] lt $strings[$_] } 1..$#strings # Strictly ascending</lang>
Alternatively, if you can guarantee that the input strings don't contain null bytes, the equality test can be performed by a regex like this:
<lang perl>join("\0", @strings) =~ /^ ( [^\0]*+ ) (?: \0 \1 )* $/x # All equal</lang>
Phix
with javascript_semantics function allsame(sequence s) for i=2 to length(s) do if s[i]!=s[1] then return false end if end for return true end function function strict_order(sequence s) for i=2 to length(s) do if s[i]<=s[i-1] then return false end if end for return true end function procedure test(sequence s) printf(1,"%-22V allsame:%5t, strict_order:%5t\n",{s,allsame(s),strict_order(s)}) end procedure test({"AA","BB","CC"}) test({"AA","AA","AA"}) test({"AA","CC","BB"}) test({"AA","ACB","BB","CC"}) test({"single_element"})
- Output:
{"AA","BB","CC"} allsame:false, strict_order: true
{"AA","AA","AA"} allsame: true, strict_order:false
{"AA","CC","BB"} allsame:false, strict_order:false
{"AA","ACB","BB","CC"} allsame:false, strict_order: true
{"single_element"} allsame: true, strict_order: true
Phixmonti
<lang Phixmonti>include ..\Utilitys.pmt
( "alpha" "beta" "gamma" "delta" "epsilon" "zeta"
"eta" "theta" "iota" "kappa" "lambda" "mu" )
dup dup sort == /# put 0 (false) in the pile, indicating that they are not in ascending order #/
drop /# discard the result #/
dup len swap 1 get rot repeat == /# put 0 (false) in the pile, indicating that they are not repeated strings #/ </lang>
PicoLisp
PicoLisp has the native operators =, > and < these can take an infinite number of arguments and are also able to compare Transient symbols (the Strings of PicoLisp). <lang PicoLisp>(= "AA" "AA" "AA") -> T (= "AA" "AA" "Aa") -> NIL (< "AA" "AA") -> NIL (< "AA" "Aa") -> T (< "1" "A" "B" "Z" "c" ) -> T (> "A" "B" "Z" "C") -> NIL</lang> If you want a function which takes one list here are some straight-forward implementation: <lang PicoLisp> (de same (List)
(apply = List))
(de sorted (List)
(apply < List))
(de sorted-backwards (List)
(apply > List))
(same '("AA" "AA" "AA")) -> T </lang> This would of course also work with <= and >= without any hassle.
PL/I
<lang pli>*process source xref attributes or(!);
/*--------------------------------------------------------------------
* 01.07.2014 Walter Pachl
*-------------------------------------------------------------------*/
clist: Proc Options(main);
Dcl (hbound) Builtin;
Dcl sysprint Print;
Dcl abc(3) Char(2) Init('AA','BB','CC');
Dcl aaa(3) Char(2) Init('AA','AA','AA');
Dcl acb(3) Char(2) Init('AA','CC','BB');
Call test('ABC',ABC);
Call test('AAA',AAA);
Call test('ACB',ACB);
test: Procedure(name,x);
Dcl name Char(*);
Dcl x(*) Char(*);
Dcl (all_equal,increasing) Bit(1) Init('1'b);
Dcl (i,i1) Bin Fixed(31);
Dcl txt Char(50) Var;
Do i=1 To hbound(x)-1 While(all_equal ! increasing);
i1=i+1;
Select;
When(x(i1)=x(i)) increasing='0'b;
When(x(i1)<x(i)) Do;
increasing='0'b;
all_equal='0'b;
End;
Otherwise /* x(i1)>x(i) */
all_equal='0'b;
End;
End;
Select;
When(all_equal) txt='all elements are equal';
When(increasing) txt='elements are in increasing order';
Otherwise txt='neither equal nor in increasing order';
End;
Put Skip List(name!!': '!!txt);
End;
End;</lang>
- Output:
ABC: elements are in increasing order AAA: all elements are equal ACB: neither equal nor in increasing order
Plain English
<lang plainenglish>To decide if some string things are lexically equal: If the string things are empty, say yes. Get a string thing from the string things. Put the string thing's string into a canonical string. Loop. If the string thing is nil, say yes. If the string thing's string is not the canonical string, say no. Put the string thing's next into the string thing. Repeat.
To decide if some string things are in ascending order: If the string things' count is less than 2, say yes. Get a string thing from the string things. Put the string thing's next into the string thing. Loop. If the string thing is nil, say yes. If the string thing's string is less than the string thing's previous' string, say no. Put the string thing's next into the string thing. Repeat.</lang>
PowerShell
<lang PowerShell> function IsAscending ( [string[]]$Array ) { ( 0..( $Array.Count - 2 ) ).Where{ $Array[$_] -le $Array[$_+1] }.Count -eq $Array.Count - 1 } function IsEqual ( [string[]]$Array ) { ( 0..( $Array.Count - 2 ) ).Where{ $Array[$_] -eq $Array[$_+1] }.Count -eq $Array.Count - 1 }
IsAscending 'A', 'B', 'B', 'C' IsAscending 'A', 'C', 'B', 'C' IsAscending 'A', 'A', 'A', 'A'
IsEqual 'A', 'B', 'B', 'C' IsEqual 'A', 'C', 'B', 'C' IsEqual 'A', 'A', 'A', 'A' </lang>
- Output:
True False True False False True
Prolog
<lang Prolog>los(["AA","BB","CC"]). los(["AA","AA","AA"]). los(["AA","CC","BB"]). los(["AA","ACB","BB","CC"]). los(["single_element"]).
lexically_equal(S,S,S). in_order(G,L,G) :- compare(<,L,G).
test_list(List) :-
List = [L|T],
write('for list '), write(List), nl,
(foldl(lexically_equal, T, L, _)
-> writeln('The items in the list ARE lexically equal')
; writeln('The items in the list are NOT lexically equal')),
(foldl(in_order, T, L, _)
-> writeln('The items in the list ARE in ascending order')
; writeln('The items in the list are NOT in ascending order')),
nl.
test :- forall(los(List), test_list(List)).</lang>
- Output:
?- test. for list [AA,BB,CC] The items in the list are NOT lexically equal The items in the list ARE in ascending order for list [AA,AA,AA] The items in the list ARE lexically equal The items in the list are NOT in ascending order for list [AA,CC,BB] The items in the list are NOT lexically equal The items in the list are NOT in ascending order for list [AA,ACB,BB,CC] The items in the list are NOT lexically equal The items in the list ARE in ascending order for list [single_element] The items in the list ARE lexically equal The items in the list ARE in ascending order true.
PureBasic
<lang purebasic>EnableExplicit DataSection
Data.s ~"AA\tAA\tAA\nAA\tBB\tCC\nAA\tCC\tBB\nAA\tACB\tBB\tCC\nsingel_element"
EndDataSection
Macro PassFail(PF)
If PF : PrintN("Pass") : Else : PrintN("Fail") : EndIf
EndMacro
Macro ProcRec(Proc)
Define tf1$,tf2$ : Static chk.b : chk=#True tf1$=StringField(s$,c,tz$) : tf2$=StringField(s$,c+1,tz$) If Len(tf2$) : Proc(s$,tz$,c+1) : EndIf
EndMacro
Procedure.b IsStringsEqual(s$,tz$=~"\t",c.i=1)
ProcRec(IsStringsEqual) chk & Bool(tf1$=tf2$ Or tf2$="") ProcedureReturn chk
EndProcedure
Procedure.b IsStringsAscending(s$,tz$=~"\t",c.i=1)
ProcRec(IsStringsAscending) chk & Bool(tf1$<tf2$ Or tf2$="") ProcedureReturn chk
EndProcedure
Define t$,sf$,c.i,i.i,PF.b Read.s t$ : c=CountString(t$,~"\n") OpenConsole("Compare a list of Strings") For i=1 To c+1
sf$=StringField(t$,i,~"\n")
PrintN("List : "+sf$)
Print("Lexical test : ") : PassFail(IsStringsEqual(sf$))
Print("Ascending test : ") : PassFail(IsStringsAscending(sf$))
PrintN("")
Next Input()</lang>
- Output:
List : AA AA AA Lexical test : Pass Ascending test : Fail List : AA BB CC Lexical test : Fail Ascending test : Pass List : AA CC BB Lexical test : Fail Ascending test : Fail List : AA ACB BB CC Lexical test : Fail Ascending test : Pass List : singel_element Lexical test : Pass Ascending test : Pass
Python
A useful pattern is that when you need some function of an item in a list with its next item over possibly all items in the list then f(a, nexta) for a, nexta in zip(alist, alist[1:])) works nicely.
(Especially if an index is not needed elsewhere in the algorithm).
<lang python>all(a == nexta for a, nexta in zip(strings, strings[1:])) # All equal
all(a < nexta for a, nexta in zip(strings, strings[1:])) # Strictly ascending
len(set(strings)) == 1 # Concise all equal sorted(strings, reverse=True) == strings # Concise (but not particularly efficient) ascending </lang>
Equivalently, we can also use additional list arguments with map rather than zip,
and, if we wish, pass functional forms of standard operators to either of them:
<lang python>from operator import (eq, lt)
xs = ["alpha", "beta", "gamma", "delta", "epsilon", "zeta",
"eta", "theta", "iota", "kappa", "lambda", "mu"]
ys = ["alpha", "beta", "gamma", "delta", "epsilon", "zeta",
"eta", "theta", "iota", "kappa", "lambda", "mu"]
az = sorted(xs)
print (
all(map(eq, xs, ys)),
all(map(lt, xs, xs[1:])),
all(map(lt, az, az[1:]))
)</lang>
- Output:
True False True
Quackery
Idiomatically the strings would be stored in a nest which need not be named. The words allthesame and allinorder both take a nest of strings from the stack and return a boolean.
The word $> compares two strings using the QACSFOT lexical ordering. (QACSFOT - Quackery Arbitrary Character Sequence For Ordered Text. It is less arbitrary than the ASCII sequence.)
<lang Quackery> [ [ true swap
dup size 1 > while
behead swap
witheach
[ over != if
[ dip not conclude ] ] ]
drop ] is allthesame ( [ --> b )
[ [ true swap
dup size 1 > while
behead swap
witheach
[ tuck $> if
[ dip not conclude ] ] ]
drop ] is allinorder ( [ --> b )</lang>
R
Let's start with a function that splits a vector into sub-vectors; it starts a new vector whenever the comparison function yields false.
<lang R> chunks <- function (compare, xs) {
starts = which(c(T, !compare(head(xs, -1), xs[-1]), T))
lapply(seq(1,length(starts)-1),
function(i) xs[starts[i]:(starts[i+1]-1)] )
} </lang>
Testing:
<lang R> > chunks(`<`, c(0,4,8,1,3,5,7,9)) 1 [1] 0 4 8
2 [1] 1 3 5 7 9 </lang>
R displays the results in a very prolix manner, so let's simplify it.
<lang R> > toString(chunks(`<`, c(0,4,8,1,3,5,7,9,-2,0,88))) [1] "c(0, 4, 8), c(1, 3, 5, 7, 9), c(-2, 0, 88)" > toString(chunks(`==`, c(0,0,0,5,5,8))) [1] "c(0, 0, 0), c(5, 5), 8" </lang>
Defining the required functions:
<lang R> all.eq <- function(xs) 1 == length( chunks(`==`, xs)) ascending <- function(xs) 1 == length( chunks(`<`, xs)) </lang>
Testing:
<lang R> > all.eq(c('by')) [1] TRUE > all.eq(c('by','by','by')) [1] TRUE > all.eq(c('by','by','by','zoo')) [1] FALSE > ascending(c("at", "even", "once", "run", "zoo")) [1] TRUE > ascending(c("at", "even", "once", "run", "zoo", "we")) [1] FALSE > ascending(c("at", "even", "go", "go")) [1] FALSE > ascending(c("at")) [1] TRUE </lang>
Racket
Racket mostly has this... see documentation of string=? and string<?.
There are two small issues:
- Racket will not cope with comparing less than 2 strings
- also
string=?andstring<?take variable arguments, so the list has to beapplyed to the functions
Hence the wrapper in the code below: <lang racket>#lang racket/base (define ((list-stringX? stringX?) strs)
(or (null? strs) (null? (cdr strs)) (apply stringX? strs)))
(define list-string=? (list-stringX? string=?)) (define list-string<? (list-stringX? string<?))
(module+ test
(require tests/eli-tester)
(test
(list-string=? '()) => #t
(list-string=? '("a")) => #t
(list-string=? '("a" "a")) => #t
(list-string=? '("a" "a" "a")) => #t
(list-string=? '("b" "b" "a")) => #f)
(test
(list-string<? '()) => #t
(list-string<? '("a")) => #t
(list-string<? '("a" "b")) => #t
(list-string<? '("a" "a")) => #f
(list-string<? '("a" "b" "a")) => #f
(list-string<? '("a" "b" "c")) => #t))</lang>
Raku
(formerly Perl 6)
In Raku, putting square brackets around an infix operator turns it into a listop that effectively works as if the operator had been but in between all of the elements of the argument list (or in technical terms, it folds/reduces the list using that operator, while taking into account the operator's inherent associativity and identity value):
<lang perl6>[eq] @strings # All equal [lt] @strings # Strictly ascending</lang>
Red
<lang Red>Red []
list1: ["asdf" "Asdf" "asdf"] list2: ["asdf" "bsdf" "asdf"] list3: ["asdf" "asdf" "asdf"]
all-equal?: func [list][ 1 = length? unique/case list ] sorted?: func [list][ list == sort/case copy list ] ;; sort without copy would modify list !
print all-equal? list1 print sorted? list1
print all-equal? list2 print sorted? list2
print all-equal? list3 print sorted? list3 </lang>
- Output:
false false false false true true
REXX
version 1
<lang rexx>/* REXX ---------------------------------------------------------------
- 28.06.2014 Walter Pachl
- --------------------------------------------------------------------*/
Call mklist 'ABC','AA','BB','CC' Call test 'ABC' Call mklist 'AAA','AA','AA','AA' Call mklist 'ACB','AA','CC','BB' Call test 'AAA' Call test 'ACB' Exit
mklist:
list=arg(1) do i=1 by 1 To arg()-1 call value list'.'i,arg(i+1) End Call value list'.0',i-1 Return
test: Parse Arg list all_equal=1 increasing=1 Do i=1 To value(list'.0')-1 While all_equal | increasing
i1=i+1
Select
When value(list'.i1')==value(list'.i') Then increasing=0
When value(list'.i1')<<value(list'.i') Then Do
all_equal=0
increasing=0
End
When value(list'.i1')>>value(list'.i') Then all_equal=0
End
End
Select
When all_equal Then Say 'List' value(list)': all elements are equal' When increasing Then Say 'List' value(list)': elements are in increasing order' Otherwise Say 'List' value(list)': neither equal nor in increasing order' End
Return</lang>
- Output:
List ABC: elements are in increasing order List AAA: all elements are equal List ACB: neither equal nor in increasing order
version 2
Programming note: If a caseless compare (case insensitive) is desired, the two
- parse arg x (on lines 14 & 20)
REXX statements could be replaced with either of (they're equivalent):
- parse upper arg x
- arg x
<lang rexx>/*REXX program compares a list of (character) strings for: equality, all ascending. */ @.1= 'ayu dab dog gar panda tui yak' /*seven strings: they're all ascending.*/ @.2= 'oy oy oy oy oy oy oy oy oy oy' /* ten strings: all equal. */ @.3= 'somehow somewhere sometime' /*three strings: ¬equal, ¬ascending.*/ @.4= 'Hoosiers' /*only a single string is defined. */ @.5= /*Null. That is, no strings here. */
do j=1 for 5; say; say /* [↓] traipse through all the lists. */
say center(' '@.j, 50, "═") /*display a centered title/header. */
if ifEqual( @.j) then say 'strings are all equal.'
if ifAscend(@.j) then say 'strings are ascending.'
end /*j*/
exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ ifEqual: procedure; parse arg strings /*set STRINGS to a string in the list*/
do k=2 to words(strings) /*scan the strings in the list. */
if word(strings,k)\==word(strings,k-1) then return 0 /*string=prev? */
end /*k*/ /* [↑] 0=false, [↓] 1=true. */
return 1 /*indicate that all strings are equal. */
/*──────────────────────────────────────────────────────────────────────────────────────*/ ifAscend: procedure; parse arg strings /*set STRINGS to a string in the list*/
do k=2 to words(strings) /*scan the strings in the list. */
if word(strings,k)<<=word(strings,k-1) then return 0 /*string>prev? */
end /*k*/ /* [↑] 0=false, [↓] 1=true. */
return 1 /*indicate that strings are ascending. */</lang>
- output when using the supplied lists:
══════════ ayu dab dog gar panda tui yak══════════ The strings are ascending. ══════════ oy oy oy oy oy oy oy oy oy oy══════════ The strings are all equal. ══════════ somehow somewhere sometime══════════ ════════════════════ Hoosiers═════════════════════ The strings are all equal. The strings are ascending. ════════════════════════ ═════════════════════════ The strings are all equal. The strings are ascending.
version 3
This REXX version is more idiomatic. <lang rexx>/*REXX program compares a list of strings for: equality, all ascending. */ @.1= 'ayu dab dog gar panda tui yak' /*seven strings: they're all ascending.*/ @.2= 'oy oy oy oy oy oy oy oy oy oy' /* ten strings: all equal. */ @.3= 'somehow somewhere sometime' /*three strings: ¬equal, ¬ascending.*/ @.4= 'Hoosiers' /*only a single string is defined. */ @.5= /*Null. That is, no strings here. */
- = 5; do j=1 for #; say; say /* [↓] traipse through all the lists. */
say center(' '@.j, 50, "═") /*display a centered title/header. */
if cStr(@.j, 'Equal' ) then say " The strings are all equal."
if cStr(@.j, 'Ascending') then say " The strings are ascending."
end /*j*/
exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ cStr: procedure; parse arg x; arg , how 2 /*set X to list; get 1st char of arg #2*/
do k=2 to words(x) /*scan the strings in the list. */
if how=='E' then if word(x,k) \== word(x,k-1) then return 0 /*¬=prev.?*/
if how=='A' then if word(x,k) <<= word(x,k-1) then return 0 /*≤ prev.?*/
end /*k*/ /* [↓] 1=true. [↑] 0=false. */
return 1 /*indicate strings have true comparison*/</lang>
- output is identical to the above REXX version.
Ruby
<lang ruby>strings.uniq.one? # all equal? strings == strings.uniq.sort # ascending?</lang>
Short circuiting: <lang ruby>strings.all?{|str| str == strings.first} # all equal? strings.each_cons(2).all?{|str1, str2| str1 < str2} # ascending?</lang>
Rust
<lang rust>fn strings_are_equal(seq: &[&str]) -> bool {
match seq {
&[] | &[_] => true,
&[x, y, ref tail @ ..] if x == y => strings_are_equal(&[&[y], tail].concat()),
_ => false
}
}
fn asc_strings(seq: &[&str]) -> bool {
match seq {
&[] | &[_] => true,
&[x, y, ref tail @ ..] if x < y => asc_strings(&[&[y], tail].concat()),
_ => false
}
}</lang>
S-lang
"Simple Loop" and "Array Idiomatic" versions: <lang S-lang>define equal_sl(sarr) {
variable n = length(sarr), a0, i; if (n < 2) return 1;
a0 = sarr[0]; _for i (1, length(sarr)-1, 1) if (sarr[i] != a0) return 0;
return 1;
} define ascending_sl(sarr) {
variable n = length(sarr), a0, i; if (n < 2) return 1;
_for i (0, length(sarr)-2, 1) if (sarr[i] >= sarr[i+1]) return 0;
return 1;
}
define equal_ai(sarr) {
if (length(sarr) < 2) return 1; variable s0 = sarr[0]; return all(sarr1: == s0);
}
define ascending_ai(sarr) {
variable la = length(sarr); if (la < 2) return 1; return all(sarr0:la-2 < sarr1:la-1);
}
define atest(a) {
() = printf("\n");
print(a);
() = printf("equal_sl=%d, ascending_sl=%d\n",
equal_sl(a), ascending_sl(a));
() = printf("equal_ai=%d, ascending_ai=%d\n",
equal_ai(a), ascending_ai(a));
}
atest(["AA","BB","CC"]); atest(["AA","AA","AA"]); atest(["AA","CC","BB"]); atest(["AA","ACB","BB","CC"]); atest(["single_element"]); atest(NULL); </lang>
- Output:
"AA" "BB" "CC" equal_sl=0, ascending_sl=1 equal_ai=0, ascending_ai=1 "AA" "AA" "AA" equal_sl=1, ascending_sl=0 equal_ai=1, ascending_ai=0 "AA" "CC" "BB" equal_sl=0, ascending_sl=0 equal_ai=0, ascending_ai=0 "AA" "ACB" "BB" "CC" equal_sl=0, ascending_sl=1 equal_ai=0, ascending_ai=1 "single_element" equal_sl=1, ascending_sl=1 equal_ai=1, ascending_ai=1 NULL equal_sl=1, ascending_sl=1 equal_ai=1, ascending_ai=1
Scala
Functions implemented in Scala following a functional paradigm <lang Scala> def strings_are_equal(seq:List[String]):Boolean = seq match {
case Nil => true case s::Nil => true case el1 :: el2 :: tail => el1==el2 && strings_are_equal(el2::tail)
}
def asc_strings(seq:List[String]):Boolean = seq match {
case Nil => true case s::Nil => true case el1 :: el2 :: tail => el1.compareTo(el2) < 0
}
</lang>
- Output:
'''Sample tests:'''
scala> strings_are_equal(List("asdf"))
res3: Boolean = true
scala> strings_are_equal(List("asdf","asdf","sf"))
res5: Boolean = false
scala> asc_strings(List())
res10: Boolean = true
scala> asc_strings(List("asdfas","fds"))
res11: Boolean = true
scala> asc_strings(List("sdfa","asfsdf","afas","asf"))
res8: Boolean = false
Scheme
For known lists that are 'short-enough', the simplest solution uses 'apply', but that relies on the list being shorter than the maximum number of arguments a function can accept. Better is to write a simple loop:
<lang scheme> (define (compare-strings fn strs)
(or (null? strs) ; returns #t on empty list
(null? (cdr strs)) ; returns #t on list of size 1
(do ((fst strs (cdr fst))
(snd (cdr strs) (cdr snd)))
((or (null? snd)
(not (fn (car fst) (car snd))))
(null? snd))))) ; returns #t if the snd list is empty, meaning all comparisons are exhausted
(compare-strings string=? strings) ; test for all equal (compare-strings string<? strings) ; test for in ascending order </lang>
Seed7
<lang seed7>$ include "seed7_05.s7i";
const func boolean: allTheSame (in array string: strings) is func
result
var boolean: allTheSame is TRUE;
local
var integer: index is 0;
begin
for index range 2 to length(strings) until not allTheSame do
if strings[pred(index)] <> strings[index] then
allTheSame := FALSE;
end if;
end for;
end func;
const func boolean: strictlyAscending (in array string: strings) is func
result
var boolean: strictlyAscending is TRUE;
local
var integer: index is 0;
begin
for index range 2 to length(strings) until not strictlyAscending do
if strings[pred(index)] >= strings[index] then
strictlyAscending := FALSE;
end if;
end for;
end func;</lang>
SenseTalk
<lang sensetalk>analyze ["AA","BB","CC"] analyze ["AA","AA","AA"] analyze ["AA","CC","BB"] analyze ["AA","ACB","BB","CC"] analyze ["single_element"]
to analyze aList put "List: " & aList put " " & (if allEqual(aList) then "IS" else "Is NOT") && "all equal" put " " & (if isAscending(aList) then "IS" else "Is NOT") && "strictly ascending" end analyze
to handle allEqual strings return the number of items in the unique items of strings is less than 2 end allEqual
to handle isAscending strings repeat with n = 2 to the number of items in strings if item n of strings isn't more than item n-1 of strings then return False end if end repeat return True end isAscending</lang>
- Output:
List: ["AA","BB","CC"] Is NOT all equal IS strictly ascending List: ["AA","AA","AA"] IS all equal Is NOT strictly ascending List: ["AA","CC","BB"] Is NOT all equal Is NOT strictly ascending List: ["AA","ACB","BB","CC"] Is NOT all equal IS strictly ascending List: ["single_element"] IS all equal IS strictly ascending
Sidef
Short-circuiting: <lang ruby>1..arr.end -> all{ arr[0] == arr[_] } # all equal 1..arr.end -> all{ arr[_-1] < arr[_] } # strictly ascending</lang>
Non short-circuiting: <lang ruby>arr.uniq.len == 1 # all equal arr == arr.uniq.sort # strictly ascending</lang>
Tailspin
Note that we choose here to use 1 as true and 0 as false since Tailspin doesn't (yet?) have booleans <lang tailspin> // matcher testing if the array contains anything not equal to the first element templates allEqual
when <[](..1)> do 1 ! when <[<~=$(1)>]> do 0 ! otherwise 1 !
end allEqual
templates strictAscending
def a: $; 1 -> # when <$a::length..> do 1 ! when <?($a($) <..~$a($+1)>)> do $ + 1 -> # otherwise 0 !
end strictAscending
// Of course we could just use the same kind of loop for equality templates strictEqual
def a: $; 1 -> # when <$a::length..> do 1 ! when <?($a($) <=$a($+1)>)> do $ + 1 -> # otherwise 0 !
end strictEqual </lang>
Tcl
The command form of the eq and < operators (introduced in Tcl 8.5) handle arbitrarily many arguments and will check if they're all equal/ordered.
Making the operators work with a list of values is just a matter of using the expansion syntax with them.
<lang tcl>tcl::mathop::eq {*}$strings; # All values string-equal
tcl::mathop::< {*}$strings; # All values in strict order</lang>
VBA
<lang vb> Private Function IsEqualOrAscending(myList) As String Dim i&, boolEqual As Boolean, boolAsc As Boolean
On Error Resume Next
If UBound(myList) > 0 Then
If Err.Number > 0 Then
IsEqualOrAscending = "Error " & Err.Number & " : Empty array"
On Error GoTo 0
Exit Function
Else
For i = 1 To UBound(myList)
If myList(i) <> myList(i - 1) Then boolEqual = True
If myList(i) <= myList(i - 1) Then boolAsc = True
Next
End If
End If
IsEqualOrAscending = "List : " & Join(myList, ",") & ", IsEqual : " & (Not boolEqual) & ", IsAscending : " & Not boolAsc
End Function </lang> Call : <lang vb> Sub Main() Dim List
Debug.Print IsEqualOrAscending(Array("AA", "BB", "CC"))
Debug.Print IsEqualOrAscending(Array("AA", "AA", "AA"))
Debug.Print IsEqualOrAscending(Array("AA", "CC", "BB"))
Debug.Print IsEqualOrAscending(Array("AA", "ACB", "BB", "CC"))
Debug.Print IsEqualOrAscending(Array("single_element"))
Debug.Print IsEqualOrAscending(Array("AA", "BB", "BB"))
'test with Empty Array :
Debug.Print IsEqualOrAscending(List)
End Sub </lang>
- Output:
List : AA,BB,CC, IsEqual : False, IsAscending : True List : AA,AA,AA, IsEqual : True, IsAscending : False List : AA,CC,BB, IsEqual : False, IsAscending : False List : AA,ACB,BB,CC, IsEqual : False, IsAscending : True List : single_element, IsEqual : True, IsAscending : True List : AA,BB,BB, IsEqual : False, IsAscending : False Error 13 : Empty array
VBScript
<lang vb> Function string_compare(arr) lexical = "Pass" ascending = "Pass" For i = 0 To UBound(arr) If i+1 <= UBound(arr) Then If arr(i) <> arr(i+1) Then lexical = "Fail" End If If arr(i) >= arr(i+1) Then ascending = "Fail" End If End If Next string_compare = "List: " & Join(arr,",") & vbCrLf &_ "Lexical Test: " & lexical & vbCrLf &_ "Ascending Test: " & ascending & vbCrLf End Function
WScript.StdOut.WriteLine string_compare(Array("AA","BB","CC")) WScript.StdOut.WriteLine string_compare(Array("AA","AA","AA")) WScript.StdOut.WriteLine string_compare(Array("AA","CC","BB")) WScript.StdOut.WriteLine string_compare(Array("AA","ACB","BB","CC")) WScript.StdOut.WriteLine string_compare(Array("FF")) </lang>
- Output:
List: AA,BB,CC Lexical Test: Fail Ascending Test: Pass List: AA,AA,AA Lexical Test: Pass Ascending Test: Fail List: AA,CC,BB Lexical Test: Fail Ascending Test: Fail List: AA,ACB,BB,CC Lexical Test: Fail Ascending Test: Pass List: FF Lexical Test: Pass Ascending Test: Pass
Wren
<lang ecmascript>import "/sort" for Sort
var areEqual = Fn.new { |strings|
if (strings.count < 2) return true
return (1...strings.count).all { |i| strings[i] == strings[i-1] }
}
var areAscending = Fn.new { |strings| Sort.isSorted(strings) }
var a = ["a", "a", "a"] var b = ["a", "b", "c"] var c = ["a", "a", "b"] var d = ["a", "d", "c"] System.print("%(a) are all equal : %(areEqual.call(a))") System.print("%(b) are ascending : %(areAscending.call(b))") System.print("%(c) are all equal : %(areEqual.call(c))") System.print("%(d) are ascending : %(areAscending.call(d))")</lang>
- Output:
[a, a, a] are all equal : true [a, b, c] are ascending : true [a, a, b] are all equal : false [a, d, c] are ascending : false
XProfan
<lang XProfan>Proc allsame
Parameters long liste
var int result = 1
var int cnt = GetCount(liste)
Case cnt == 0 : Return 0
Case cnt == 1 : Return 1
WhileLoop 1, cnt-1
If GetString$(liste,&loop - 1) <> GetString$(liste,&loop)
result = 0
BREAK
EndIf
EndWhile
Return result
EndProc
Proc strict_order
Parameters long liste
var int result = 1
var int cnt = GetCount(liste)
Case cnt == 0 : Return 0
Case cnt == 1 : Return 1
WhileLoop 1, cnt-1
If GetString$(liste,&loop) <= GetString$(liste,&loop - 1)
result = 0
BREAK
EndIf
EndWhile
Return result
EndProc
cls declare string s[4] s[0] = "AA,BB,CC" s[1] = "AA,AA,AA" s[2] = "AA,CC,BB" s[3] = "AA,ACB,BB,CC" s[4] = "single_element"
WhileLoop 0,4
ClearList 0
Move("StrToList",s[&loop],",")
Print "list:",s[&loop]
Print "...is " + if(allsame(0), "", "not ") + "lexically equal"
Print "...is " + if(strict_order(0), "", "not ") + "in strict ascending order"
EndWhile
ClearList 0 WaitKey end</lang>
- Output:
list: AA,BB,CC ...is not lexically equal ...is in strict ascending order list: AA,AA,AA ...is lexically equal ...is not in strict ascending order list: AA,CC,BB ...is not lexically equal ...is not in strict ascending order list: AA,ACB,BB,CC ...is not lexically equal ...is in strict ascending order list: single_element ...is lexically equal ...is in strict ascending order
zkl
These short circuit. <lang zkl>fcn allEQ(strings){ (not strings.filter1('!=(strings[0]))) } fcn monoUp(strings){
strings.len()<2 or
strings.reduce(fcn(a,b){ if(a>=b) return(Void.Stop,False); b }).toBool()
}</lang> <lang zkl>allEQ(T("AA")).println(); //True allEQ(T("AA","AA","AA","AA")).println(); //True allEQ(T("A", "AA","AA","AA")).println(); //False
monoUp(T("a")).println(); //True monoUp(T("a","aa","aaa","aaaa")).println(); //True monoUp(T("a","aa","aaa","aaa")).println(); //False monoUp(T("a","b","c","cc")).println(); //True</lang>
zonnon
<lang zonnon> module CompareStrings; type Vector = array * of string; var v,w: Vector; i: integer; all,ascending: boolean; begin v := new Vector(3); v[0] := "uno"; v[1] := "uno"; v[2] := "uno";
all := true; for i := 1 to len(v) - 1 do all := all & (v[i - 1] = v[i]); end;
w := new Vector(3); w[0] := "abc"; w[1] := "bcd"; w[2] := "cde"; v := w; ascending := true; for i := 1 to len(v) - 1 do ascending := ascending & (v[i - 1] <= v[i]) end;
write("all equals?: ");writeln(all); write("ascending?: ");writeln(ascending) end CompareStrings. </lang>
ZX Spectrum Basic
<lang zxbasic>10 FOR j=160 TO 200 STEP 10 20 RESTORE j 30 READ n 40 LET test1=1: LET test2=1 50 FOR i=1 TO n 60 READ a$ 70 PRINT a$;" "; 80 IF i=1 THEN GO TO 110 90 IF p$<>a$ THEN LET test1=0 100 IF p$>=a$ THEN LET test2=0 110 LET p$=a$ 120 NEXT i 130 PRINT 'test1'test2 140 NEXT j 150 STOP 160 DATA 3,"AA","BB","CC" 170 DATA 3,"AA","AA","AA" 180 DATA 3,"AA","CC","BB" 190 DATA 4,"AA","ACB","BB","CC" 200 DATA 1,"single_element"</lang>
- Programming Tasks
- Solutions by Programming Task
- 11l
- 360 Assembly
- Action!
- Ada
- ALGOL 68
- ALGOL W
- AppleScript
- Arturo
- AWK
- BQN
- Bracmat
- C
- C sharp
- C++
- Clojure
- COBOL
- Common Lisp
- D
- Delphi
- System.SysUtils
- Dyalect
- Elena
- Elixir
- Erlang
- F Sharp
- Factor
- Forth
- Fortran
- FreeBASIC
- Fōrmulæ
- Go
- Gosu
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Jq
- Jsish
- Julia
- Klong
- Kotlin
- Lambdatalk
- Lua
- M2000 Interpreter
- Maple
- Mathcad
- Mathematica
- Wolfram Language
- MATLAB
- Octave
- Nanoquery
- NetRexx
- Nim
- OCaml
- Oforth
- OoRexx
- PARI/GP
- Perl
- Phix
- Phixmonti
- PicoLisp
- PL/I
- Plain English
- PowerShell
- Prolog
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- Red
- REXX
- Ruby
- Rust
- S-lang
- Scala
- Scheme
- Seed7
- SenseTalk
- Sidef
- Tailspin
- Tcl
- VBA
- VBScript
- Wren
- Wren-sort
- XProfan
- Zkl
- Zonnon
- ZX Spectrum Basic