Ordered words: Difference between revisions
(Added Forth) |
m (Fixed "Oops" in Forth) |
||
| Line 768: | Line 768: | ||
begin s> dup r@ >= while type cr repeat |
begin s> dup r@ >= while type cr repeat |
||
2drop r> drop \ keep printing until shorter word |
2drop r> drop \ keep printing until shorter word |
||
; \ has been found |
; \ has been found |
||
: ordered ( --) |
|||
open-file s.clear read-file read-back close |
|||
; \ open file, clear the stack, read file |
|||
\ read it back and close the file |
|||
ordered</lang> |
|||
Since the longest word is on top of the stack, the only thing to be done is to pop |
Since the longest word is on top of the stack, the only thing to be done is to pop |
||
all words from the stack until a shorter word is encountered. Consequently, all |
all words from the stack until a shorter word is encountered. Consequently, all |
||
Revision as of 12:45, 18 June 2011
You are encouraged to solve this task according to the task description, using any language you may know.
Define an ordered word as a word in which the letters of the word appear in alphabetic order. Examples include 'abbey' and 'dirt'.
The task is to find and display all the ordered words in this dictionary that have the longest word length. (Examples that access the dictionary file locally assume that you have downloaded this file yourself.) The display needs to be shown on this page.
Ada
<lang Ada>with Ada.Containers.Indefinite_Vectors; with Ada.Text_IO; procedure Ordered_Words is
package Word_Vectors is new Ada.Containers.Indefinite_Vectors
(Index_Type => Positive, Element_Type => String);
function Is_Ordered (The_Word : String) return Boolean is
Highest_Character : Character := 'a';
begin
for I in The_Word'Range loop
if The_Word(I) not in 'a' .. 'z' then
return False;
end if;
if The_Word(I) < Highest_Character then
return False;
end if;
Highest_Character := The_Word(I);
end loop;
return True;
end Is_Ordered;
procedure Print_Word (Position : Word_Vectors.Cursor) is
begin
Ada.Text_IO.Put_Line (Word_Vectors.Element (Position));
end Print_Word;
File : Ada.Text_IO.File_Type; Ordered_Words : Word_Vectors.Vector; Max_Length : Positive := 1;
begin
Ada.Text_IO.Open (File, Ada.Text_IO.In_File, "unixdict.txt");
while not Ada.Text_IO.End_Of_File (File) loop
declare
Next_Word : String := Ada.Text_IO.Get_Line (File);
begin
if Is_Ordered (Next_Word) then
if Next_Word'Length > Max_Length then
Max_Length := Next_Word'Length;
Word_Vectors.Clear (Ordered_Words);
Word_Vectors.Append (Ordered_Words, Next_Word);
elsif Next_Word'Length = Max_Length then
Word_Vectors.Append (Ordered_Words, Next_Word);
end if;
end if;
end;
end loop;
Word_Vectors.Iterate (Ordered_Words, Print_Word'Access);
end Ordered_Words;</lang>
Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
AutoHotkey
This script uses the ASCII value of each letter to determine its place in the alphabet. Given a dictionary not all in the same case, StringLower could be used. This script assumes a locally downloaded copy of the dictionary, but UrlDownloadToFile could be used. The purpose of the GUI is simply to display a field where the user can copy the list. MsgBox could be used, or FileAppend. <lang AutoHotkey> MaxLen=0 Loop, Read, UnixDict.txt ; Assigns A_LoopReadLine to each line of the file {
thisword := A_LoopReadLine ; Just for readability
blSort := isSorted(thisWord) ; reduce calls to IsSorted to improve performance
ThisLen := StrLen(ThisWord) ; reduce calls to StrLen to improve performance
If (blSort = true and ThisLen = maxlen)
list .= ", " . thisword
Else If (blSort = true and ThisLen > maxlen)
{
list := thisword
maxlen := ThisLen
}
}
IsSorted(word){ ; This function uses the ASCII value of the letter to determine its place in the alphabet.
; Thankfully, the dictionary is in all lowercase
lastchar=0
Loop, parse, word
{
if ( Asc(A_LoopField) < lastchar )
return false
lastchar := Asc(A_loopField)
}
return true
}
GUI, Add, Edit, w300 ReadOnly, %list% GUI, Show return ; End Auto-Execute Section
GUIClose: ExitApp </lang> Output: <lang>abbott, accent, accept, access, accost, almost, bellow, billow, biopsy, chilly, choosy, choppy, effort, floppy, glossy, knotty</lang>
AWK
<lang awk>BEGIN { abc = "abcdefghijklmnopqrstuvwxyz" }
{ # Check if this line is an ordered word. ordered = 1 # true left = -1 for (i = 1; i <= length($0); i++) { right = index(abc, substr($0, i, 1)) if (right == 0 || left > right) { ordered = 0 # false break } left = right }
if (ordered) { score = length($0) if (score > best["score"]) { # Reset the list of best ordered words. best["score"] = score best["count"] = 1 best[1] = $0 } else if (score == best["score"]) { # Add this word to the list. best[++best["count"]] = $0 } } }
END { # Print the list of best ordered words. for (i = 1; i <= best["count"]; i++) print best[i] }</lang>
You must provide unixdict.txt as input.
$ awk -f ordered-words.awk unixdict.txt abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
C
<lang c>#include <stdlib.h>
- include <string.h>
- include <stdio.h>
- include <assert.h>
- define MAXLEN 100
typedef char TWord[MAXLEN];
typedef struct Node {
TWord word; struct Node *next;
} Node;
int is_ordered_word(const TWord word) {
assert(word != NULL); int i;
for (i = 0; word[i] != '\0'; i++)
if (word[i] > word[i + 1] && word[i + 1] != '\0')
return 0;
return 1;
}
Node* list_prepend(Node* words_list, const TWord new_word) {
assert(new_word != NULL);
Node *new_node = malloc(sizeof(Node));
if (new_node == NULL)
exit(EXIT_FAILURE);
strcpy(new_node->word, new_word); new_node->next = words_list; return new_node;
}
Node* list_destroy(Node *words_list) {
while (words_list != NULL) {
Node *temp = words_list;
words_list = words_list->next;
free(temp);
}
return words_list;
}
void list_print(Node *words_list) {
while (words_list != NULL) {
printf("\n%s", words_list->word);
words_list = words_list->next;
}
}
int main() {
FILE *fp = fopen("unixdict.txt", "r");
if (fp == NULL)
return EXIT_FAILURE;
Node *words = NULL; TWord line; unsigned int max_len = 0;
while (fscanf(fp, "%99s\n", line) != EOF) {
if (strlen(line) > max_len && is_ordered_word(line)) {
max_len = strlen(line);
words = list_destroy(words);
words = list_prepend(words, line);
} else if (strlen(line) == max_len && is_ordered_word(line)) {
words = list_prepend(words, line);
}
}
fclose(fp); list_print(words);
return EXIT_SUCCESS;
}</lang> Output: <lang>abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty</lang> Alternative version with dynamic array: <lang c>#include <stdlib.h>
- include <string.h>
- include <stdio.h>
- include <assert.h>
- define MAXLEN 100
typedef char TWord[MAXLEN];
typedef struct WordsArray {
TWord *words; size_t len;
} WordsArray;
int is_ordered_word(const TWord word) {
assert(word != NULL); int i;
for (i = 0; word[i] != '\0'; i++)
if (word[i] > word[i + 1] && word[i + 1] != '\0')
return 0;
return 1;
}
void array_append(WordsArray *words_array, const TWord new_word) {
assert(words_array != NULL); assert(new_word != NULL); assert((words_array->len == 0) == (words_array->words == NULL));
words_array->len++;
words_array->words = realloc(words_array->words,
words_array->len * sizeof(words_array->words[0]));
if (words_array->words == NULL)
exit(EXIT_FAILURE);
strcpy(words_array->words[words_array->len-1], new_word);
}
void array_free(WordsArray *words_array) {
assert(words_array != NULL); free(words_array->words); words_array->words = NULL; words_array->len = 0;
}
void list_print(WordsArray *words_array) {
assert(words_array != NULL);
size_t i;
for (i = 0; i < words_array->len; i++)
printf("\n%s", words_array->words[i]);
}
int main() {
FILE *fp = fopen("unixdict.txt", "r");
if (fp == NULL)
return EXIT_FAILURE;
WordsArray words; words.len = 0; words.words = NULL;
TWord line; line[0] = '\0'; unsigned int max_len = 0;
while (fscanf(fp, "%99s\n", line) != EOF) { // 99 = MAXLEN - 1
if (strlen(line) > max_len && is_ordered_word(line)) {
max_len = strlen(line);
array_free(&words);
array_append(&words, line);
} else if (strlen(line) == max_len && is_ordered_word(line)) {
array_append(&words, line);
}
}
fclose(fp); list_print(&words); array_free(&words);
return EXIT_SUCCESS;
}</lang>
C++
<lang cpp>#include <algorithm>
- include <fstream>
- include <functional>
- include <iostream>
- include <iterator>
- include <string>
- include <vector>
// use adjacent_find to test for out-of-order letter pair bool ordered(const std::string &word) {
return std::adjacent_find(word.begin(), word.end(), std::greater<char>()) == word.end();
}
int main() {
std::ifstream infile("unixdict.txt");
if (!infile)
{
std::cerr << "Can't open word file\n";
return -1;
}
std::vector<std::string> words; std::string word; int longest = 0;
while (std::getline(infile, word))
{
int length = word.length();
if (length < longest) continue; // don't test short words
if (ordered(word))
{
if (length > longest)
{
longest = length; // set new minimum length
words.clear(); // reset the container
}
words.push_back(word);
}
}
std::copy(words.begin(), words.end(), std::ostream_iterator<std::string>(std::cout, "\n"));
}</lang> Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
C#
<lang csharp>using System; using System.Linq; using System.Net;
static class Program {
static void Main(string[] args)
{
WebClient client = new WebClient();
string text = client.DownloadString("http://www.puzzlers.org/pub/wordlists/unixdict.txt");
string[] words = text.Split(new char[] { '\r', '\n' }, StringSplitOptions.RemoveEmptyEntries);
var query = from w in words
where IsOrderedWord(w)
group w by w.Length into ows
orderby ows.Key descending
select ows;
Console.WriteLine(string.Join(", ", query.First().ToArray()));
}
private static bool IsOrderedWord(string w)
{
for (int i = 1; i < w.Length; i++)
if (w[i] < w[i - 1])
return false;
return true; }
}</lang>
Output:
abbott, accent, accept, access, accost, almost, bellow, billow, biopsy, chilly, choosy, choppy, effort, floppy, glossy, knotty
Common Lisp
<lang lisp>(defun orderedp (word)
(reduce (lambda (prev curr)
(when (char> prev curr) (return-from orderedp nil))
curr)
word)
t)
(defun longest-ordered-words (filename)
(let ((result nil))
(with-open-file (s filename)
(loop
with greatest-length = 0
for word = (read-line s nil)
until (null word)
do (let ((length (length word)))
(when (and (>= length greatest-length)
(orderedp word))
(when (> length greatest-length)
(setf greatest-length length
result nil))
(push word result)))))
(nreverse result)))
CL-USER> (longest-ordered-words "unixdict.txt") ("abbott" "accent" "accept" "access" "accost" "almost" "bellow" "billow"
"biopsy" "chilly" "choosy" "choppy" "effort" "floppy" "glossy" "knotty")
</lang>
D
<lang d>import std.stdio, std.algorithm;
void main() {
string[] owords;
foreach (w; File("unixdict.txt").byLine()) {
if (!isSorted(w))
continue;
if (!owords.length || w.length == owords[0].length)
owords ~= w.idup;
else if (w.length > owords[0].length)
owords = [w.idup];
}
writeln(owords);
}</lang> Output:
[abbott, accent, accept, access, accost, almost, bellow, billow, biopsy, chilly, choosy, choppy, effort, floppy, glossy, knotty]
Functional-style, same output: <lang d>import std.stdio, std.algorithm, std.array, std.range;
void main() {
auto ow = filter!isSorted(File("unixdict.txt").byLine());
auto owa = array(map!q{ a.dup }(ow));
auto maxl = reduce!max(map!walkLength(owa));
writeln(filter!((w){ return w.length == maxl; })(owa));
}</lang>
Delphi
<lang Delphi> program POrderedWords;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, IdHTTP;
function IsOrdered(const s:string): Boolean; var
I: Integer;
begin
Result := Length(s)<2; // empty or 1 char strings are ordered
for I := 2 to Length(s) do
if s[I]<s[I-1] then // can improve using case/localization to order...
Exit;
Result := True;
end;
function ProcessDictionary(const AUrl: string): string; var
slInput: TStringList; I, WordSize: Integer;
begin
slInput := TStringList.Create;
try
with TIdHTTP.Create(nil) do try
slInput.Text := Get(AUrl);
finally
Free;
end;
// or use slInput.LoadFromFile('yourfilename') to load from a local file
WordSize :=0;
for I := 0 to slInput.Count-1 do begin
if IsOrdered(slInput[I]) then
if (Length(slInput[I]) = WordSize) then
Result := Result + slInput[I] + ' '
else if (Length(slInput[I]) > WordSize) then begin
Result := slInput[I] + ' ';
WordSize := Length(slInput[I]);
end;
end;
finally
slInput.Free;
end;
end;
begin
try
WriteLn(ProcessDictionary('http://www.puzzlers.org/pub/wordlists/unixdict.txt'));
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end. </lang>
Output: dictionary directly processed from the URL
<lang Delphi> abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty </lang>
E
<lang e>pragma.enable("accumulator")
def words := <http://www.puzzlers.org/pub/wordlists/unixdict.txt>.getText().split("\n") def ordered := accum [] for word ? (word.sort() <=> word) in words { _.with(word) } def maxLen := accum 0 for word in ordered { _.max(word.size()) } def maxOrderedWords := accum [] for word ? (word.size() <=> maxLen) in ordered { _.with(word) } println(" ".rjoin(maxOrderedWords))</lang>
One-pass procedural algorithm which avoids keeping the entire data set in memory:
<lang e>def best := [].diverge() for `@word$\n` ? (word.sort() <=> word) in <http://www.puzzlers.org/pub/wordlists/unixdict.txt> {
if (best.size() == 0) {
best.push(word)
} else if (word.size() > best[0].size()) {
best(0) := [word] # replace all
} else if (word.size() <=> best[0].size()) {
best.push(word)
}
} println(" ".rjoin(best.snapshot()))</lang>
Output: abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
F#
<lang fsharp>open System open System.IO
let longestOrderedWords() =
let isOrdered = Seq.pairwise >> Seq.forall (fun (a,b) -> a <= b)
File.ReadLines("unixdict.txt")
|> Seq.filter isOrdered
|> Seq.groupBy (fun s -> s.Length)
|> Seq.sortBy (fst >> (~-))
|> Seq.head |> snd
longestOrderedWords() |> Seq.iter (printfn "%s")</lang>
Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Factor
<lang factor>USING: fry grouping io io.encodings.utf8 io.files kernel math math.order sequences unicode.case ; IN: ordered-words
CONSTANT: dict-file "vocab:ordered-words/unixdict.txt"
- word-list ( -- seq )
dict-file utf8 file-lines ;
- ordered-word? ( word -- ? )
>lower 2 <clumps> [ first2 <= ] all? ;
- filter-longest-words ( seq -- seq' )
dup [ length ] [ max ] map-reduce '[ length _ = ] filter ;
- main ( -- )
word-list [ ordered-word? ] filter filter-longest-words [ print ] each ;</lang>
Output:
( scratchpad ) USING: ordered-words ; ( scratchpad ) main abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Fantom
<lang fantom> class Main {
public static Bool ordered (Str word)
{
word.chars.all |Int c, Int i -> Bool|
{
(i == (word.size-1) || c <= word.chars[i+1])
}
}
public static Void main ()
{
Str[] words := [,]
File(`unixdict.txt`).eachLine |Str word|
{
if (ordered(word))
{
if (words.isEmpty || words.first.size < word.size)
{ // reset the list
words = [word]
}
else if (words.size >= 1 && words.first.size == word.size)
{ // add word to existing ones
words.add (word)
}
}
}
echo (words.join (" "))
}
} </lang>
Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Forth
This program uses a string stack, which means that all matching words are stored on a stack. The longest word ends up on the top of the stack. <lang Forth> include lib/stmstack.4th \ include string stack library
- check-word ( a n -- a n f)
2dup bl >r \ start off with a space begin dup \ when not end of word while over c@ r@ >= \ check character while r> drop over c@ >r chop \ chop character off repeat r> drop nip 0= \ cleanup and set flag
- open-file ( -- h)
1 dup argn = abort" Usage: ordered infile" args input open error? abort" Cannot open file" dup use \ return and use the handle
- read-file ( --)
0 >r \ begin with zero length
begin
refill \ EOF detected?
while
0 parse dup r@ >= \ equal or longer string length?
if \ check the word and adjust length
check-word if r> drop dup >r >s else 2drop then
else \ if it checks out, put on the stack
2drop \ otherwise drop the word
then
repeat r> drop \ clean it up
- read-back ( --)
s> dup >r type cr \ longest string is on top of stack begin s> dup r@ >= while type cr repeat 2drop r> drop \ keep printing until shorter word
- \ has been found
- ordered ( --)
open-file s.clear read-file read-back close
- \ open file, clear the stack, read file
\ read it back and close the file
ordered</lang> Since the longest word is on top of the stack, the only thing to be done is to pop all words from the stack until a shorter word is encountered. Consequently, all words are listed in reverse order:
knotty glossy floppy effort choppy choosy chilly biopsy billow bellow almost accost access accept accent abbott
Fortran
<lang fortran> !***************************************************************************************
module ordered_module
!***************************************************************************************
implicit none
!the dictionary file: integer,parameter :: file_unit = 1000 character(len=*),parameter :: filename = 'unixdict.txt'
!maximum number of characters in a word: integer,parameter :: max_chars = 50
type word character(len=max_chars) :: str !the word from the dictionary integer :: n = 0 !length of this word logical :: ordered = .false. !if it is an ordered word end type word
!the dictionary structure: type(word),dimension(:),allocatable :: dict
contains !***************************************************************************************
!****************************************************************************** function count_lines_in_file(fid) result(n_lines) !****************************************************************************** implicit none
integer :: n_lines integer,intent(in) :: fid character(len=1) :: tmp integer :: i integer :: ios
!the file is assumed to be open already.
rewind(fid) !rewind to beginning of the file
n_lines = 0 do !read each line until the end of the file. read(fid,'(A1)',iostat=ios) tmp if (ios < 0) exit !End of file n_lines = n_lines + 1 !row counter end do
rewind(fid) !rewind to beginning of the file
!****************************************************************************** end function count_lines_in_file !******************************************************************************
!****************************************************************************** pure elemental function ordered_word(word) result(yn) !****************************************************************************** ! turns true if word is an ordered word, false if it is not. !******************************************************************************
implicit none character(len=*),intent(in) :: word logical :: yn
integer :: i
yn = .true. do i=1,len_trim(word)-1 if (ichar(word(i+1:i+1))<ichar(word(i:i))) then yn = .false. exit end if end do
!****************************************************************************** end function ordered_word !******************************************************************************
!***************************************************************************************
end module ordered_module
!***************************************************************************************
!****************************************************
program main
!****************************************************
use ordered_module implicit none
integer :: i,n,n_max
!open the dictionary and read in all the words: open(unit=file_unit,file=filename) !open the file n = count_lines_in_file(file_unit) !count lines in the file allocate(dict(n)) !allocate dictionary structure do i=1,n ! read(file_unit,'(A)') dict(i)%str !each line is a word in the dictionary dict(i)%n = len_trim(dict(i)%str) !save word length end do close(file_unit) !close the file
!use elemental procedure to get ordered words: dict%ordered = ordered_word(dict%str)
!max length of an ordered word: n_max = maxval(dict%n, mask=dict%ordered)
!write the output: do i=1,n if (dict(i)%ordered .and. dict(i)%n==n_max) write(*,'(A,A)',advance='NO') trim(dict(i)%str),' ' end do write(*,*)
!****************************************************
end program main
!**************************************************** </lang>
Output
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Go
Go has strings and Unicode and stuff, but with the dictionary all ASCII and lower case, strings and Unicode seem overkill. I just worked with byte slices here, only converting the final result to strings for easy output. <lang go>
package main
import (
"bytes" "fmt" "io/ioutil"
)
func main() {
// read into memory in one chunk
b, err := ioutil.ReadFile("unixdict.txt")
if err != nil {
fmt.Println(err)
return
}
// split at line ends
bss := bytes.Split(b, []byte{'\n'}, -1)
// accumulate result
var longest int
var list [][]byte
for _, bs := range bss {
// don't bother with words shorter than
// our current longest ordered word
if len(bs) < longest {
continue
}
// check for ordered property
var lastLetter byte
for i := 0; ; i++ {
if i == len(bs) {
// end of word. it's an ordered word.
// save it and break from loop
if len(bs) > longest {
longest = len(bs)
list = list[:0]
}
list = append(list, bs)
break
}
// check next letter
b := bs[i]
if b < 'a' || b > 'z' {
continue // not a letter. ignore.
}
if b < lastLetter {
break // word not ordered.
}
// letter passes test
lastLetter = b
}
}
// print result
for _, bs := range list {
fmt.Println(string(bs))
}
} </lang> Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Haskell
<lang haskell> -- Words are read from the standard input. We keep in memory only the current -- set of longest, ordered words. -- -- Limitation: the locale's collation order is not take into consideration.
isOrdered wws@(_:ws) = and $ zipWith (<=) wws ws
keepLongest _ acc [] = acc keepLongest max acc (w:ws) =
let len = length w in case compare len max of LT -> keepLongest max acc ws EQ -> keepLongest max (w:acc) ws GT -> keepLongest len [w] ws
longestOrderedWords = reverse . keepLongest 0 [] . filter isOrdered
main = do
str <- getContents let ws = longestOrderedWords $ words str mapM_ putStrLn ws
</lang>
Output: <lang haskell> abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty </lang> Alternative version: <lang haskell>import Control.Monad (liftM)
isSorted wws@(_ : ws) = and $ zipWith (<=) wws ws
getLines = liftM lines . readFile
main = do
ls <- getLines "unixdict.txt" let ow = filter isSorted ls let maxl = foldr max 0 (map length ow) print $ filter (\w -> (length w) == maxl) ow</lang>
Icon and Unicon
<lang Unicon>link strings
procedure main(A)
f := open(\A[1]) | stop("Give dictionary file name on command line")
every (maxLen := 0, maxLen <= *(w := !f), w == csort(w)) do {
if maxLen <:= *w then maxList := [] #discard any shorter sorted words
put(maxList, w)
}
every write(!\maxList)
end</lang>
strings provides csort which sorts the letters within a string
Output:
->ordered_words unixdict.txt abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty ->
J
<lang j> require'web/gethttp'
dict=: gethttp'http://www.puzzlers.org/pub/wordlists/unixdict.txt' oWords=: (#~ ] = /:~L:0) <;._2 dict-.CR ;:inv (#~ (= >./)@:(#@>))oWords
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty</lang>
Recap:
- fetch dictionary (
dict) - break into words, one per line (
<;._2 dict-.CR) - find ordered words (
oWords) - select the longest ordered words (
(#~ (= >./)@:(#@>))oWords) - format for display (using ;:inv)
Java
This example assumes there is a local copy of the dictionary whose paht is given as the first argument to the program. <lang java5>import java.io.BufferedReader; import java.io.FileReader; import java.io.IOException; import java.util.Arrays; import java.util.Collections; import java.util.Comparator; import java.util.LinkedList; import java.util.List;
public class Ordered {
private static boolean isOrderedWord(String word){ char[] sortedWord = word.toCharArray(); Arrays.sort(sortedWord); return word.equals(new String(sortedWord)); }
public static void main(String[] args) throws IOException{ List<String> orderedWords = new LinkedList<String>(); BufferedReader in = new BufferedReader(new FileReader(args[0])); while(in.ready()){ String word = in.readLine(); if(isOrderedWord(word)) orderedWords.add(word); } in.close();
Collections.<String>sort(orderedWords, new Comparator<String>() { @Override public int compare(String o1, String o2) { return new Integer(o2.length()).compareTo(o1.length()); } });
int maxLen = orderedWords.get(0).length(); for(String word: orderedWords){ if(word.length() == maxLen){ System.out.println(word); }else{ break; } } } }</lang> Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
JavaScript
Using node.js:
<lang javascript>var fs = require('fs'), print = require('sys').print; fs.readFile('./unixdict.txt', 'ascii', function (err, data) {
var is_ordered = function(word){return word.split().sort().join() === word;},
ordered_words = data.split('\n').filter(is_ordered).sort(function(a, b){return a.length - b.length}).reverse(),
longest = [], curr = len = ordered_words[0].length, lcv = 0;
while (curr === len){
longest.push(ordered_words[lcv]);
curr = ordered_words[++lcv].length;
};
print(longest.sort().join(', ') + '\n');
});</lang> Output:
abbott, accent, accept, access, accost, almost, bellow, billow, biopsy, chilly, choosy, choppy, effort, floppy, glossy, knotty
Lua
<lang lua>fp = io.open( "dictionary.txt" )
maxlen = 0 list = {}
for w in fp:lines() do
ordered = true for l = 2, string.len(w) do
if string.byte( w, l-1 ) > string.byte( w, l ) then ordered = false
break
end
end if ordered then
if string.len(w) > maxlen then list = {} list[1] = w maxlen = string.len(w) elseif string.len(w) == maxlen then list[#list+1] = w end
end
end
for _, w in pairs(list) do
print( w )
end
fp:close()</lang> Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
OCaml
<lang ocaml>let input_line_opt ic =
try Some(input_line ic) with End_of_file -> None
(* load each line in a list *) let read_lines ic =
let rec aux acc = match input_line_opt ic with | Some line -> aux (line :: acc) | None -> (List.rev acc) in aux []
let char_list_of_string str =
let lst = ref [] in String.iter (fun c -> lst := c :: !lst) str; (List.rev !lst)
let is_ordered word =
let rec aux = function
| c1::c2::tl ->
if c1 <= c2
then aux (c2::tl)
else false
| c::[] -> true
| [] -> true (* should only occur with an empty string *)
in
aux (char_list_of_string word)
let longest_words words =
let res, _ =
List.fold_left
(fun (lst, n) word ->
let len = String.length word in
let comp = compare len n in
match lst, comp with
| lst, 0 -> ((word::lst), n) (* len = n *)
| lst, -1 -> (lst, n) (* len < n *)
| _, 1 -> ([word], len) (* len > n *)
| _ -> assert false
)
([""], 0) words
in
(List.rev res)
let () =
let ic = open_in "unixdict.txt" in let words = read_lines ic in let lower_words = List.map String.lowercase words in let ordered_words = List.filter is_ordered lower_words in let longest_ordered_words = longest_words ordered_words in List.iter print_endline longest_ordered_words</lang>
$ ocaml ordered_words.ml abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Perl
<lang Perl>#!/usr/bin/perl use strict; use warnings;
open(FH, "<", "unixdict.txt") or die "Can't open file!\n"; my @words; while (<FH>) {
chomp;
push @{$words[length]}, $_ if $_ eq join("", sort split(//));
} close FH; print "@{$words[-1]}\n"; </lang> Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Perl 6
<lang Perl 6>my @words; my $maxlen = 0; for slurp("unixdict.txt").lines {
if .chars >= $maxlen and [le] .comb {
if .chars > $maxlen {
@words = ();
$maxlen = .chars;
}
push @words, $_;
}
} say ~@words;</lang> Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
PicoLisp
<lang PicoLisp>(in "unixdict.txt"
(mapc prinl
(maxi '((L) (length (car L)))
(by length group
(filter '((S) (apply <= S))
(make (while (line) (link @))) ) ) ) ) )</lang>
Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Prolog
Works with SWI-Prolog
<lang Prolog>:- use_module(library( http/http_open )).
ordered_words :-
% we read the URL of the words
http_open('http://www.puzzlers.org/pub/wordlists/unixdict.txt', In, []), read_file(In, [], Out), close(In),
% we get a list of pairs key-value where key = Length and value = <list-of-its-codes>
% this list must be sorted
msort(Out, MOut),
group_pairs_by_key(MOut, POut),
% we sorted this list in decreasing order of the length of values
predsort(my_compare, POut, [_N-V | _OutSort]), maplist(mwritef, V).
mwritef(V) :-
writef('%s\n', [V]).
read_file(In, L, L1) :- read_line_to_codes(In, W), ( W == end_of_file ->
% the file is read
L1 = L ;
% we sort the list of codes of the line
% and keep only the "goods word" ( msort(W, W) -> length(W, N), L2 = [N-W | L], (len = 6 -> writef('%s\n', [W]); true) ; L2 = L ),
% and we have the pair Key-Value in the result list
read_file(In, L2, L1)).
% predicate for sorting list of pairs Key-Values % if the lentgh of values is the same % we sort the keys in alhabetic order my_compare(R, K1-_V1, K2-_V2) :- ( K1 < K2 -> R = >; K1 > K2 -> R = <; =). </lang> Output :
?- ordered_words. abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty true.
PureBasic
<lang PureBasic>Procedure.s sortLetters(*word.Character, wordLength) ;returns a string with the letters of a word sorted
Protected Dim letters.c(wordLength) Protected *letAdr = @letters() CopyMemoryString(*word, @*letAdr) SortArray(letters(), #PB_Sort_Ascending, 0, wordLength - 1) ProcedureReturn PeekS(@letters(), wordLength)
EndProcedure
Structure orderedWord
word.s length.i
EndStructure
Define filename.s = "unixdict.txt", fileNum = 0, word.s
If OpenConsole()
NewList orderedWords.orderedWord()
If ReadFile(fileNum, filename)
While Not Eof(fileNum)
word = ReadString(fileNum)
If word = sortLetters(@word, Len(word))
AddElement(orderedWords())
orderedWords()\word = word
orderedWords()\length = Len(word)
EndIf
Wend
EndIf
SortStructuredList(orderedWords(), #PB_Sort_Ascending, OffsetOf(orderedWord\word), #PB_Sort_String)
SortStructuredList(orderedWords(), #PB_Sort_Descending, OffsetOf(orderedWord\length), #PB_Sort_integer)
Define maxLength
FirstElement(orderedWords())
maxLength = orderedWords()\length
ForEach orderedWords()
If orderedWords()\length = maxLength
Print(orderedWords()\word + " ")
EndIf
Next
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</lang> Sample output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Python
<lang python>import urllib.request
url = 'http://www.puzzlers.org/pub/wordlists/unixdict.txt' words = urllib.request.urlopen(url).read().decode("utf-8").split() ordered = [word for word in words if word==.join(sorted(word))] maxlen = len(max(ordered, key=len)) maxorderedwords = [word for word in ordered if len(word) == maxlen] print(' '.join(maxorderedwords))</lang>
Alternate Solution <lang python>import urllib.request
mx, url = 0, 'http://www.puzzlers.org/pub/wordlists/unixdict.txt'
for word in urllib.request.urlopen(url).read().decode("utf-8").split():
lenword = len(word)
if lenword >= mx and word==.join(sorted(word)):
if lenword > mx:
words, mx = [], lenword
words.append(word)
print(' '.join(words))</lang>
Sample Output
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Short local version: <lang python>from itertools import groupby o = (w for w in map(str.strip, open("unixdict.txt")) if sorted(w)==list(w)) print list(next(groupby(sorted(o, key=len, reverse=True), key=len))[1])</lang>
REXX
This problem assumes (or implies) an order of letter case, but fortunately,
there're no uppercase letters in the dictionary.
In ASCII, "A" is less then "a", while in EBCDICI, it's the other way around.
The problem could be solved easily by first converting the word to a specific case,
and then test for ordered letters in the word.
Also, any superflous blanks are removed as the dictionary is read.
<lang rexx>
/*REXX program lists (longest) ordered words from a supplied dictionary.*/
ifid='UNIXDICT.TXT' /*filename of the word dictionary*/
i.= /*placeholder for list of words. */
m=0 /*maximum length of ordered words*/
call linein ifid,1,0 /*point to the first word in dict*/
/*(above)---in case file is open.*/
do j=1 while lines(ifid)\==0 /*keep reading until exhausted. */
x=strip(linein(ifid)) /*read a word from the dictionary*/
w=length(x) /*W is the length of the word. */
if w<m then iterate /*if not long enough, ignore it. */
z=left(x,1) /*now, see if the word is ordered*/
do k=2 to w /*process each letter in the word*/
_=substr(x,k,1) /*get the next letter in the word*/
if \datatype(_,'M') then iterate /*not a letter? Then skip it*/
if _<z then iterate j /*letter < then the previous ? */
z=_ /*we have a newer current letter.*/
end
if w<m then iterate /*bypass adding word if too small*/
m=w /*maybe define a new maximum len.*/
i.w=i.w x /*add the word to a word list. */
end
say words(i.w) 'words found (of length' m")"; say /*show & tell time*/
do n=1 for words(i.w); say word(i.m,n); end /*list the words. */
</lang> Output when using the supplied word dictionary:
16 words found (of length 6) abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Ruby
<lang ruby> require 'open-uri' ordered_words = open('http://www.puzzlers.org/pub/wordlists/unixdict.txt', 'r').select do |word|
word.chomp! word.split( ).sort.join == word
end
grouped = ordered_words.group_by{ |word| word.size } puts grouped[grouped.keys.max] </lang>
Sample Output
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
Scheme
The following implementation uses a char>=? procedure that accepts an arbitrary number of arguments. This is allowed, but not required, by R5RS, and is provided by many Scheme implementations.
<lang scheme> (define ordered-words
(lambda (file)
(let ((port (open-input-file file)))
(let loop ((char (read-char port))
(word '())
(result '(())))
(cond ((eof-object? char)
(reverse (map (lambda (word) (apply string word)) result)))
((eq? #\newline char)
(loop (read-char port) '()
(let ((best-length (length (car result)))
(word-length (length word)))
(cond ((or (< word-length best-length)
(not (apply char>=? word)))
result)
((> word-length best-length)
(list (reverse word)))
(else
(cons (reverse word) result))))))
(else
(loop (read-char port) (cons char word) result)))))))
</lang>
Tcl
<lang tcl>package require http
- Pick the ordered words (of maximal length) from a list
proc chooseOrderedWords list {
set len 0
foreach word $list {
# Condition to determine whether a word is ordered; are its characters # in sorted order? if {$word eq [join [lsort [split $word ""]] ""]} { if {[string length $word] > $len} { set len [string length $word] set orderedOfMaxLen {} } if {[string length $word] == $len} { lappend orderedOfMaxLen $word } }
} return $orderedOfMaxLen
}
- Get the dictionary and print the ordered words from it
set t [http::geturl "http://www.puzzlers.org/pub/wordlists/unixdict.txt"] puts [chooseOrderedWords [http::data $t]] http::cleanup $t</lang> Output:
abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty
TUSCRIPT
<lang tuscript> $$ MODE TUSCRIPT SET data = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt") DICT orderdwords CREATE 99999 COMPILE LOOP word=data
- "<%" = any token SET letters=STRINGS (word,":<%:") SET wordsignatur= ALPHA_SORT (letters) IF (wordsignatur==letters) THEN SET wordlength=LENGTH (word) DICT orderdwords ADD/COUNT word,num,cnt,wordlength ENDIF
ENDLOOP
DICT orderdwords UNLOAD words,num,cnt,wordlength SET maxlength=MAX_LENGTH (words) SET rtable=QUOTES (maxlength) BUILD R_TABLE maxlength = rtable SET index=FILTER_INDEX (wordlength,maxlength,-) SET longestwords=SELECT (words,#index) PRINT num," ordered words - max length is ",maxlength,":"
LOOP n,w=longestwords SET n=CONCAT (n,"."), n=CENTER(n,4) PRINT n,w ENDLOOP ENDCOMPILE </lang> Output:
422 ordered words - max length is 6: 1. abbott 2. accent 3. accept 4. access 5. accost 6. almost 7. bellow 8. billow 9. biopsy 10. chilly 11. choosy 12. choppy 13. effort 14. floppy 15. glossy 16. knotty