Wordle comparison

From Rosetta Code
Task
Wordle comparison
You are encouraged to solve this task according to the task description, using any language you may know.
Rationale

While similar to both Bulls and cows and Mastermind, Wordle is a notable variation, having experienced a viral surge in popularity, and reverse engineering the game or creating variants has become a popular programming exercise. However, a sampling of the "code a Wordle clone" videos on YouTube shows that seven of the eight reviewed had a serious flaw in the way that they assigned colours to the letters of a guessed word. This aspect of the game is described here: en.wikipedia.org/wiki/Wordle#Gameplay

After every guess, each letter is marked as either green, yellow or gray: green indicates that letter is correct and in the correct position, yellow means it is in the answer but not in the right position, while gray indicates it is not in the answer at all. Multiple instances of the same letter in a guess, such as the "o"s in "robot", will be colored green or yellow only if the letter also appears multiple times in the answer; otherwise, excess repeating letters will be colored gray.
Task

Create a function or procedure that takes two strings; the answer string, and the guess string, and returns a string, list, dynamic array or other ordered sequence indicating how each letter should be marked as per the description above. (e.g. "green", "yellow", or "grey", or, equivalently, the integers 2, 1, or 0 or suchlike.)

You can assume that both the answer string and the guess string are the same length, and contain only printable characters/code points in the ASCII/UniCode Range ! to ~ (hex 20 to 7F) and that case is significant. (The original game only uses strings of 5 characters, all alphabetic letters, all in the same case, but this allows for most existing variants of the game.)

Provide test data and show the output here.

The test data should include the answer string ALLOW and the guess string LOLLY, and the result should be (yellow, yellow, green, grey, grey) or equivalent.

ALGOL 68

Test cases copied from C.

# utility functions: #

PROC join = ([]STRING row, STRING joiner) STRING:
  BEGIN
    BOOL first := TRUE;
    STRING result := "";
    FOR i FROM LWB row TO UPB row DO
      IF NOT first THEN result +:= joiner
                   ELSE first := FALSE
      FI;
      result +:= row[i]
    OD;
    result
  END;

PROC fill = (REF []STRING row, STRING s) VOID:
  BEGIN
    FOR i FROM LWB row TO UPB row DO row[i] := s OD
  END;

# actual solution: #

PROC wordle comparison = (STRING word, guess) []STRING:
  BEGIN
    STRING copy := word;
    # we'll just replace matched chars with NULs in copy
      to avoid further matches #
    [UPB guess]STRING result;
    fill(result, "");
    # first the greens: #
    FOR i TO UPB guess DO
      IF i <= UPB copy AND copy[i] = guess[i] THEN
        result[i] := "green";
        copy[i] := REPR 0
      FI
    OD;
    # then the rest: #
    FOR i TO UPB guess DO
      IF result[i] = "" THEN
        FOR j TO UPB copy DO
          IF copy[j] = guess[i] THEN
            result[i] := "yellow";
            copy[j] := REPR 0;
            next
          FI
        OD;
        result[i] := "grey";
        next: SKIP
      FI
    OD;
    result
  END;

[,]STRING pairs = (("ALLOW", "LOLLY"),
                   ("BULLY", "LOLLY"),
                   ("ROBIN", "ALERT"),
                   ("ROBIN", "SONIC"),
                   ("ROBIN", "ROBIN"));
FOR i TO UPB pairs DO
  print((pairs[i,1], " v ", pairs[i,2], " => ",
         join(wordle comparison(pairs[i,1], pairs[i,2]), ", "),
         newline))
OD
Output:
ALLOW v LOLLY => yellow, yellow, green, grey, grey
BULLY v LOLLY => grey, grey, green, green, green
ROBIN v ALERT => grey, grey, grey, yellow, grey
ROBIN v SONIC => grey, green, yellow, green, grey
ROBIN v ROBIN => green, green, green, green, green

C

Translation of: Wren
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

void wordle(const char *answer, const char *guess, int *result) {
    int i, ix, n = strlen(guess);
    char *ptr;
    if (n != strlen(answer)) {
        printf("The words must be of the same length.\n");
        exit(1);
    }
    char answer2[n+1];
    strcpy(answer2, answer);
    for (i = 0; i < n; ++i) {
        if (guess[i] == answer2[i]) {
            answer2[i] = '\v';
            result[i] = 2;
        }
    }
    for (i = 0; i < n; ++i) {
        if ((ptr = strchr(answer2, guess[i])) != NULL) {
            ix = ptr - answer2;
            answer2[ix] = '\v';
            result[i] = 1;
        }
    }
}

int main() {
    int i, j;
    const char *answer, *guess;
    int res[5];
    const char *res2[5];
    const char *colors[3] = {"grey", "yellow", "green"};
    const char *pairs[5][2] = {
        {"ALLOW", "LOLLY"},
        {"BULLY", "LOLLY"},
        {"ROBIN", "ALERT"},
        {"ROBIN", "SONIC"},
        {"ROBIN", "ROBIN"}
    };
    for (i = 0; i < 5; ++i) {
        answer = pairs[i][0];
        guess  = pairs[i][1];
        for (j = 0; j < 5; ++j) res[j] = 0;
        wordle(answer, guess, res);
        for (j = 0; j < 5; ++j) res2[j] = colors[res[j]];
        printf("%s v %s => { ", answer, guess);
        for (j = 0; j < 5; ++j) printf("%d ", res[j]);
        printf("} => { ");
        for (j = 0; j < 5; ++j) printf("%s ", res2[j]);
        printf("}\n");
    }
    return 0;
}
Output:
ALLOW v LOLLY => { 1 1 2 0 0 } => { yellow yellow green grey grey }
BULLY v LOLLY => { 0 0 2 2 2 } => { grey grey green green green }
ROBIN v ALERT => { 0 0 0 1 0 } => { grey grey grey yellow grey }
ROBIN v SONIC => { 0 2 1 2 0 } => { grey green yellow green grey }
ROBIN v ROBIN => { 2 2 2 2 2 } => { green green green green green }

C#

Works with: .NET 8
Translation of: Java
using System;
using System.Collections.Generic;
using System.Linq;

public class WordleComparison
{
    public static void Main(string[] args)
    {
        List<TwoWords> pairs = new List<TwoWords>
        {
            new TwoWords("ALLOW", "LOLLY"),
            new TwoWords("ROBIN", "SONIC"),
            new TwoWords("CHANT", "LATTE"),
            new TwoWords("We're", "She's"),
            new TwoWords("NOMAD", "MAMMA")
        };

        foreach (var pair in pairs)
        {
            Console.WriteLine(pair.Answer + " v " + pair.Guess + " -> " + string.Join(", ", Wordle(pair.Answer, pair.Guess)));
        }
    }

    private static List<Colour> Wordle(string answer, string guess)
    {
        if (answer.Length != guess.Length)
        {
            throw new ArgumentException("The two words must be of the same length.");
        }

        var result = Enumerable.Repeat(Colour.GREY, guess.Length).ToList();
        var answerCopy = answer;

        for (int i = 0; i < guess.Length; i++)
        {
            if (answer[i] == guess[i])
            {
                answerCopy = answerCopy.Remove(i, 1).Insert(i, "\0");
                result[i] = Colour.GREEN;
            }
        }

        for (int i = 0; i < guess.Length; i++)
        {
            int index = answerCopy.IndexOf(guess[i]);
            if (index >= 0 && result[i] != Colour.GREEN)
            {
                answerCopy = answerCopy.Remove(index, 1).Insert(index, "\0");
                result[i] = Colour.YELLOW;
            }
        }

        return result;
    }

    private enum Colour { GREEN, GREY, YELLOW }

    private record TwoWords(string Answer, string Guess);
}
Output:
ALLOW v LOLLY -> YELLOW, YELLOW, GREEN, GREY, GREY
ROBIN v SONIC -> GREY, GREEN, YELLOW, GREEN, GREY
CHANT v LATTE -> GREY, YELLOW, YELLOW, GREY, GREY
We're v She's -> GREY, GREY, YELLOW, YELLOW, GREY
NOMAD v MAMMA -> GREY, YELLOW, GREEN, GREY, GREY

C++

#include <cstdint>
#include <iostream>
#include <stdexcept>
#include <string>
#include <vector>

enum Colour { GREEN, GREY, YELLOW };

const char NIL = '\0';

struct Two_Words {
	std::string answer;
	std::string guess;
};

std::string to_string(const Colour& colour) {
	std::string result;
	switch ( colour ) {
		case Colour::GREEN  : result = "Green";  break;
		case Colour::GREY   : result = "Grey";   break;
		case Colour::YELLOW : result = "Yellow"; break;
	}
	return result;
}

std::vector<Colour> wordle(const std::string& answer, const std::string& guess) {
	const uint32_t guess_length = guess.length();
	if ( answer.length() != guess_length ) {
		throw std::invalid_argument("The two words must have the same length.");
	}

	std::string answerCopy = answer;
	std::vector<Colour> result(guess_length, Colour::GREY);
	for ( uint32_t i = 0; i < guess_length; ++i ) {
		if ( answer[i] == guess[i] ) {
			answerCopy[i] = NIL;
			result[i] = Colour::GREEN;
		}
	}

	for ( uint32_t i = 0; i < guess_length; ++i ) {
		std::string::size_type index = answerCopy.find(guess[i]);
		if ( index != std::string::npos ) {
			answerCopy[index] = NIL;
			result[i] = Colour::YELLOW;
		}
	}
	return result;
}

int main() {
	const std::vector<Two_Words> pairs = { Two_Words("ALLOW", "LOLLY"), Two_Words("ROBIN", "SONIC"),
		Two_Words("CHANT", "LATTE"), Two_Words("We're", "She's"), Two_Words("NOMAD", "MAMMA") };

	for ( const Two_Words& pair : pairs ) {
		std::vector<Colour> colours = wordle(pair.answer, pair.guess);
		std::cout << pair.answer << " v " << pair.guess << " -> [";
		for ( uint32_t i = 0; i < pair.answer.length() - 1; ++i ) {
			std::cout << to_string(colours[i]) << ", ";
		}
		std::cout << to_string(colours.back()) << "]" << std::endl;
	}
}
Output:
ALLOW v LOLLY -> [Yellow, Yellow, Green, Grey, Grey]
ROBIN v SONIC -> [Grey, Green, Yellow, Green, Grey]
CHANT v LATTE -> [Grey, Yellow, Yellow, Grey, Grey]
We're v She's -> [Grey, Grey, Yellow, Yellow, Grey]
NOMAD v MAMMA -> [Grey, Yellow, Green, Grey, Grey]

Delphi

Works with: Delphi version 6.0


{Structure to hold the secret wordle word and a test word}

type TStringPair = record
 Secret,Test: string;
 end;

{Array of test pairs}

const Pairs: array [0..4] of TStringPair = (
	(Secret: 'ALLOW'; Test: 'LOLLY'),
	(Secret: 'BULLY'; Test: 'LOLLY'),
	(Secret: 'ROBIN'; Test: 'ALERT'),
	(Secret: 'ROBIN'; Test: 'SONIC'),
	(Secret: 'ROBIN'; Test: 'ROBIN'));

{Structures holding wordle colors}

type TWordleColors = (wcGreen,wcYellow,wcGrey);
type TWordleArray = array [0..4] of TWordleColors;


function TestWordle(Secret,Test: string): TWordleArray;
{Compare Test string against secret wordle word}
var I,J,Inx: integer;
var SL: TStringList;

	function LetterAvailable(C: char): boolean;
	{Check to see if letter is unused}
	{Decrement count every time letter used}
	var Inx: integer;
	begin
	Result:=False;
	{Is it in the list?}
	Inx:=SL.IndexOf(C);
	{Exit if not}
	if Inx<0 then exit;
	{Decrement count each time a letter is used}
	SL.Objects[Inx]:=Pointer(Integer(SL.Objects[Inx])-1);
	if integer(SL.Objects[Inx])=0 then SL.Delete(Inx);
	Result:=True;
	end;


begin
SL:=TStringList.Create;
try
{Put letters in list and count number of available}
for I:=1 to Length(Secret) do
	begin
	{Already in list?}
	Inx:=SL.IndexOf(Secret[I]);
	{Store it with a count of 1, if not in list, otherwise, increment count}
	if Inx<0 then SL.AddObject(Secret[I],Pointer(1))
	else SL.Objects[Inx]:=Pointer(Integer(SL.Objects[Inx])+1);
	end;
{Set all words to gray}
for I:=0 to High(Result) do Result[I]:=wcGrey;
{Test for exact position match}
for I:=1 to Length(Test) do
 if Test[I]=Secret[I] then
	begin
	{If we haven't used up the letter, mark it green}
	if LetterAvailable(Test[I]) then Result[I-1]:=wcGreen;
	end;
{Test for non-positional match and mark them yellow}
for I:=1 to Length(Test) do
	begin
	{Check of letter available and not already green}
	if LetterAvailable(Test[I]) then
	if Result[I-1]<>wcGreen then Result[I-1]:=wcYellow;
	end;
finally SL.Free; end;
end;


procedure ShowOneWordle(Memo: TMemo; Pair: TStringPair);
{Test one wordle pair and display result}
var S: string;
var I: integer;
var WA: TWordleArray;
begin
{Get color pattern}
WA:=TestWordle(Pair.Secret,Pair.Test);
{Generate text for color pattern}
S:='';
for I:=0 to High(WA) do
 case WA[I] of
  wcGreen: S:=S+' Green';
  wcYellow: S:=S+' Yellow';
  wcGrey: S:=S+' Gray';
  end;
{Display pair and corresponding color pattern}
Memo.Lines.Add(Pair.Secret+' v '+Pair.Test+': '+S);
end;


procedure ShowWordleColors(Memo: TMemo);
{Show all test pairs}
var I: integer;
begin
for I:=0 to High(Pairs) do
 ShowOneWordle(Memo,Pairs[I]);
end;
Output:
ALLOW v LOLLY:  Yellow Yellow Green Gray Gray
BULLY v LOLLY:  Gray Gray Green Green Green
ROBIN v ALERT:  Gray Gray Gray Yellow Gray
ROBIN v SONIC:  Gray Green Yellow Green Gray
ROBIN v ROBIN:  Green Green Green Green Green

Elapsed Time: 4.854 ms.

Forth

: color! ( c i -- ) tuck pad + c! here + 0 swap c! ;

: wordle ( a1 u1 a2 u2 -- a3 u3 )
   2swap here swap move pad over erase dup 0 do
      over i + c@ here i + c@ = if 2 i color! then
   loop dup 0 do
      2dup here swap rot i + 1 search nip nip if 1 i color! then
   loop nip pad swap ;

:noname
   create s" grey" , , s" yellow" , , s" green" , ,
   does> swap 2* cells + 2@ type ; execute color.

: .wordle ( a1 u1 a2 u2 -- )
   2over type ."  v " 2dup type ."  => " wordle
   over + swap do i c@ color. space loop cr ;

:noname
   0 s" ROBIN" 2dup 2dup s" SONIC" 2over s" ALERT"
   s" BULLY" s" LOLLY" s" ALLOW" 2over
   begin ?dup while .wordle repeat ; execute
Output:
ALLOW v LOLLY => yellow yellow green grey grey 
BULLY v LOLLY => grey grey green green green 
ROBIN v ALERT => grey grey grey yellow grey 
ROBIN v SONIC => grey green yellow green grey 
ROBIN v ROBIN => green green green green green

FreeBASIC

Function wordle(Byval respuesta As String, Byval supuesto As String) As String
    Dim As Integer n, i, k
    Dim As String resultado
    
    n = Len(supuesto)
    If 5 <> Len(respuesta) Then
        Print respuesta; ": Expected 5 character target." : Return ""
    Elseif 5 <> Len(supuesto) Then
        Print supuesto; ": Expected 5 character guess." : Return ""
    Elseif n = Len(respuesta) Then
        resultado = Left("0000000000000000000", n)
        For i = 1 To n
            If Mid(supuesto, i, 1) = Mid(respuesta, i, 1) Then
                Mid(respuesta, i, 1) = "0"
                Mid(resultado, i, 1) = "2"
            End If
        Next i
        For i = 1 To n
            k = Instr(respuesta, Mid(supuesto, i, 1))
            If k Then
                Mid(respuesta, k, 1) = "0"
                Mid(resultado, i, 1) = "1"
            End If
        Next i
    Else
        Print "words must be same length"
    End If
    Return resultado
End Function


Data "ALLOW", "LOLLY", "CHANT", "LATTE", "ROBIN", "ALERT", "ROBIN", "SONIC", "ROBIN", "ROBIN"
Data "BULLY", "LOLLY", "ADAPT", "SÅLÅD", "Ukraine", "Ukraíne","BBAAB", "BBBBBAA", "BBAABBB", "AABBBAA"

Dim As String colores(3), respuesta, supuesto, res, res1
colores(0) = "grey" : colores(1) = "yellow" : colores(2) = "green"

Dim As Integer i, j
For i = 1 To 10 '5
    Read respuesta, supuesto
    res = wordle(respuesta, supuesto)
    
    If res <> "" Then
        res1 = ""
        For j = 1 To Len(res)
            res1 &= Mid(res, j, 1) & ", "
        Next j
        
        Print respuesta; " v "; supuesto; " => ["; Left(res1, Len(res1)-2); "] => ";
        
        For j = 1 To Len(res)
            Print using "\      \"; colores(Val(Mid(res, j, 1)));
        Next j
        Print
    End If
Next i
Sleep
Output:
ALLOW v LOLLY => [1, 1, 2, 0, 0] => yellow yellow green  grey   grey
CHANT v LATTE => [0, 1, 1, 0, 0] => grey   yellow yellow grey   grey
ROBIN v ALERT => [0, 0, 0, 1, 0] => grey   grey   grey   yellow grey
ROBIN v SONIC => [0, 2, 1, 2, 0] => grey   green  yellow green  grey
ROBIN v ROBIN => [2, 2, 2, 2, 2] => green  green  green  green  green
BULLY v LOLLY => [0, 0, 2, 2, 2] => grey   grey   green  green  green
ADAPT v S+L+D => [0, 0, 0, 0, 1] => grey   grey   grey   grey   yellow
Ukraine: Expected 5 character target.
BBBBBAA: Expected 5 character guess.
BBAABBB: Expected 5 character target.

FutureBasic

This compact function returns a byte array (as a pstring) with 2, 1, 0, for matched, mismatched, unmatched. It is useful for games up to 15 chars wide, and is case sensitive as specified.

short x = 80, y = 20

clear local fn colorString( w1 as str15, w2 as str15 ) as str15
  str255 n : str15 c : c[0] = w2[0] : short r
  for r = 1 to w1[0]
    if w2[r] = w1[r] then c[r] = 2 else n[w1[r]]++
  next
  for r = 1 to w2[0]
    if c[r] == 0 then if n[w2[r]] then n[w2[r]]-- : c[r] = 1
  next
end fn = c

This function uses the array to display output mimicking the appearance of WORDLE.

mda(0) = {fn ColorDarkGray,fn ColorWithRGB(.7,.6,.3,1),fn ColorWithRGB(.3,.6,.3,1)}
void local fn wordleCompare( wordle as str15, guess as str15 )
  str15 color : short r
  color = fn colorString( wordle, guess )
  text @"menlo bold", 14, fn colorLightGray
  print %( 20, y ) wordle : text ,,fn colorWhite
  for r = 1 to guess[0]
    rect fill ( x, y, 24, 24 ), mda_object( color[r] )
    print %( x + 7.5, y + 1 ) chr$( guess[r] ); : x += 28
  next
  x = 80 : y += 28
end fn

window 1, @"FB Wordle Compare", ( 0, 0, 265, 290 )
WindowSetBackgroundColor( 1, fn Colorblack )
fn wordleCompare( "ALLOW", "LOLLY" )
fn wordleCompare( "CHANT", "LATTE" )
fn wordleCompare( "ROBIN", "SONIC" )
fn wordleCompare( "PROUD", "LEAST" )
fn wordleCompare( "STEAL", "LEAST" )
fn wordleCompare( "LEAST", "LEAST" )
fn wordleCompare( "FULLY", "LABEL" )
fn wordleCompare( "We're", "She's" )
fn wordleCompare("LONGER", "STRING")

handleevents
Output:

File:Wordle Comparison in FutureBasic.png

Go

Translation of: Wren
package main

import (
    "bytes"
    "fmt"
    "log"
)

func wordle(answer, guess string) []int {
    n := len(guess)
    if n != len(answer) {
        log.Fatal("The words must be of the same length.")
    }
    answerBytes := []byte(answer)
    result := make([]int, n) // all zero by default
    for i := 0; i < n; i++ {
        if guess[i] == answerBytes[i] {
            answerBytes[i] = '\000'
            result[i] = 2
        }
    }
    for i := 0; i < n; i++ {
        ix := bytes.IndexByte(answerBytes, guess[i])
        if ix >= 0 {
            answerBytes[ix] = '\000'
            result[i] = 1
        }
    }
    return result
}

func main() {
    colors := []string{"grey", "yellow", "green"}
    pairs := [][]string{
        {"ALLOW", "LOLLY"},
        {"BULLY", "LOLLY"},
        {"ROBIN", "ALERT"},
        {"ROBIN", "SONIC"},
        {"ROBIN", "ROBIN"},
    }
    for _, pair := range pairs {
        res := wordle(pair[0], pair[1])
        res2 := make([]string, len(res))
        for i := 0; i < len(res); i++ {
            res2[i] = colors[res[i]]
        }
        fmt.Printf("%s v %s => %v => %v\n", pair[0], pair[1], res, res2)
    }
}
Output:
ALLOW v LOLLY => [1 1 2 0 0] => [yellow yellow green grey grey]
BULLY v LOLLY => [0 0 2 2 2] => [grey grey green green green]
ROBIN v ALERT => [0 0 0 1 0] => [grey grey grey yellow grey]
ROBIN v SONIC => [0 2 1 2 0] => [grey green yellow green grey]
ROBIN v ROBIN => [2 2 2 2 2] => [green green green green green]

Haskell

import Data.Bifunctor (first)
import Data.List (intercalate, mapAccumL)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)

type Tally = M.Map Char Int

-------------------- WORDLE COMPARISON -------------------

wordleScore :: String -> String -> [Int]
wordleScore target guess =
  snd $
    uncurry (mapAccumL amber) $
      first charCounts $
        mapAccumL green [] (zip target guess)

green :: String -> (Char, Char) -> (String, (Char, Int))
green residue (t, g)
  | t == g = (residue, (g, 2))
  | otherwise = (t : residue, (g, 0))

amber :: Tally -> (Char, Int) -> (Tally, Int)
amber tally (_, 2) = (tally, 2)
amber tally (c, _)
  | 0 < fromMaybe 0 (M.lookup c tally) =
      (M.adjust pred c tally, 1)
  | otherwise = (tally, 0)

charCounts :: String -> Tally
charCounts =
  foldr
    (flip (M.insertWith (+)) 1)
    M.empty

--------------------------- TEST -------------------------
main :: IO ()
main = do
  putStrLn $ intercalate " -> " ["Target", "Guess", "Scores"]
  putStrLn []
  mapM_ (either putStrLn putStrLn) $
    uncurry wordleReport
      <$> [ ("ALLOW", "LOLLY"),
            ("CHANT", "LATTE"),
            ("ROBIN", "ALERT"),
            ("ROBIN", "SONIC"),
            ("ROBIN", "ROBIN"),
            ("BULLY", "LOLLY"),
            ("ADAPT", "SÅLÅD"),
            ("Ukraine", "Ukraíne"),
            ("BBAAB", "BBBBBAA"),
            ("BBAABBB", "AABBBAA")
          ]

wordleReport :: String -> String -> Either String String
wordleReport target guess
  | 5 /= length target =
      Left (target <> ": Expected 5 character target.")
  | 5 /= length guess =
      Left (guess <> ": Expected 5 character guess.")
  | otherwise =
      let scores = wordleScore target guess
       in Right
            ( intercalate
                " -> "
                [ target,
                  guess,
                  show scores,
                  unwords (color <$> scores)
                ]
            )

color 2 = "green"
color 1 = "amber"
color _ = "gray"
Output:
Target -> Guess -> Scores

ALLOW -> LOLLY -> [1,1,2,0,0] -> amber amber green gray gray
CHANT -> LATTE -> [0,1,1,0,0] -> gray amber amber gray gray
ROBIN -> ALERT -> [0,0,0,1,0] -> gray gray gray amber gray
ROBIN -> SONIC -> [0,2,1,2,0] -> gray green amber green gray
ROBIN -> ROBIN -> [2,2,2,2,2] -> green green green green green
BULLY -> LOLLY -> [0,0,2,2,2] -> gray gray green green green
ADAPT -> SÅLÅD -> [0,0,0,0,1] -> gray gray gray gray amber
Ukraine: Expected 5 character target.
BBBBBAA: Expected 5 character guess.
BBAABBB: Expected 5 character target.

J

Implementation (brute force):

wrdcmp=: {{
  yw=.gr=. I.x=y
  key=. '#' gr} x
  for_ch.y do.
    if.ch e. key do.
      key=. '#' (key i.ch)} key
      yw=. yw, ch_index
    end.
  end.
  2 gr} 1 yw} (#y)#0
}}

A bit more efficient (about 3 times faster on task example, which might matter if a few microseconds was important):

wrdcmp=: {{
  yw=. ;(] , ({.~1<.#)@-.)&.>/(<@I.y=/~x#~y~:x),<I.x=y
  2 (I.x=y)} 1 yw} (#y)#0
}}

assert 1 1 2 0 0-: 'allow' wrdcmp 'lolly'
assert 0 0 2 2 2-: 'bully' wrdcmp 'lolly'
assert 0 0 0 1 0-: 'robin' wrdcmp 'alert'
assert 0 2 1 2 0-: 'robin' wrdcmp 'sonic'
assert 2 2 2 2 2-: 'robin' wrdcmp 'robin'
assert 0 0 2 1 0-: 'mamma' wrdcmp 'nomad'
assert 0 1 2 0 0-: 'nomad' wrdcmp 'mamma'

Explanation:

<I.x=y is a box containing the list of exact match indices, and (<@I.y=/~x#~y~:x) is a list of boxes (one box for each character in the guess) of the indices of not-necessarily-exact matches. Meanwhile ({.~1<.#) means "at most one" and operates on lists (so it's empty for an empty list and the first element for a non-empty list).

In other words, we build a list of candidate matches for each character and then, for each character, exclude any already picked index and if there's a remaining candidates, we pick the first of those.

(exact match indices will override inexact match indices, which makes the inexact match index calculation simpler -- we don't have to use a separate type for exact match indices.)

Task example:

   ('allow' wrdcmp 'lolly')&{&.;: 'gray yellow green'
yellow yellow green gray gray

Java

import java.util.List;
import java.util.stream.Collectors;
import java.util.stream.Stream;

public final class WordleComparison {

	public static void main(String[] args) {
		List<TwoWords> pairs = List.of( new TwoWords("ALLOW", "LOLLY"), new TwoWords("ROBIN", "SONIC"),
			new TwoWords("CHANT", "LATTE"), new TwoWords("We're", "She's"), new TwoWords("NOMAD", "MAMMA") );
		
		for ( TwoWords pair : pairs ) {
			System.out.println(pair.answer + " v " + pair.guess + " -> " + wordle(pair.answer, pair.guess));
		}
	}
	
	private static List<Colour> wordle(String answer, String guess) {
		final int guessLength = guess.length();
		if ( answer.length() != guessLength ) {
		    throw new AssertionError("The two words must be of the same length.");
		}
		
		String answerCopy = answer;
		List<Colour> result = Stream.generate( () -> Colour.GREY ).limit(guessLength).collect(Collectors.toList());
		for ( int i = 0; i < guessLength; i++ ) {
		    if ( answer.charAt(i) == guess.charAt(i) ) {
		        answerCopy = answerCopy.substring(0, i) + NULL + answerCopy.substring(i + 1);
		        result.set(i, Colour.GREEN);
		    }
		}
		
		for ( int i = 0; i < guessLength; i++ ) {
		    int index = answerCopy.indexOf(guess.charAt(i));
		    if ( index >= 0 ) {
		        answerCopy = answerCopy.substring(0, index) + NULL + answerCopy.substring(index + 1);
		        result.set(i, Colour.YELLOW);
		    }
		}
		return result;
	}
	
	private enum Colour { GREEN, GREY, YELLOW }
	
	private static record TwoWords(String answer, String guess) {}
	
	private static final char NULL = '\0';

}
Output:
ALLOW v LOLLY -> [YELLOW, YELLOW, GREEN, GREY, GREY]
ROBIN v SONIC -> [GREY, GREEN, YELLOW, GREEN, GREY]
CHANT v LATTE -> [GREY, YELLOW, YELLOW, GREY, GREY]
We're v She's -> [GREY, GREY, YELLOW, YELLOW, GREY]
NOMAD v MAMMA -> [GREY, YELLOW, GREEN, GREY, GREY]

JavaScript

(() => {
    "use strict";

    // ---------------- WORDLE COMPARISON ----------------

    // wordleScore :: (String, String) -> [Int]
    const wordleScore = (target, guess) => {
        // A sequence of integers scoring characters
        // in the guess:
        // 2 for correct character and position
        // 1 for a character which is elsewhere in the target
        // 0 for for character not seen in the target.
        const [residue, scores] = mapAccumL(green)([])(
            zip([...target])([...guess])
        );

        return mapAccumL(amber)(
            charCounts(residue)
        )(scores)[1];
    };


    // green :: String ->
    // (Char, Char) -> (String, (Char, Int))
    const green = residue =>
        // The existing residue of unmatched characters,
        // tupled with a character score of 2 if the target
        // character and guess character match.
        // Otherwise, a residue (extended by the unmatched
        // character) tupled with a character score of 0.
        ([t, g]) => t === g ? (
            Tuple(residue)(Tuple(g)(2))
        ) : Tuple([t, ...residue])(Tuple(g)(0));


    // amber :: Dict -> (Char, Int) -> (Dict, Int)
    const amber = tally =>
        // An adjusted tally of the counts of unmatched
        // of remaining unmatched characters, tupled with
        // a 1 if the character was in the remaining tally
        // (now decremented) and otherwise a 0.
        ([c, n]) => 2 === n ? (
            Tuple(tally)(2)
        ) : Boolean(tally[c]) ? (
            Tuple(
                adjust(x => x - 1)(c)(tally)
            )(1)
        ) : Tuple(tally)(0);


    // ---------------------- TEST -----------------------
    // main :: IO ()
    const main = () => [
            ["ALLOW", "LOLLY"],
            ["CHANT", "LATTE"],
            ["ROBIN", "ALERT"],
            ["ROBIN", "SONIC"],
            ["ROBIN", "ROBIN"],
            ["BULLY", "LOLLY"],
            ["ADAPT", "SÅLÅD"],
            ["Ukraine", "Ukraíne"],
            ["BBAAB", "BBBBBAA"],
            ["BBAABBB", "AABBBAA"]
        ]
        .map(tg => wordleReport(...tg))
        .join("\n");


    // wordleReport :: (String, String) -> String
    const wordleReport = (target, guess) => {
        // Either a message, if target or guess are other than
        // five characters long, or a color-coded wordle score
        // for each character in the guess.

        const scoreNames = ["gray", "amber", "green"];

        return 5 !== target.length ? (
            `${target}: Expected 5 character target.`
        ) : 5 !== guess.length ? (
            `${guess}: Expected 5 character guess.`
        ) : (() => {
            const scores = wordleScore(target, guess);

            return [
                target, guess, JSON.stringify(scores),
                scores.map(n => scoreNames[n])
                .join(" ")
            ].join(" -> ");
        })();
    };

    // --------------------- GENERIC ---------------------

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = a =>
        // A pair of values, possibly of
        // different types.
        b => ({
            type: "Tuple",
            "0": a,
            "1": b,
            length: 2,
            *[Symbol.iterator]() {
                for (const k in this) {
                    if (!isNaN(k)) {
                        yield this[k];
                    }
                }
            }
        });


    // add (+) :: Num a => a -> a -> a
    const add = a =>
        // Curried addition.
        b => a + b;


    // adjust :: (a -> a) -> Key ->
    // Dict Key a -> Dict Key a
    const adjust = f => k => dict =>
        // The orginal dictionary, unmodified, if k is
        // not an existing key.
        // Otherwise, a new copy in which the existing
        // value of k is updated by application of f.
        k in dict ? (
            Object.assign({}, dict, {
                [k]: f(dict[k])
            })
        ) : dict;


    // charCounts :: String -> Dict Char Int
    const charCounts = cs =>
        // Dictionary of chars, with the
        // frequency of each in cs.
        [...cs].reduce(
            (a, c) => insertWith(add)(c)(
                1
            )(a), {}
        );


    // insertWith :: Ord k => (a -> a -> a) ->
    // k -> a -> Map k a -> Map k a
    const insertWith = f =>
        // A new dictionary updated with a (k, f(v)(x)) pair.
        // Where there is no existing v for k, the supplied
        // x is used directly.
        k => x => dict => Object.assign({},
            dict, {
                [k]: k in dict ? (
                    f(dict[k])(x)
                ) : x
            });


    // mapAccumL :: (acc -> x -> (acc, y)) -> acc ->
    // [x] -> (acc, [y])
    const mapAccumL = f =>
        // A tuple of an accumulation and a list
        // obtained by a combined map and fold,
        // with accumulation from left to right.
        acc => xs => [...xs].reduce(
            ([a, bs], x) => second(
                v => bs.concat(v)
            )(
                f(a)(x)
            ),
            Tuple(acc)([])
        );


    // second :: (a -> b) -> ((c, a) -> (c, b))
    const second = f =>
        // A function over a simple value lifted
        // to a function over a tuple.
        // f (a, b) -> (a, f(b))
        ([x, y]) => Tuple(x)(f(y));


    // zip :: [a] -> [b] -> [(a, b)]
    const zip = xs =>
        // The paired members of xs and ys, up to
        // the length of the shorter of the two lists.
        ys => Array.from({
            length: Math.min(xs.length, ys.length)
        }, (_, i) => Tuple(xs[i])(ys[i]));

    // MAIN ---
    return main();
})();
Output:
ALLOW -> LOLLY -> [1,1,2,0,0] -> amber amber green gray gray
CHANT -> LATTE -> [0,1,1,0,0] -> gray amber amber gray gray
ROBIN -> ALERT -> [0,0,0,1,0] -> gray gray gray amber gray
ROBIN -> SONIC -> [0,2,1,2,0] -> gray green amber green gray
ROBIN -> ROBIN -> [2,2,2,2,2] -> green green green green green
BULLY -> LOLLY -> [0,0,2,2,2] -> gray gray green green green
ADAPT -> SÅLÅD -> [0,0,0,0,1] -> gray gray gray gray amber
Ukraine: Expected 5 character target.
BBBBBAA: Expected 5 character guess.
BBAABBB: Expected 5 character target.

jq

Translation of: Wren
Works with: jq

Works with gojq, the Go implementation of jq

def colors: ["grey", "yellow", "green"];
 
def wordle($answer; $guess):
  ($guess|length) as $n
  | if ($answer|length) != $n then "The words must be of the same length." | error
    else { answer: (answer | explode),
           guess:  (guess  | explode),
	   result: [range(0;$n)|0] }
    | reduce range(0; $n) as $i (.;
        if .guess[$i] == .answer[$i]
        then .answer[$i] = 0
        | .result[$i] = 2
        else .
	end )
    | reduce range(0; $n) as $i (.;
        .guess[$i] as $g
        | (.answer | index($g) ) as $ix
        | if $ix
          then .answer[$ix] = 0
          | .result[$i] = 1
          else .
	  end )
    | .result
    end ;
 
def pairs:
    ["ALLOW", "LOLLY"],
    ["BULLY", "LOLLY"],
    ["ROBIN", "ALERT"],
    ["ROBIN", "SONIC"],
    ["ROBIN", "ROBIN"]
;

pairs
| wordle(.[0]; .[1]) as $res
| ($res | map(colors[.])) as $res2
| "\(.[0]) v \(.[1]) => \($res) => \($res2)"
Output:

As for #Wren.

Julia

Translation of: Wren
const colors = ["grey", "yellow", "green"]
 
function wordle(answer, guess)
    n = length(guess)
    length(answer) != n && error("The words must be of the same length.")
    answervector, result = collect(answer), zeros(Int, n)
    for i in 1:n
        if guess[i] == answervector[i]
            answervector[i] = '\0'
            result[i] = 2
        end
    end
    for i in 1:n
        c = guess[i]
        ix = findfirst(isequal(c), answervector)
        if ix != nothing
            answervector[ix] = '\0'
            result[i] = 1
        end
    end
    return result
end
 
const testpairs = [
    ["ALLOW", "LOLLY"],
    ["BULLY", "LOLLY"],
    ["ROBIN", "ALERT"],
    ["ROBIN", "SONIC"],
    ["ROBIN", "ROBIN"]
]
for (pair0, pair1) in testpairs
    res  = wordle(pair0, pair1)
    res2 = [colors[i + 1] for i in res]
    println("$pair0 v $pair1 => $res => $res2")
end
Output:
ALLOW v LOLLY => [1, 1, 2, 0, 0] => ["yellow", "yellow", "green", "grey", "grey"]
BULLY v LOLLY => [0, 0, 2, 2, 2] => ["grey", "grey", "green", "green", "green"]
ROBIN v ALERT => [0, 0, 0, 1, 0] => ["grey", "grey", "grey", "yellow", "grey"]
ROBIN v SONIC => [0, 2, 1, 2, 0] => ["grey", "green", "yellow", "green", "grey"]
ROBIN v ROBIN => [2, 2, 2, 2, 2] => ["green", "green", "green", "green", "green"]

Kotlin

Translation of: Java
fun main() {
    val pairs = listOf(
        TwoWords("ALLOW", "LOLLY"),
        TwoWords("ROBIN", "SONIC"),
        TwoWords("CHANT", "LATTE"),
        TwoWords("We're", "She's"),
        TwoWords("NOMAD", "MAMMA")
    )

    for (pair in pairs) {
        println("${pair.answer} v ${pair.guess} -> ${wordle(pair.answer, pair.guess)}")
    }
}

private fun wordle(answer: String, guess: String): List<Colour> {
    val guessLength = guess.length
    require(answer.length == guessLength) { "The two words must be of the same length." }

    var answerCopy = answer
    val result = MutableList(guessLength) { Colour.GREY }
    for (i in guess.indices) {
        if (answer[i] == guess[i]) {
            answerCopy = answerCopy.substring(0, i) + NULL + answerCopy.substring(i + 1)
            result[i] = Colour.GREEN
        }
    }

    for (i in guess.indices) {
        val index = answerCopy.indexOf(guess[i])
        if (index >= 0) {
            answerCopy = answerCopy.substring(0, index) + NULL + answerCopy.substring(index + 1)
            if (result[i] != Colour.GREEN) {
                result[i] = Colour.YELLOW
            }
        }
    }
    return result
}

private enum class Colour { GREEN, GREY, YELLOW }

private data class TwoWords(val answer: String, val guess: String)

private const val NULL = '\u0000'
Output:
ALLOW v LOLLY -> [YELLOW, YELLOW, GREEN, GREY, GREY]
ROBIN v SONIC -> [GREY, GREEN, YELLOW, GREEN, GREY]
CHANT v LATTE -> [GREY, YELLOW, YELLOW, GREY, GREY]
We're v She's -> [GREY, GREY, YELLOW, YELLOW, GREY]
NOMAD v MAMMA -> [GREY, YELLOW, GREEN, GREY, GREY]

Nim

Translation of: Wren
import std/[strformat, strutils]

type Color {.pure.} = enum Grey = "grey", Yellow = "yellow", Green = "green"

proc wordle(answer, guess: string): seq[Color] =
  let n = guess.len
  if answer.len != n:
    quit "The words must be of the same length.", QuitFailure
  var answer = answer
  result.setLen(n)
  for i in 0..<n:
    if guess[i] == answer[i]:
      answer[i] = '\0'
      result[i] = Green
  for i in 0..<n:
    let ix = answer.find(guess[i])
    if ix >= 0:
      answer[ix] = '\0'
      result[i] = Yellow

const Pairs = [["ALLOW", "LOLLY"],
               ["BULLY", "LOLLY"],
               ["ROBIN", "ALERT"],
               ["ROBIN", "SONIC"],
               ["ROBIN", "ROBIN"]]

for pair in Pairs:
  let res  = wordle(pair[0], pair[1])
  echo &"""{pair[0]} v {pair[1]} → ({res.join(", ")})"""
Output:
ALLOW v LOLLY → (yellow, yellow, green, grey, grey)
BULLY v LOLLY → (grey, grey, green, green, green)
ROBIN v ALERT → (grey, grey, grey, yellow, grey)
ROBIN v SONIC → (grey, green, yellow, green, grey)
ROBIN v ROBIN → (green, green, green, green, green)

PARI/GP

Translation of: Julia
colors = ["grey", "yellow", "green"];

wordle(answer, guess) =
{
    n = #guess;
    if (#answer != n, error("The words must be of the same length."));
    answervector = Vecsmall(answer);
    guessvector = Vecsmall(guess); \\ Convert guess to a vector of ASCII values
    result = vector(n, i, 0);
    for (i = 1, n,
        if (guessvector[i] == answervector[i],
            answervector[i] = 0;
            result[i] = 2;
        );
    );
    for (i = 1, n,
        c = guessvector[i];
        for (j = 1, n,
            if (answervector[j] == c,
                answervector[j] = 0;
                result[i] = 1;
                break;
            );
        );
    );
    result;
}

{
testpairs = [["ALLOW", "LOLLY"], ["BULLY", "LOLLY"], ["ROBIN", "ALERT"], ["ROBIN", "SONIC"], ["ROBIN", "ROBIN"]];
for (i = 1, #testpairs,
    pair = testpairs[i];
    res = wordle(pair[1], pair[2]);
    res2 = vector(#res, j, colors[res[j] + 1]);
    print(pair[1] " v " pair[2] " => " res " => " res2);
)
}
Output:
ALLOW v LOLLY => [1, 1, 2, 0, 0] => ["yellow", "yellow", "green", "grey", "grey"]
BULLY v LOLLY => [0, 0, 2, 2, 2] => ["grey", "grey", "green", "green", "green"]
ROBIN v ALERT => [0, 0, 0, 1, 0] => ["grey", "grey", "grey", "yellow", "grey"]
ROBIN v SONIC => [0, 2, 1, 2, 0] => ["grey", "green", "yellow", "green", "grey"]
ROBIN v ROBIN => [2, 2, 2, 2, 2] => ["green", "green", "green", "green", "green"]

Perl

#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Wordle_comparison
use warnings;

for my $test ( ["ALLOW", "LOLLY"], ["BULLY", "LOLLY"], ["ROBIN", "ALERT"],
  ["ROBIN", "SONIC"], ["ROBIN", "ROBIN"])
  {
  local $_ = join "\n", @$test;
  1 while s/([ -~])(.*\n(??{$` =~ tr!!.!cr}))\1/\0$2\0/;
  1 while s/([ -~])(.*\n.*?)\1/\01$2\01/;
  print "@$test => @{[ qw( green yellow grey )
    [map ord, split //, s/.*\n//r =~ tr/\0\1/\2/cr] ]}\n";
  }
Output:
ALLOW LOLLY => yellow yellow green grey grey
BULLY LOLLY => grey grey green green green
ROBIN ALERT => grey grey grey yellow grey
ROBIN SONIC => grey green yellow green grey
ROBIN ROBIN => green green green green green

Explanation (re-written to be more readable):

use strict;
use warnings;

sub show {
    # print the given string, but convert certain non-printable characters to be visible:
    #  newline -> \n
    #  null \0 -> !
    #  control-A \1 -> ?
    #  control-B \2 -> _
    local $_ = shift;
    s/\n/\\n/g;
    s/\0/!/g;
    s/\01/?/g;
    s/\02/_/g;
    print "$_\n";
}

for my $test ( ["ALLOW", "LOLLY"],
               ["BULLY", "LOLLY"],
               ["ROBIN", "ALERT"],
               ["ROBIN", "SONIC"],
               ["ROBIN", "ROBIN"] )
{
    print "-" x 80, "\n";

    # @$test is two strings.
    # my ($answer, $guess) = @$test

    print "Start\n";
    local $_ = join "\n", @$test;
    show "  '$_'";

    show "Same letter, same position -> \0";
    # For each letter in $answer that also appears in $guess, change the
    # letter to a null character \0.
    #
    # [ -~] matches any letter (any printable character, not \0 or \n).
    #       Could also have used [A-Z]
    #
    # $` the substring before the matched letter
    #
    # tr!!.!cr
    #   !! the set of characters to transliterate (i.e., the empty set)
    #   c - complement the empty set (i.e., all characters)
    #   r - non-destructive: don't modify $` instead just return the resulting string
    #   !.! - change every character of $` to a dot '.'
    #   Could also have used "." x length($`)
    #
    # (??xxx) - use the result of the Perl expression xxx as a regex pattern,
    #    xxx will be some number of dots,
    #    one dot for every character before the matched letter.
    #    (A dot matches any character except newline \n.)
    #
    # \1 matches the same letter again.
    # Results in something like s/(X)(.*\n...)X/\0$2\0/
    #
    # i.e., if letter X from $answer appears in the same position in $guess,
    # then change X to a null character \0 in both $answer and $guess.
    show "  '$_'"
        while s/([ -~])(.*\n(??{$` =~ tr!!.!cr}))\1/\0$2\0/;

    show "Same letter, any position -> \1";
    # [ -~] matches any remaining letter in $answer (again could have used [A-Z]).
    #
    # .*\n anything in $answer after the letter.
    #
    # .*?\1 anything in $guess up to (and including) that same letter.
    # \1 matches whatever letter ([ -~]) matched.
    # The ? causes us to select the left-most occurrence of the letter in
    # $answer (in case there are multiple occurrences).
    #
    # Change that letter to control-A \01 in both $answer and $guess.
    #
    # i.e., if letter X from $answer appears anywhere in $guess, then change X
    # to control-A in both $answer and $guess.
    show "  '$_'"
        while s/([ -~])(.*\n.*?)\1/\01$2\01/;

    print "Discard first word\n";
    # s/.*\n//r
    #   r - non-destructive (return the result without modifying $_)
    s/.*\n//;
    show "  '$_'";

    show "Remaining letters -> \2";
    # tr/\0\1/\2/cr
    #   /\0\1/ - the set of chars to transliterate: \0 null and \1 control-A
    #   c - complement the set of chars (i.e., any char that's not null or control-A)
    #   r - non-destructive
    tr/\0\1/\2/c;
    show "  '$_'";

    # In general: split //, "XYZ" - returns a list ("X", "Y", "Z").
    # Here: split // - returns a string of chars all "\0" or "\1" or "\2".
    my @chars = split //, $_;
    show "  @chars";

    # Change "\0" to integer 0, "\1" to 1, "\2" to 2
    my @indexes = map ord, @chars;
    show "  @indexes";

    # Convert indexes 0-2 to color names.
    my @colors = qw( green yellow grey );
    print "@$test => @{ [ @colors[ @indexes ] ] }\n";
    #print "@$test => @colors[ @indexes ]\n"; # same
}

Phix

Aside: You may be mildly surprised to see the 2nd for loop limit being clobbered like this, but you cannot change the limit mid-loop in Phix (an explicit exit would be far clearer) and hence you can do this.
In practice the for loop takes a private copy of the value of the limit, be that n or more significantly say length(s), and ignores any changes you might subsequently make to it.

with javascript_semantics
function wordle(string answer, guess)
    integer n = length(guess)
    assert(n == length(answer),"words must be same length")
    sequence result = repeat(0,n)
    for i=1 to n do
        if guess[i]=answer[i] then
            answer[i] = '\0'
            result[i] = 2
        end if
    end for
    for i=1 to n do
        n = find(guess[i],answer)
        if n then
            answer[n] = '\0'
            result[i] = 1
        end if
    end for
    return result
end function
 
constant tests = {{"ALLOW", "LOLLY"},
                  {"BULLY", "LOLLY"},
                  {"ROBIN", "ALERT"},
                  {"ROBIN", "SONIC"},
                  {"ROBIN", "ROBIN"}},
         colours = {"grey", "yellow", "green"}
for i=1 to length(tests) do
    string {answer,guess} = tests[i]
    sequence res = wordle(answer,guess),
             rac = extract(colours,sq_add(res,1))
    printf(1,"%s v %s => %v => %v\n",{answer,guess,res,rac})
end for
Output:
ALLOW v LOLLY => {1,1,2,0,0} => {"yellow","yellow","green","grey","grey"}
BULLY v LOLLY => {0,0,2,2,2} => {"grey","grey","green","green","green"}
ROBIN v ALERT => {0,0,0,1,0} => {"grey","grey","grey","yellow","grey"}
ROBIN v SONIC => {0,2,1,2,0} => {"grey","green","yellow","green","grey"}
ROBIN v ROBIN => {2,2,2,2,2} => {"green","green","green","green","green"}

Picat

My preferred representation of textual answer is:

  • correct pos (green): Uppercase
  • correct char (yellow): lowercase + "*"
  • not in word (grey): lowercase


Translation of: Go
main =>
  Pairs = [["ALLOW", "LOLLY"],
           ["BULLY", "LOLLY"],
           ["ROBIN", "ALERT"],
           ["ROBIN", "SONIC"],
           ["ROBIN", "ROBIN"],
           ["ROBBY", "OBBYR"],
           ["ROSETTA", "OSSETAR"]],
  foreach([Answer,Guess] in Pairs)
    [Pres,Res] = wordle(Answer,Guess),
    Len = Res.len,
    printf("%w v %w => %w  %w\n", Answer, Guess, Pres, Res)
  end,
  nl.

wordle(Answer,Guess) = [Presentation,Result =>
  N = Guess.len,
  Answer2 = copy_term(Answer), % don't touch Answer
  if N != Answer.len then
    print("The words must be of the same length.")
  else
    Result = new_list(N,grey), % grey by default
    Presentation = copy_term(Guess).map(to_lowercase),
    foreach(I in 1..N, Guess[I] == Answer2[I])
      Answer2[I] := "",
      Result[I] := green,
      Presentation[I] :=  [to_uppercase(Guess[I])] ++ " "
    end,
    foreach(I in 1..N, Ix = find_first_of(Answer2,Guess[I]), Ix > 0) 
      Answer2[Ix] := "",
      Result[I] := yellow,
      Presentation[I] := [to_lowercase(Guess[I])] ++ "*"
    end
  end.
Output:
ALLOW v LOLLY => [l*,o*,L ,l ,y ]  [yellow,yellow,green,grey,grey]
BULLY v LOLLY => [l ,o ,L ,L ,Y ]  [grey,grey,green,green,green]
ROBIN v ALERT => [a ,l ,e ,r*,t ]  [grey,grey,grey,yellow,grey]
ROBIN v SONIC => [s ,O ,n*,I ,c ]  [grey,green,yellow,green,grey]
ROBIN v ROBIN => [R ,O ,B ,I ,N ]  [green,green,green,green,green]
ROBBY v OBBYR => [o*,b*,B ,y*,r*]  [yellow,yellow,green,yellow,yellow]
ROSETTA v OSSETAR => [o*,s ,S ,E ,t*,a*,r*]  [yellow,grey,green,green,yellow,yellow,yellow]

Python

'''Wordle comparison'''

from functools import reduce
from operator import add


# wordleScore :: String -> String -> [Int]
def wordleScore(target, guess):
    '''A sequence of integers scoring characters
       in the guess:
       2 for correct character and position
       1 for a character which is elsewhere in the target
       0 for for character not seen in the target.
    '''
    return mapAccumL(amber)(
        *first(charCounts)(
            mapAccumL(green)(
                [], zip(target, guess)
            )
        )
    )[1]


# green :: String -> (Char, Char) -> (String, (Char, Int))
def green(residue, tg):
    '''The existing residue of unmatched characters, tupled
       with a character score of 2 if the target character
       and guess character match.
       Otherwise, a residue (extended by the unmatched
       character) tupled with a character score of 0.
    '''
    t, g = tg
    return (residue, (g, 2)) if t == g else (
        [t] + residue, (g, 0)
    )


# amber :: Dict -> (Char, Int) -> (Dict, Int)
def amber(tally, cn):
    '''An adjusted tally of the counts of unmatched
       of remaining unmatched characters, tupled with
       a 1 if the character was in the remaining tally
       (now decremented) and otherwise a 0.
    '''
    c, n = cn
    return (tally, 2) if 2 == n else (
        adjust(
            lambda x: x - 1,
            c, tally
        ),
        1
    ) if 0 < tally.get(c, 0) else (tally, 0)


# ------------------------- TEST -------------------------
# main :: IO ()
def main():
    '''Scores for a set of (Target, Guess) pairs.
    '''
    print(' -> '.join(['Target', 'Guess', 'Scores']))
    print()
    print(
        '\n'.join([
            wordleReport(*tg) for tg in [
                ("ALLOW", "LOLLY"),
                ("CHANT", "LATTE"),
                ("ROBIN", "ALERT"),
                ("ROBIN", "SONIC"),
                ("ROBIN", "ROBIN"),
                ("BULLY", "LOLLY"),
                ("ADAPT", "SÅLÅD"),
                ("Ukraine", "Ukraíne"),
                ("BBAAB", "BBBBBAA"),
                ("BBAABBB", "AABBBAA")
            ]
        ])
    )


# wordleReport :: String -> String -> String
def wordleReport(target, guess):
    '''Either a message, if target or guess are other than
       five characters long, or a color-coded wordle score
       for each character in the guess.
    '''
    scoreName = {2: 'green', 1: 'amber', 0: 'gray'}

    if 5 != len(target):
        return f'{target}: Expected 5 character target.'
    elif 5 != len(guess):
        return f'{guess}: Expected 5 character guess.'
    else:
        scores = wordleScore(target, guess)
        return ' -> '.join([
            target, guess, repr(scores),
            ' '.join([
                scoreName[n] for n in scores
            ])
        ])


# ----------------------- GENERIC ------------------------

# adjust :: (a -> a) -> Key -> Dict -> Dict
def adjust(f, k, dct):
    '''A new copy of the Dict, in which any value for
       the given key has been updated by application of
       f to the existing value.
    '''
    return dict(
        dct,
        **{k: f(dct[k]) if k in dct else None}
    )


# charCounts :: String -> Dict Char Int
def charCounts(s):
    '''A dictionary of the individual characters in s,
       with the frequency of their occurrence.
    '''
    return reduce(
        lambda a, c: insertWith(add)(c)(1)(a),
        list(s),
        {}
    )


# first :: (a -> b) -> ((a, c) -> (b, c))
def first(f):
    '''A simple function lifted to a function over a tuple,
       with f applied only the first of two values.
    '''
    return lambda xy: (f(xy[0]), xy[1])


# insertWith :: Ord k => (a -> a -> a) ->
#   k -> a -> Map k a -> Map k a
def insertWith(f):
    '''A new dictionary updated with a (k, f(v)(x)) pair.
       Where there is no existing v for k, the supplied
       x is used directly.
    '''
    return lambda k: lambda x: lambda dct: dict(
        dct,
        **{k: f(dct[k], x) if k in dct else x}
    )


# mapAccumL :: (acc -> x -> (acc, y)) -> acc ->
# [x] -> (acc, [y])
def mapAccumL(f):
    '''A tuple of an accumulation and a map
       with accumulation from left to right.
    '''
    def nxt(a, x):
        return second(lambda v: a[1] + [v])(
            f(a[0], x)
        )
    return lambda acc, xs: reduce(
        nxt, xs, (acc, [])
    )


# second :: (a -> b) -> ((c, a) -> (c, b))
def second(f):
    '''A simple function lifted to a function over a tuple,
       with f applied only to the second of two values.
    '''
    return lambda xy: (xy[0], f(xy[1]))


# MAIN ---
if __name__ == '__main__':
    main()
Output:
Target -> Guess -> Scores

ALLOW -> LOLLY -> [1, 1, 2, 0, 0] -> amber amber green gray gray
CHANT -> LATTE -> [0, 1, 1, 0, 0] -> gray amber amber gray gray
ROBIN -> ALERT -> [0, 0, 0, 1, 0] -> gray gray gray amber gray
ROBIN -> SONIC -> [0, 2, 1, 2, 0] -> gray green amber green gray
ROBIN -> ROBIN -> [2, 2, 2, 2, 2] -> green green green green green
BULLY -> LOLLY -> [0, 0, 2, 2, 2] -> gray gray green green green
ADAPT -> SÅLÅD -> [0, 0, 0, 0, 1] -> gray gray gray gray amber
Ukraine: Expected 5 character target.
BBBBBAA: Expected 5 character guess.
BBAABBB: Expected 5 character target.

Quackery

  [ tuck witheach 
      [ over i^ peek = while
        2 rot i^ poke
        0 rot i^ poke ]
    witheach 
      [ over find 
        2dup swap found iff 
          [ 1 unrot poke ] 
        else drop ]
    [] swap witheach 
      [ dup 3 < * join ] ]   is wordle-compare ( $ $ --> [ ) 
 
  $ "ALLOW" $ "LOLLY" wordle-compare echo cr 
  $ "BULLY" $ "LOLLY" wordle-compare echo cr 
  $ "ROBIN" $ "ALERT" wordle-compare echo cr
  $ "ROBIN" $ "SONIC" wordle-compare echo cr
  $ "ROBIN" $ "ROBIN" wordle-compare echo cr
Output:

2 is equivalent to green, 1 is equivalent to yellow, 1 is equivalent to grey

[ 1 1 2 0 0 ]
[ 0 0 2 2 2 ]
[ 0 0 0 1 0 ]
[ 0 2 1 2 0 ]
[ 2 2 2 2 2 ]

Raku

Updated to add a proof of concept matching for similarity where commonly found on spoofing domain names. Of course this is just the tip of the iceberg (only comparing results after decomposition) and there are way too many Unicode homoglyphs that can only be matched using a lookup table/database.

# 20220216 Raku programming solution

sub wordle (\answer,\guess where [==] (answer,guess)».chars ) {

   my ($aSet, $gSet, @return) = (answer,guess)».&{ (set .comb.pairs).SetHash }

   (my \intersection = $aSet$gSet).keys».&{ @return[.key] = 'green' }
   ($aSet,$gSet)».&{ $_ ∖= intersection } # purge common subset

   for $gSet.keys.sort -> \trial { # pair 
      @return[trial.key] = 'grey';
      for $aSet.keys -> \actual { # pair
         if [eq] (trial,actual)».value {
            @return[trial.key] = 'yellow'; 
            $aSet{actual}:delete;
            last
         } 
         my @NFD = (trial,actual).map: { .value.NFD }
         if [ne] @NFD and [==] @NFD».first {
            @return[trial.key] = 'azure';
            $aSet{actual}:delete;
            last
         }
      }
   }
   @return
}

say .[0]~' vs '~.[1]~"\t"~ wordle .[0],.[1] for (
<ALLOW LOLLY>, <ROBIN ALERT>, <ROBIN SONIC>, <ROBIN ROBIN>, <BULLY LOLLY>,
<ADAPT SÅLÅD>, <Ukraine Ukraíne>, <BBAABBB BBBBBAA>, <BBAABBB AABBBAA> );
Output:
ALLOW vs LOLLY  yellow yellow green grey grey
ROBIN vs ALERT  grey grey grey yellow grey
ROBIN vs SONIC  grey green yellow green grey
ROBIN vs ROBIN  green green green green green
BULLY vs LOLLY  grey grey green green green
ADAPT vs SÅLÅD	grey azure grey azure yellow
Ukraine vs Ukraíne	green green green green azure green green
BBAABBB vs BBBBBAA      green green yellow yellow green yellow yellow
BBAABBB vs AABBBAA      yellow yellow yellow yellow green grey grey

Scala

Translation of: Java
object WordleComparison extends App {

  case class TwoWords(answer: String, guess: String)
  enum Colour extends Enum[Colour] {
    case GREEN, GREY, YELLOW
  }

  val pairs = List(TwoWords("ALLOW", "LOLLY"), TwoWords("ROBIN", "SONIC"),
    TwoWords("CHANT", "LATTE"), TwoWords("We're", "She's"), TwoWords("NOMAD", "MAMMA"))

  pairs.foreach(pair => println(s"${pair.answer} v ${pair.guess} -> ${wordle(pair.answer, pair.guess)}"))

  def wordle(answer: String, guess: String): List[Colour] = {
    if (answer.length != guess.length) {
      throw new AssertionError("The two words must be of the same length.")
    }

    var answerCopy = answer
    var result = List.fill(guess.length)(Colour.GREY)

    for (i <- guess.indices) {
      if (answer(i) == guess(i)) {
        answerCopy = answerCopy.updated(i, NULL)
        result = result.updated(i, Colour.GREEN)
      }
    }

    for (i <- guess.indices) {
      val index = answerCopy.indexOf(guess(i))
      if (index >= 0 && result(i) != Colour.GREEN) {
        answerCopy = answerCopy.updated(index, NULL)
        result = result.updated(i, Colour.YELLOW)
      }
    }
    result
  }

  val NULL = '\u0000'
}
Output:
ALLOW v LOLLY -> List(YELLOW, YELLOW, GREEN, GREY, GREY)
ROBIN v SONIC -> List(GREY, GREEN, YELLOW, GREEN, GREY)
CHANT v LATTE -> List(GREY, YELLOW, YELLOW, GREY, GREY)
We're v She's -> List(GREY, GREY, YELLOW, YELLOW, GREY)
NOMAD v MAMMA -> List(GREY, YELLOW, GREEN, GREY, GREY)

Swift

enum Colour : CustomStringConvertible {
  case grey
  case yellow
  case green
  
  var description : String {
    switch self {
    case .grey: return "grey"
    case .yellow: return "yellow"
    case .green: return "green"
    }
  }
}

func wordle(answer: String, guess: String) -> [Colour]? {
    guard answer.count == guess.count else {
        return nil
    }
    var a = Array(answer)
    let g = Array(guess)
    let n = a.count
    var result = Array(repeating: Colour.grey, count: n)
    for i in 0..<n {
        if g[i] == a[i] {
            a[i] = "\0"
            result[i] = Colour.green
        }
    }
    for i in 0..<n {
        if let j = a.firstIndex(of: g[i]) {
            a[j] = "\0"
            result[i] = Colour.yellow
        }
    }
    return result
}

let pairs = [("ALLOW", "LOLLY"), ("BULLY", "LOLLY"),
              ("ROBIN", "ALERT"), ("ROBIN", "SONIC"),
              ("ROBIN", "ROBIN")]

for pair in pairs {
    if let result = wordle(answer: pair.0, guess: pair.1) {
        print("\(pair.0) v \(pair.1) => \(result)")
    }
}
Output:
ALLOW v LOLLY => [yellow, yellow, green, grey, grey]
BULLY v LOLLY => [grey, grey, green, green, green]
ROBIN v ALERT => [grey, grey, grey, yellow, grey]
ROBIN v SONIC => [grey, green, yellow, green, grey]
ROBIN v ROBIN => [green, green, green, green, green]

Tailspin

templates wordle
  sink removeFirst
    @: $;
    @wordle: [$@wordle... -> #];
    when <=$@> do ''! @:'';
    otherwise $!
  end removeFirst
  @: [$(1)...];
  [$(2)...] -> \[i](
    when <=$@wordle($i)> do (green:$)! @wordle($i): '';
    otherwise $!
  \) -> \[i](
    when <'' ?($@wordle <[<=$>]>)> do (yellow:$)! $ -> !removeFirst
    when <''> do (grey:$)!
    otherwise $!
  \) !
end wordle

test 'wordle'
  assert ['ALLOW', 'LOLLY'] -> wordle <=[(yellow:'L'), (yellow:'O'), (green:'L'), (grey:'L'), (grey:'Y')]> 'guess LOLLY'
  assert ['ALLOW', 'STALL'] -> wordle <=[(grey:'S'), (grey:'T'), (yellow:'A'), (yellow:'L'), (yellow:'L')]> 'guess STALL'
  assert ['ALLOW', 'ALLEY'] -> wordle <=[(green:'A'), (green:'L'), (green:'L'), (grey:'E'), (grey:'Y')]> 'guess ALLEY'
  assert ['ALLOW', 'ALLOW'] -> wordle <=[(green:'A'), (green:'L'), (green:'L'), (green:'O'), (green:'W')]> 'guess correct'
end 'wordle'

['ALLOW', 'LOLLY'] -> wordle -> !OUT::write
Output:
[yellow=L, yellow=O, green=L, grey=L, grey=Y]

V (Vlang)

Translation of: Go
fn wordle(answer string, guess string) []int {
    n := guess.len
    if n != answer.len {
        println("The words must be of the same length.")
    }
    mut answer_bytes := answer.bytes()
    mut result := []int{len:n} // all zero by default
    for i := 0; i < n; i++ {
        if guess[i] == answer_bytes[i] {
            answer_bytes[i] = u8(000)
            result[i] = 2
        }
    }
    for i := 0; i < n; i++ {
        ix := answer_bytes.index(guess[i])
        if ix >= 0 {
            answer_bytes[ix] = u8(000)
            result[i] = 1
        }
    }
    return result
}
 
fn main() {
    colors := ["grey", "yellow", "green"]
    pairs := [
        ["ALLOW", "LOLLY"],
        ["BULLY", "LOLLY"],
        ["ROBIN", "ALERT"],
        ["ROBIN", "SONIC"],
        ["ROBIN", "ROBIN"],
    ]
    for pair in pairs {
        res := wordle(pair[0], pair[1])
        mut res2 := []string{len: res.len}
        for i := 0; i < res.len; i++ {
            res2[i] = colors[res[i]]
        }
        println("${pair[0]} v ${pair[1]} => $res => $res2\n")
    }
}
Output:
ALLOW v LOLLY => [1, 1, 2, 0, 0] => ['yellow', 'yellow', 'green', 'grey', 'grey']
BULLY v LOLLY => [0, 0, 2, 2, 2] => ['grey', 'grey', 'green', 'green', 'green']
ROBIN v ALERT => [0, 0, 0, 1, 0] => ['grey', 'grey', 'grey', 'yellow', 'grey']
ROBIN v SONIC => [0, 2, 1, 2, 0] => ['grey', 'green', 'yellow', 'green', 'grey']
ROBIN v ROBIN => [2, 2, 2, 2, 2] => ['green', 'green', 'green', 'green', 'green']

Wren

var colors = ["grey", "yellow", "green"]

var wordle = Fn.new { |answer, guess|
    var n = guess.count
    if (answer.count != n) Fiber.abort("The words must be of the same length.")
    answer = answer.toList
    var result = List.filled(n, 0)
    for (i in 0...n) {
        if (guess[i] == answer[i]) {
            answer[i] = "\0"
            result[i] = 2
        }
    }
    for (i in 0...n) {
        var ix = answer.indexOf(guess[i])
        if (ix >= 0) {
            answer[ix] = "\0"
            result[i] = 1
        }
    }
    return result
}

var pairs = [
    ["ALLOW", "LOLLY"],
    ["BULLY", "LOLLY"],
    ["ROBIN", "ALERT"],
    ["ROBIN", "SONIC"],
    ["ROBIN", "ROBIN"]
]
for (pair in pairs) {
    var res  = wordle.call(pair[0], pair[1])
    var res2 = res.map { |i| colors[i] }.toList
    System.print("%(pair[0]) v %(pair[1]) => %(res) => %(res2)")
}
Output:
ALLOW v LOLLY => [1, 1, 2, 0, 0] => [yellow, yellow, green, grey, grey]
BULLY v LOLLY => [0, 0, 2, 2, 2] => [grey, grey, green, green, green]
ROBIN v ALERT => [0, 0, 0, 1, 0] => [grey, grey, grey, yellow, grey]
ROBIN v SONIC => [0, 2, 1, 2, 0] => [grey, green, yellow, green, grey]
ROBIN v ROBIN => [2, 2, 2, 2, 2] => [green, green, green, green, green]

XPL0

string 0;

proc ShowColors(Result);
char Result;
int  Color, I;
[Color:= ["gray   ", "yellow ", "green  "];
for I:= 0 to 4 do
    Text(0, Color(Result(I)));
CrLf(0);
];

func Wordle(Answer, Guess);
char Answer, Guess, Result;
int  I, J;
[Result:= "     ";
for I:= 0 to 4 do
    if Guess(I) = Answer(I) then
        [Result(I):= 2;  Answer(I):= 0]
    else Result(I):= 0;
for I:= 0 to 4 do
    for J:= 0 to 4 do
        if Guess(I) = Answer(J) then
            [Result(I):= 1;  Answer(J):= 0];
return Result;
];

[ShowColors(Wordle("ALLOW", "LOLLY"));
 ShowColors(Wordle("BULLY", "LOLLY"));
 ShowColors(Wordle("ROBIN", "ALERT"));
 ShowColors(Wordle("ROBIN", "SONIC"));
 ShowColors(Wordle("ROBIN", "ROBIN"));
]
Output:
yellow yellow green  gray   gray   
gray   gray   green  green  green  
gray   gray   gray   yellow gray   
gray   green  yellow green  gray   
green  green  green  green  green  

Yabasic

Translation of: Phix
// Rosetta Code problem: http://rosettacode.org/wiki/Wordle_comparison
// by Galileo, 02/2022

sub wordle$(answer$, guess$)
    local n, i, k, result$
    
    n = len(guess$)
    if n = len(answer$) then
        result$ = left$("0000000000000000000", n)
        for i = 1 to n
            if mid$(guess$, i, 1) = mid$(answer$, i, 1) then
                mid$(answer$, i, 1) = "0"
                mid$(result$, i, 1) = "2"
            end if
        next
        for i = 1 to n
            k = instr(answer$, mid$(guess$, i, 1))
            if k then
                mid$(answer$, k, 1) = "0"
                mid$(result$, i, 1) = "1"
            end if
        next
    else
        print "words must be same length"
    end if
    return result$
end sub

data "ALLOW", "LOLLY", "BULLY", "LOLLY", "ROBIN", "ALERT", "ROBIN", "SONIC", "ROBIN", "ROBIN"
dim colours$(3) : colours$(0) = "grey" : colours$(1) = "yellow" : colours$(2) = "green"
         
for i = 1 to 5
    read answer$, guess$
    res$ = wordle$(answer$, guess$)
    print answer$, " v ", guess$, " => ";

    for j = 1 to len(res$)
        print colours$(val(mid$(res$, j, 1))), " ";
    next
    print
next
Output:
ALLOW v LOLLY => yellow yellow green grey grey
BULLY v LOLLY => grey grey green green green
ROBIN v ALERT => grey grey grey yellow grey
ROBIN v SONIC => grey green yellow green grey
ROBIN v ROBIN => green green green green green
---Program done, press RETURN---