Palindrome detection: Difference between revisions
Go solution |
Add YAMLScript sample |
||
(458 intermediate revisions by more than 100 users not shown) | |||
Line 1: | Line 1: | ||
{{task|Text processing}} |
{{task|Text processing}} |
||
[[Category:Recursion]] |
|||
Write at least one function/method (or whatever it is called in your preferred |
|||
[[Category:String manipulation]] |
|||
language) to check if a sequence of characters (or bytes) is |
|||
[[Category:Classic CS problems and programs]] |
|||
a [[wp:Palindrome|palindrome]] or not. The ''function'' must return |
|||
[[Category:Palindromes]] |
|||
a boolean value (or something that can be used as boolean value, like an |
|||
integer). |
|||
A [[wp:Palindrome|palindrome]] is a phrase which reads the same backward and forward. |
|||
It is not mandatory to write also an example code that uses the ''function'', |
|||
unless its usage could be not clear (e.g. the provided recursive C solution |
|||
needs explanation on how to call the function). |
|||
{{task heading}} |
|||
It is not mandatory to handle properly encodings (see [[String length]]), |
|||
i.e. it is admissible that the function does not recognize 'salàlas' as |
|||
palindrome. |
|||
Write a function or program that checks whether a given sequence of characters (or, if you prefer, bytes) |
|||
The function must not ignore spaces and punctuations. The compliance to the |
|||
is a palindrome. |
|||
aforementioned, strict or not, requirements completes the task. |
|||
'''''For extra credit:''''' |
|||
'''Example'''<br> |
|||
* Support Unicode characters. |
|||
An example of a Latin palindrome is the sentence |
|||
* Write a second function (possibly as a wrapper to the first) which detects ''inexact'' palindromes, i.e. phrases that are palindromes if white-space and punctuation is ignored and case-insensitive comparison is used. |
|||
"''In girum imus nocte et consumimur igni''", |
|||
roughly translated as: we walk around in the night and we are burnt by the |
|||
fire (of love). To do your test with it, you must make it all the same case and |
|||
strip spaces. |
|||
{{task heading|Hints}} |
|||
'''Notes'''<br> |
|||
* It might be useful for this task to know how to [[Reversing a string|reverse a string]]. |
* It might be useful for this task to know how to [[Reversing a string|reverse a string]]. |
||
* This task's entries might also form the subjects of the task [[Test a function]]. |
* This task's entries might also form the subjects of the task [[Test a function]]. |
||
{{task heading|Related tasks}} |
|||
{{Related tasks/Word plays}} |
|||
{{Template:Strings}} |
|||
<br><br> |
|||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">F is_palindrome(s) |
|||
R s == reversed(s)</syntaxhighlight> |
|||
=={{header|360 Assembly}}== |
|||
<syntaxhighlight lang="360asm">* Reverse b string 25/06/2018 |
|||
PALINDRO CSECT |
|||
USING PALINDRO,R13 base register |
|||
B 72(R15) skip savearea |
|||
DC 17F'0' savearea |
|||
STM R14,R12,12(R13) prolog |
|||
ST R13,4(R15) " |
|||
ST R15,8(R13) " |
|||
LR R13,R15 " |
|||
LA R8,BB @b[1] |
|||
LA R9,AA+L'AA-1 @a[n-1] |
|||
LA R6,1 i=1 |
|||
LOOPI C R6,=A(L'AA) do i=1 to length(a) |
|||
BH ELOOPI leave i |
|||
MVC 0(1,R8),0(R9) substr(b,i,1)=substr(a,n-i+1,1) |
|||
LA R8,1(R8) @b=@b+1 |
|||
BCTR R9,0 @a=@a-1 |
|||
LA R6,1(R6) i=i+1 |
|||
B LOOPI end do |
|||
ELOOPI XPRNT AA,L'AA print a |
|||
CLC BB,AA if b=a |
|||
BNE SKIP |
|||
XPRNT MSG,L'MSG then print msg |
|||
SKIP L R13,4(0,R13) epilog |
|||
LM R14,R12,12(R13) " |
|||
XR R15,R15 " |
|||
BR R14 exit |
|||
AA DC CL32'INGIRUMIMUSNOCTEETCONSUMIMURIGNI' a |
|||
BB DS CL(L'AA) b |
|||
MSG DC CL23'IT IS A TRUE PALINDROME' |
|||
YREGS |
|||
END PALINDRO</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
INGIRUMIMUSNOCTEETCONSUMIMURIGNI |
|||
IT IS A TRUE PALINDROME |
|||
</pre> |
|||
=={{header|8080 Assembly}}== |
|||
<syntaxhighlight lang="8080asm"> org 100h |
|||
jmp demo |
|||
;;; Is the $-terminated string at DE a palindrome? |
|||
;;; Returns: zero flag set if palindrome |
|||
palin: mov h,d ; Find end of string |
|||
mov l,e |
|||
mvi a,'$' |
|||
cmp m ; The empty string is a palindrome |
|||
rz |
|||
pend: inx h ; Scan until terminator found |
|||
cmp m |
|||
jnz pend |
|||
dcx h ; Move to last byte of text |
|||
ptest: ldax d ; Load char at left pointer |
|||
cmp m ; Compare to char at right pointer |
|||
rnz ; If not equal, not a palindrome |
|||
inx d ; Move pointers |
|||
dcx h |
|||
mov a,d ; Check if left pointer is before right pointer |
|||
cmp h ; High byte |
|||
jc ptest |
|||
mov a,e ; Low byte |
|||
cmp l |
|||
jc ptest |
|||
xra a ; Made it to the end - set zero flag |
|||
ret ; Return |
|||
;;; Test the routine on a few examples |
|||
demo: lxi h,words ; Word list pointer |
|||
loop: mov e,m ; Load word pointer |
|||
inx h |
|||
mov d,m |
|||
inx h |
|||
mov a,e ; Stop when zero reached |
|||
ora d |
|||
rz |
|||
push h ; Keep word list pointer |
|||
call pstr ; Print word |
|||
call palin ; Check if palindrome |
|||
lxi d,no |
|||
jnz print ; Print "no" if not a palindrome |
|||
lxi d,yes ; Print "yes" otherwise |
|||
print: call pstr |
|||
pop h |
|||
jmp loop |
|||
;;; Print strint using CP/M keeping DEHL registers |
|||
pstr: push d |
|||
push h |
|||
mvi c,9 |
|||
call 5 |
|||
pop h |
|||
pop d |
|||
ret |
|||
yes: db ': yes',13,10,'$' |
|||
no: db ': no',13,10,'$' |
|||
words: dw w1,w2,w3,w4,0 |
|||
w1: db 'rotor$' |
|||
w2: db 'racecar$' |
|||
w3: db 'level$' |
|||
w4: db 'rosetta$'</syntaxhighlight> |
|||
{{out}} |
|||
<pre>rotor: yes |
|||
racecar: yes |
|||
level: yes |
|||
rosetta: no</pre> |
|||
=={{header|8086 Assembly}}== |
|||
<syntaxhighlight lang="asm"> cpu 8086 |
|||
org 100h |
|||
section .text |
|||
jmp demo |
|||
;;; Check if the $-terminated string in [DS:SI] is a palindrome. |
|||
;;; Returns with zero flag set if so. |
|||
;;; Destroyed: AL, CX, SI, DI, ES. |
|||
palin: push es ; Set ES=DS. |
|||
pop ds |
|||
mov al,'$' ; Find end of string |
|||
mov cx,-1 |
|||
mov di,si |
|||
repne scasb |
|||
dec di ; Move back to last actual character |
|||
.loop: cmp si,di |
|||
ja .ok ; If SI > DI, it is a palindrome |
|||
lodsb |
|||
dec di ; Compare left character to right character |
|||
cmp al,[di] |
|||
jne .no ; If not equal, not a palindrome |
|||
jmp .loop ; Otherwise, try next pair of characters |
|||
.ok: cmp al,al ; Set zero flag |
|||
.no: ret ; Return |
|||
;;; Try the routine on a couple of strings |
|||
demo: mov si,words |
|||
.loop: lodsw ; Grab word pointer |
|||
test ax,ax ; Zero? |
|||
jz .done ; Then we are done |
|||
mov dx,ax ; Otherwise, print word |
|||
mov ah,9 |
|||
int 21h |
|||
xchg bp,si ; Keep array pointer in BP |
|||
xchg si,dx ; Put word pointer in SI |
|||
call palin ; Check if it is a palindrome |
|||
mov dx,yes ; Print 'yes'... |
|||
jz .print ; ...if it is a palindrome |
|||
mov dx,no ; Otherwise, print 'no' |
|||
.print: int 21h |
|||
xchg si,bp ; Restore array pointer |
|||
jmp .loop ; Get next word. |
|||
.done: ret |
|||
yes: db ': yes',13,10,'$' ; Yes and no |
|||
no: db ': no',13,10,'$' |
|||
words: dw .w1,.w2,.w3,.w4,.w5,0 |
|||
.w1: db 'rotor$' ; Words to check |
|||
.w2: db 'racecar$' |
|||
.w3: db 'level$' |
|||
.w4: db 'redder$' |
|||
.w5: db 'rosetta$'</syntaxhighlight> |
|||
{{out}} |
|||
<pre>rotor: yes |
|||
racecar: yes |
|||
level: yes |
|||
redder: yes |
|||
rosetta: no</pre> |
|||
=={{header|ACL2}}== |
|||
<syntaxhighlight lang="lisp">(defun reverse-split-at-r (xs i ys) |
|||
(if (zp i) |
|||
(mv xs ys) |
|||
(reverse-split-at-r (rest xs) (1- i) |
|||
(cons (first xs) ys)))) |
|||
(defun reverse-split-at (xs i) |
|||
(reverse-split-at-r xs i nil)) |
|||
(defun is-palindrome (str) |
|||
(let* ((lngth (length str)) |
|||
(idx (floor lngth 2))) |
|||
(mv-let (xs ys) |
|||
(reverse-split-at (coerce str 'list) idx) |
|||
(if (= (mod lngth 2) 1) |
|||
(equal (rest xs) ys) |
|||
(equal xs ys)))))</syntaxhighlight> |
|||
=={{header|Acornsoft Lisp}}== |
|||
This is a small Lisp that doesn't have strings; symbols are used instead. <code>Explode</code> takes a symbol and returns a list of single-character symbols, one for each character in the symbol's name. <code>Implode</code> does the reverse. |
|||
Since the exact palindrome tests compares two symbols, it can use <code>eq</code>, and <code>equal</code> isn't needed. |
|||
The character set is ASCII. Given a symbol, <code>ordinal</code> returns the numeric ASCII code of the the first character in the symbol's name. <code>Character</code> goes in the other direction and returns a single-character symbol. |
|||
The peculiar definition of <code>digit-p</code> is because it's not possible to type a symbol that has a digit character as its name, and so the ''between'' comparison has to be defined using the character before '0' and the one after '9'. |
|||
<syntaxhighlight lang="lisp"> |
|||
(defun palindrome-type (text) |
|||
(cond ((exact-palindrom-p text) 'exact) |
|||
((inexact-palindrome-p text) 'inexact) |
|||
(t 'not-a-palindrome))) |
|||
(defun exact-palindrom-p (text) |
|||
(eq text (implode (reverse (explode text))))) |
|||
(defun inexact-palindrome-p (text) |
|||
(exact-palindrom-p (implode (normalise (explode text))))) |
|||
(defun reverse (list (result . ())) |
|||
(map '(lambda (e) (setq result (cons e result))) |
|||
list) |
|||
result) |
|||
(defun normalise (chars) |
|||
(cond ((null chars) |
|||
nil) |
|||
((not (alphanumeric-p (car chars))) |
|||
(normalise (cdr chars))) |
|||
((upper-case-p (car chars)) |
|||
(cons (to-lower-case (car chars)) |
|||
(normalise (cdr chars)))) |
|||
(t |
|||
(cons (car chars) (normalise (cdr chars)))))) |
|||
(defun between-p (lowest-value n highest-value) |
|||
(not (or (lessp n lowest-value) |
|||
(greaterp n highest-value)))) |
|||
(defun alphanumeric-p (ch) |
|||
(or (lower-case-p ch) (upper-case-p ch) (digit-p ch))) |
|||
(defun digit-p (ch) |
|||
(between-p (add1 (ordinal '/)) |
|||
(ordinal ch) |
|||
(sub1 (ordinal ':)))) |
|||
(defun upper-case-p (ch) |
|||
(between-p (ordinal 'A) (ordinal ch) (ordinal 'Z))) |
|||
(defun lower-case-p (ch) |
|||
(between-p (ordinal 'a) (ordinal ch) (ordinal 'z))) |
|||
(defun to-lower-case (ch) |
|||
(character (plus (ordinal ch) |
|||
(difference (ordinal 'a) (ordinal 'A))))) |
|||
(defun examples () |
|||
(map '(lambda (text) |
|||
(printc '!" text '!" |
|||
'! is! (palindrome-type text))) |
|||
'(a |
|||
abba Abba |
|||
abcba |
|||
baba |
|||
Able! was! I! ere! I! saw! Elba!! |
|||
In! girum! imus! nocte,! et! consumimur! igni))) |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
Calling <code>(examples)</code> will output: |
|||
<pre> |
|||
"a" is exact |
|||
"abba" is exact |
|||
"Abba" is inexact |
|||
"abcba" is exact |
|||
"baba" is not-a-palindrome |
|||
"Able was I ere I saw Elba!" is inexact |
|||
"In girum imus nocte, et consumimur igni" is inexact |
|||
</pre> |
|||
=={{header|Action!}}== |
|||
<syntaxhighlight lang="action!">BYTE FUNC Palindrome(CHAR ARRAY s) |
|||
BYTE l,r |
|||
l=1 r=s(0) |
|||
WHILE l<r |
|||
DO |
|||
IF s(l)#s(r) THEN RETURN (0) FI |
|||
l==+1 r==-1 |
|||
OD |
|||
RETURN (1) |
|||
BYTE FUNC IsIgnored(BYTE c) |
|||
IF (c>=' AND c<='/) OR |
|||
(c>=': AND c<='@) OR |
|||
(c>='[ AND c<='_) THEN |
|||
RETURN (1) |
|||
FI |
|||
RETURN (0) |
|||
BYTE FUNC ToUpper(BYTE c) |
|||
IF c>='a AND c<='z THEN |
|||
RETURN (c-'a+'A) |
|||
FI |
|||
RETURN (c) |
|||
BYTE FUNC InexactPalindrome(CHAR ARRAY s) |
|||
BYTE l,r,lc,rc |
|||
l=1 r=s(0) |
|||
WHILE l<r |
|||
DO |
|||
WHILE IsIgnored(s(l)) |
|||
DO |
|||
l==+1 |
|||
IF l>=r THEN RETURN (1) FI |
|||
OD |
|||
WHILE IsIgnored(s(r)) |
|||
DO |
|||
r==-1 |
|||
IF l>=r THEN RETURN (1) FI |
|||
OD |
|||
lc=ToUpper(s(l)) |
|||
rc=ToUpper(s(r)) |
|||
IF lc#rc THEN RETURN (0) FI |
|||
l==+1 r==-1 |
|||
OD |
|||
RETURN (1) |
|||
PROC Test(CHAR ARRAY s) |
|||
IF Palindrome(s) THEN |
|||
PrintF("'%S' is a palindrome%E%E",s) |
|||
ELSEIF InexactPalindrome(s) THEN |
|||
PrintF("'%S' is an inexact palindrome%E%E",s) |
|||
ELSE |
|||
PrintF("'%S' is not a palindrome%E%E",s) |
|||
FI |
|||
RETURN |
|||
PROC Main() |
|||
Test("rotavator") |
|||
Test("13231+464+989=989+464+13231") |
|||
Test("Was it a car or a cat I saw?") |
|||
Test("Did Hannah see bees? Hannah did.") |
|||
Test("This sentence is not a palindrome.") |
|||
Test("123 456 789 897 654 321") |
|||
RETURN</syntaxhighlight> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Palindrome_detection.png Screenshot from Atari 8-bit computer] |
|||
<pre> |
|||
'rotavator' is a palindrome |
|||
'13231+464+989=989+464+13231' is a palindrome |
|||
'Was it a car or a cat I saw?' is an inexact palindrome |
|||
'Did Hannah see bees? Hannah did.' is an inexact palindrome |
|||
'This sentence is not a palindrome.' is not a palindrome |
|||
'123 456 789 897 654 321' is not a palindrome |
|||
</pre> |
|||
=={{header|ActionScript}}== |
=={{header|ActionScript}}== |
||
The following function handles non-ASCII characters properly, since charAt() returns a single Unicode character. |
The following function handles non-ASCII characters properly, since charAt() returns a single Unicode character. |
||
< |
<syntaxhighlight lang="actionscript">function isPalindrome(str:String):Boolean |
||
{ |
{ |
||
for(var first:uint = 0, second:uint = str.length - 1; first < second; first++, second--) |
for(var first:uint = 0, second:uint = str.length - 1; first < second; first++, second--) |
||
if(str.charAt(first) != str.charAt(second)) return false; |
if(str.charAt(first) != str.charAt(second)) return false; |
||
return true; |
return true; |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
< |
<syntaxhighlight lang="ada">function Palindrome (Text : String) return Boolean is |
||
begin |
begin |
||
for Offset in 0..Text'Length / 2 - 1 loop |
for Offset in 0..Text'Length / 2 - 1 loop |
||
Line 45: | Line 408: | ||
end loop; |
end loop; |
||
return True; |
return True; |
||
end Palindrome;</ |
end Palindrome;</syntaxhighlight> |
||
---- |
|||
Ada 2012 version: |
|||
<syntaxhighlight lang="ada"> |
|||
function Palindrome (Text : String) return Boolean is |
|||
(for all i in Text'Range => Text(i)= Text(Text'Last-i+Text'First)); |
|||
</syntaxhighlight> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
{{trans|C}} |
{{trans|C}} |
||
Line 52: | Line 423: | ||
{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}} |
{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}} |
||
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release 1.8.8d.fc9.i386 - except for the '''FORMAT''' and ''printf'' in test}} |
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release 1.8.8d.fc9.i386 - except for the '''FORMAT''' and ''printf'' in test}} |
||
< |
<syntaxhighlight lang="algol68"># Iterative # |
||
PROC palindrome = (STRING s)BOOL:( |
PROC palindrome = (STRING s)BOOL:( |
||
FOR i TO UPB s OVER 2 DO |
FOR i TO UPB s OVER 2 DO |
||
IF s[i] /= s[UPB s-i+1] THEN GO TO return false FI |
IF s[i] /= s[UPB s-i+1] THEN GO TO return false FI |
||
OD; |
OD;Power |
||
else: TRUE EXIT |
else: TRUE EXIT |
||
return false: FALSE |
return false: FALSE |
||
Line 77: | Line 448: | ||
printf((template, t, palindrome(t))); |
printf((template, t, palindrome(t))); |
||
printf((template, t, palindrome r(t))) |
printf((template, t, palindrome r(t))) |
||
)</ |
)</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
sequence "ingirumimusnocteetconsumimurigni" is a palindrome |
sequence "ingirumimusnocteetconsumimurigni" is a palindrome |
||
Line 84: | Line 455: | ||
</pre> |
</pre> |
||
=={{header| |
=={{header|APL}}== |
||
NARS2000 APL, dynamic function "if the argument matches the reverse of the argument", with Unicode character support: |
|||
<lang AutoHotkey>MsgBox % isPalindrome("in girum imus nocte et consumimur igni") ; returns 1 for true |
|||
<syntaxhighlight lang="apl"> {⍵≡⌽⍵} 'abc' |
|||
0 |
|||
{⍵≡⌽⍵} '⍋racecar⍋' |
|||
1</syntaxhighlight> |
|||
Or in tacit function form, a combination of three functions, right tack (echo), reverse, then the result of each compared with the middle one, match (equals): |
|||
<syntaxhighlight lang="apl"> (⊢≡⌽) 'abc' |
|||
0 |
|||
(⊢≡⌽) 'nun' |
|||
1</syntaxhighlight> |
|||
An inexact version is harder, because uppercase and lowercase with Unicode awareness depends on APL interpreter; NARS2000 has no support for it. Classic case conversion means lookup up the letters in an alphabet of UppercaseLowercase, then mapping those positions into an UppercaseUppercase or LowercaseLowercase array. Remove non-A-Za-z first to get rid of punctuation, and get an inexact dynamic function with just English letter support: |
|||
<syntaxhighlight lang="apl">inexact←{Aa←(⎕A,⎕a) ⋄ (⊢≡⌽)(⎕a,⎕a)[Aa⍳⍵/⍨⍵∊Aa]} |
|||
inexact 'abc,-cbA2z' |
|||
0 |
|||
inexact 'abc,-cbA2' |
|||
1</syntaxhighlight> |
|||
Dyalog APL has a Unicode-aware uppercase/lowercase function (819 I-beam), AFAIK no support for looking up Unicode character classes. |
|||
=={{header|AppleScript}}== |
|||
isPalindrome(str) { |
|||
str := RegexReplace(str, "\W+") |
|||
Using post-Yosemite AppleScript (to pull in lowercaseStringWithLocale from Foundation classes) |
|||
If (StrLen(str) < 2) ; single character strings are palindromes |
|||
<syntaxhighlight lang="applescript">use framework "Foundation" |
|||
Return true |
|||
Else |
|||
------ CASE-INSENSITIVE PALINDROME, IGNORING SPACES ? ---- |
|||
If (SubStr(str, 1, 1) = SubStr(str, 0, 1)) ; if the first character |
|||
Return isPalindrome(SubStr(str, 2, -1)) ; is same as last character, recurse |
|||
-- isPalindrome :: String -> Bool |
|||
Else |
|||
on isPalindrome(s) |
|||
Return false |
|||
s = intercalate("", reverse of characters of s) |
|||
}</lang> |
|||
end isPalindrome |
|||
-- toSpaceFreeLower :: String -> String |
|||
on spaceFreeToLower(s) |
|||
script notSpace |
|||
on |λ|(s) |
|||
s is not space |
|||
end |λ| |
|||
end script |
|||
intercalate("", filter(notSpace, characters of toLower(s))) |
|||
end spaceFreeToLower |
|||
--------------------------- TEST ------------------------- |
|||
on run |
|||
isPalindrome(spaceFreeToLower("In girum imus nocte et consumimur igni")) |
|||
--> true |
|||
end run |
|||
-------------------- GENERIC FUNCTIONS ------------------- |
|||
-- filter :: (a -> Bool) -> [a] -> [a] |
|||
on filter(f, xs) |
|||
tell mReturn(f) |
|||
set lst to {} |
|||
set lng to length of xs |
|||
repeat with i from 1 to lng |
|||
set v to item i of xs |
|||
if |λ|(v, i, xs) then set end of lst to v |
|||
end repeat |
|||
return lst |
|||
end tell |
|||
end filter |
|||
-- intercalate :: Text -> [Text] -> Text |
|||
on intercalate(strText, lstText) |
|||
set {dlm, my text item delimiters} to {my text item delimiters, strText} |
|||
set strJoined to lstText as text |
|||
set my text item delimiters to dlm |
|||
return strJoined |
|||
end intercalate |
|||
-- Lift 2nd class handler function into 1st class script wrapper |
|||
-- mReturn :: Handler -> Script |
|||
on mReturn(f) |
|||
if class of f is script then |
|||
f |
|||
else |
|||
script |
|||
property |λ| : f |
|||
end script |
|||
end if |
|||
end mReturn |
|||
-- toLower :: String -> String |
|||
on toLower(str) |
|||
set ca to current application |
|||
((ca's NSString's stringWithString:(str))'s ¬ |
|||
lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text |
|||
end toLower</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>true</pre> |
|||
---- |
|||
===Core language only=== |
|||
It's not clear if "sequence of characters" means an array thereof or a single piece of text. But the basic method in AppleScript would be: |
|||
<syntaxhighlight lang="applescript">on isPalindrome(txt) |
|||
set txt to join(txt, "") -- In case the input's a list (array). |
|||
return (txt = join(reverse of txt's characters, "")) |
|||
end isPalindrome |
|||
on join(lst, delim) |
|||
set astid to AppleScript's text item delimiters |
|||
set AppleScript's text item delimiters to delim |
|||
set txt to lst as text |
|||
set AppleScript's text item delimiters to astid |
|||
return txt |
|||
end join |
|||
return isPalindrome("Radar")</syntaxhighlight> |
|||
Text comparisons in AppleScript are case-insensitive by default, so: |
|||
{{output}} |
|||
<syntaxhighlight lang="applescript">true</syntaxhighlight> |
|||
If case is to be taken into account, the call to the handler can be enclosed in a 'considering case' control statement. |
|||
<syntaxhighlight lang="applescript">considering case |
|||
return isPalindrome("Radar") |
|||
end considering</syntaxhighlight> |
|||
{{output}} |
|||
<syntaxhighlight lang="applescript">false</syntaxhighlight> |
|||
It's also possible to "ignore" white space, hyphens, and punctuation, which are considered by default. And of course case can be ignored explicitly, if desired, to ensure that this condition's in force during the call to the handler. The attributes can be combined in one statement. So to check for inexact palindromicity (if that's a word): |
|||
<syntaxhighlight lang="applescript">ignoring case, white space, hyphens and punctuation |
|||
return isPalindrome("Was it a 😀car, or a c😀at-I-saw?") |
|||
end ignoring</syntaxhighlight> |
|||
{{output}} |
|||
<syntaxhighlight lang="applescript">true</syntaxhighlight> |
|||
=={{header|Applesoft BASIC}}== |
|||
<syntaxhighlight lang="applesoftbasic">100 DATA"MY DOG HAS FLEAS" |
|||
110 DATA"MADAM, I'M ADAM." |
|||
120 DATA"1 ON 1" |
|||
130 DATA"IN GIRUM IMUS NOCTE ET CONSUMIMUR IGNI" |
|||
140 DATA"A man, a plan, a canal: Panama!" |
|||
150 DATA"KAYAK" |
|||
160 DATA"REDDER" |
|||
170 DATA"H" |
|||
180 DATA"" |
|||
200 FOR L1 = 1 TO 9 |
|||
210 READ W$ : GOSUB 300" IS PALINDROME? |
|||
220 PRINT CHR$(34); W$; CHR$(34); " IS "; |
|||
230 IF NOT PALINDROME THEN PRINT "NOT "; |
|||
240 PRINT "A PALINDROME" |
|||
250 NEXT |
|||
260 END |
|||
300 REMIS PALINDROME? |
|||
310 PA = 1 |
|||
320 L = LEN(W$) |
|||
330 IF L = 0 THEN RETURN |
|||
340 FOR L0 = 1 TO L / 2 + .5 |
|||
350 PA = MID$(W$, L0, 1) = MID$(W$, L - L0 + 1, 1) |
|||
360 IF PALINDROME THEN NEXT L0 |
|||
370 RETURN</syntaxhighlight> |
|||
=={{header|ARM Assembly}}== |
|||
<syntaxhighlight lang="text">@ Check whether the ASCII string in [r0] is a palindrome |
|||
@ Returns with zero flag set if palindrome. |
|||
palin: mov r1,r0 @ Find end of string |
|||
1: ldrb r2,[r1],#1 @ Grab character and increment pointer |
|||
tst r2,r2 @ Zero yet? |
|||
bne 1b @ If not try next byte |
|||
sub r1,r1,#2 @ Move R1 to last actual character. |
|||
2: cmp r0,r1 @ When R0 >= R1, |
|||
cmpgt r2,r2 @ make sure zero is set, |
|||
bxeq lr @ and stop (the string is a palindrome). |
|||
ldrb r2,[r1],#-1 @ Grab [R1] (end) and decrement. |
|||
ldrb r3,[r0],#1 @ Grab [R0] (begin) and increment |
|||
cmp r2,r3 @ Are they equal? |
|||
bxne lr @ If not, it's not a palindrome. |
|||
b 2b @ Otherwise, try next pair. |
|||
@ Try the function on a couple of strings |
|||
.global _start |
|||
_start: ldr r8,=words @ Word pointer |
|||
1: ldr r9,[r8],#4 @ Grab word and move pointer |
|||
tst r9,r9 @ Null? |
|||
moveq r7,#1 @ Then we're done; syscall 1 = exit |
|||
swieq #0 |
|||
mov r1,r9 @ Print the word |
|||
bl print |
|||
mov r0,r9 @ Test if the word is a palindrome |
|||
bl palin |
|||
ldreq r1,=yes @ "Yes" if it is a palindrome |
|||
ldrne r1,=no @ "No" if it's not a palindrome |
|||
bl print |
|||
b 1b @ Next word |
|||
@ Print zero-terminated string [r1] using Linux syscall |
|||
print: push {r7,lr} @ Keep R7 and link register |
|||
mov r2,r1 @ Find end of string |
|||
1: ldrb r0,[r2],#1 @ Grab character and increment pointer |
|||
tst r0,r0 @ Zero yet? |
|||
bne 1b @ If not, keep going |
|||
sub r2,r2,r1 @ Calculate length of string (bytes to write) |
|||
mov r0,#1 @ Stdout = 1 |
|||
mov r7,#4 @ Syscall 4 = write |
|||
swi #0 @ Make the syscall |
|||
pop {r7,lr} @ Restore R7 and link register |
|||
bx lr |
|||
@ Strings |
|||
yes: .asciz ": yes\n" @ Output yes or no |
|||
no: .asciz ": no\n" |
|||
w1: .asciz "rotor" @ Words to test |
|||
w2: .asciz "racecar" |
|||
w3: .asciz "level" |
|||
w4: .asciz "redder" |
|||
w5: .asciz "rosetta" |
|||
words: .word w1,w2,w3,w4,w5,0</syntaxhighlight> |
|||
{{out}} |
|||
<pre>rotor: yes |
|||
racecar: yes |
|||
level: yes |
|||
redder: yes |
|||
rosetta: no</pre> |
|||
=={{header|Arturo}}== |
|||
<syntaxhighlight lang="rebol">palindrome?: $[seq] -> seq = reverse seq |
|||
loop ["abba" "boom" "radar" "civic" "great"] 'wrd [ |
|||
print [wrd ": palindrome?" palindrome? wrd] |
|||
]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>abba : palindrome? true |
|||
boom : palindrome? false |
|||
radar : palindrome? true |
|||
civic : palindrome? true |
|||
great : palindrome? false</pre> |
|||
=={{header|AutoHotkey}}== |
|||
Reversing the string: |
|||
<syntaxhighlight lang="autohotkey">IsPalindrome(Str){ |
|||
Loop, Parse, Str |
|||
ReversedStr := A_LoopField . ReversedStr |
|||
return, (ReversedStr == Str)?"Exact":(RegExReplace(ReversedStr,"\W")=RegExReplace(Str,"\W"))?"Inexact":"False" |
|||
}</syntaxhighlight> |
|||
=={{header|AutoIt}}== |
=={{header|AutoIt}}== |
||
<lang AutoIt>;AutoIt Version: 3.2.10.0 |
|||
<syntaxhighlight lang="autoit">;== AutoIt Version: 3.3.8.1 |
|||
$mystring="In girum imus nocte, et consumimur igni" |
|||
MsgBox(0, "Palindrome", $mystring & " is palindrome: " & isPalindrome($mystring)) |
|||
;output is: "In girum imus nocte, et consumimur igni is palindrome: True" |
|||
$mystring="Madam, I'm Adam." |
|||
MsgBox(0, "Palindrome", $mystring & " is palindrome: " & isPalindrome($mystring)) |
|||
;output is: "Madam, I'm Adam. is palindrome: True" |
|||
$mystring="no salàlas no" |
|||
MsgBox(0, "Palindrome", $mystring & " is palindrome: " & isPalindrome($mystring)) |
|||
;output is: "no salàlas no is palindrome: False" |
|||
Global $aString[7] = [ _ |
|||
Func isPalindrome($Str_palindrome) |
|||
"In girum imus nocte, et consumimur igni", _ ; inexact palindrome |
|||
$palindrome="False" |
|||
"Madam, I'm Adam.", _ ; inexact palindrome |
|||
$Str_palindrome=StringLower($Str_palindrome) |
|||
"salàlas", _ ; exact palindrome |
|||
$str_length = StringLen($Str_palindrome) |
|||
"radar", _ ; exact palindrome |
|||
$new_str="" ;to rebuild string with only alphanumeric characters |
|||
"Lagerregal", _ ; exact palindrome |
|||
"Ein Neger mit Gazelle zagt im Regen nie.", _ ; inexact palindrome |
|||
For $i = 1 to $str_length |
|||
"something wrong"] ; no palindrome |
|||
$nth_chr = StringTrimRight(StringRight($Str_palindrome, $i),$i-1) |
|||
Global $sSpace42 = " " |
|||
if StringIsAlpha($nth_chr) Then |
|||
$new_str=$new_str & $nth_chr ; add in string if alphabet |
|||
For $i = 0 To 6 |
|||
If _IsPalindrome($aString[$i]) Then |
|||
ConsoleWrite('"' & $aString[$i] & '"' & StringLeft($sSpace42, 42-StringLen($aString[$i])) & 'is an exact palindrome.' & @LF) |
|||
$new_str=$new_str & $nth_chr ; add in string if numeric |
|||
Else |
|||
EndIf |
|||
If _IsPalindrome( StringRegExpReplace($aString[$i], '\W', '') ) Then |
|||
ConsoleWrite('"' & $aString[$i] & '"' & StringLeft($sSpace42, 42-StringLen($aString[$i])) & 'is an inexact palindrome.' & @LF) |
|||
Next |
|||
Else |
|||
$Str_palindrome=$new_str ;string without punctuations and spaces |
|||
ConsoleWrite('"' & $aString[$i] & '"' & StringLeft($sSpace42, 42-StringLen($aString[$i])) & 'is not a palindrome.' & @LF) |
|||
$Str_reverse=reverse($Str_palindrome) ;reverse this string |
|||
EndIf |
|||
EndIf |
|||
;compare characters from both strings until half string is compared |
|||
Next |
|||
For $i=1 to $str_length/2 |
|||
$First=StringLeft($Str_palindrome, 1) |
|||
$Last=StringLeft($Str_reverse, 1) |
|||
If $First == $Last Then |
|||
$palindrome="True" |
|||
EndIf |
|||
Next |
|||
Return $palindrome |
|||
EndFunc |
|||
Func _IsPalindrome($_string) |
|||
; returns reverse of input string |
|||
Local $iLen = StringLen($_string) |
|||
Func reverse($string) |
|||
For $i = 1 To Int($iLen/2) |
|||
If StringMid($_string, $i, 1) <> StringMid($_string, $iLen-($i-1), 1) Then Return False |
|||
$rev_str = "" |
|||
Next |
|||
For $i = 1 to $str_length |
|||
Return True |
|||
$rev_str = $rev_str & StringTrimRight(StringRight($string, $i), $i-1) |
|||
Next |
|||
Return $rev_str |
|||
EndFunc |
EndFunc |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
<syntaxhighlight lang="text"> |
|||
"In girum imus nocte, et consumimur igni" is an inexact palindrome. |
|||
"Madam, I'm Adam." is an inexact palindrome. |
|||
"salàlas" is an exact palindrome. |
|||
"radar" is an exact palindrome. |
|||
"Lagerregal" is an exact palindrome. |
|||
"Ein Neger mit Gazelle zagt im Regen nie." is an inexact palindrome. |
|||
"something wrong" is not a palindrome. |
|||
</syntaxhighlight> |
|||
--[[User:BugFix|BugFix]] ([[User talk:BugFix|talk]]) 14:26, 13 November 2013 (UTC) |
|||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
Line 159: | Line 761: | ||
See [[Reversing a string]]. |
See [[Reversing a string]]. |
||
< |
<syntaxhighlight lang="awk">function is_palindro(s) |
||
{ |
{ |
||
if ( s == reverse(s) ) return 1 |
if ( s == reverse(s) ) return 1 |
||
return 0 |
return 0 |
||
}</ |
}</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="awk">function is_palindro_r(s) |
||
{ |
{ |
||
if ( length(s) < 2 ) return 1 |
if ( length(s) < 2 ) return 1 |
||
if ( substr(s, 1, 1) != substr(s, length(s), 1) ) return 0 |
if ( substr(s, 1, 1) != substr(s, length(s), 1) ) return 0 |
||
return is_palindro_r(substr(s, 2, length(s)-2)) |
return is_palindro_r(substr(s, 2, length(s)-2)) |
||
}</ |
}</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="awk">BEGIN { |
||
pal = "ingirumimusnocteetconsumimurigni" |
pal = "ingirumimusnocteetconsumimurigni" |
||
print is_palindro(pal) |
print is_palindro(pal) |
||
print is_palindro_r(pal) |
print is_palindro_r(pal) |
||
}</ |
}</syntaxhighlight> |
||
=={{header|BaCon}}== |
|||
<syntaxhighlight lang="freebasic"> |
|||
OPTION COMPARE TRUE |
|||
INPUT "Enter your line... ", word$ |
|||
IF word$ = REVERSE$(word$) THEN |
|||
PRINT "This is an exact palindrome!" |
|||
ELIF EXTRACT$(word$, "[[:punct:]]|[[:blank:]]", TRUE) = REVERSE$(EXTRACT$(word$, "[[:punct:]]|[[:blank:]]", TRUE)) THEN |
|||
PRINT "This is an inexact palindrome!" |
|||
ELSE |
|||
PRINT "Not a palindrome." |
|||
ENDIF |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Enter your line... In girum imus nocte, et consumimur igni |
|||
This is an inexact palindrome! |
|||
Enter your line... Madam, I'm Adam. |
|||
This is an inexact palindrome! |
|||
Enter your line... radar |
|||
This is an exact palindrome! |
|||
Enter your line... Something else |
|||
Not a palindrome. |
|||
</pre> |
|||
=={{header|Bash}}== |
|||
<syntaxhighlight lang="bash"> |
|||
#! /bin/bash |
|||
# very simple way to detect a palindrome in Bash |
|||
# output of bash --version -> GNU bash, version 4.4.7(1)-release x86_64 ... |
|||
echo "enter a string" |
|||
read input |
|||
size=${#input} |
|||
count=0 |
|||
while (($count < $size)) |
|||
do |
|||
array[$count]=${input:$count:1} |
|||
(( count+=1 )) |
|||
done |
|||
count=0 |
|||
for ((i=0 ; i < $size; i+=1)) |
|||
do |
|||
if [ "${array[$i]}" == "${array[$size - $i - 1]}" ] |
|||
then |
|||
(( count += 1 )) |
|||
fi |
|||
done |
|||
if (( $count == $size )) |
|||
then |
|||
echo "$input is a palindrome" |
|||
fi |
|||
</syntaxhighlight> |
|||
=={{header|BASIC}}== |
=={{header|BASIC}}== |
||
{{works with|QBasic}} |
{{works with|QBasic}} |
||
<syntaxhighlight lang="qbasic">' OPTION _EXPLICIT ' For QB64. In VB-DOS remove the underscore. |
|||
<lang qbasic>DECLARE FUNCTION isPalindrome% (what AS STRING) |
|||
DIM txt$ |
|||
DATA "My dog has fleas", "Madam, I'm Adam.", "1 on 1", "In girum imus nocte et consumimur igni" |
|||
' Palindrome |
|||
DIM L1 AS INTEGER, w AS STRING |
|||
CLS |
|||
FOR L1 = 1 TO 4 |
|||
PRINT "This is a palindrome detector program." |
|||
READ w |
|||
PRINT |
|||
IF isPalindrome(w) THEN |
|||
INPUT "Please, type a word or phrase: ", txt$ |
|||
PRINT CHR$(34); w; CHR$(34); " is a palindrome" |
|||
ELSE |
|||
IF IsPalindrome(txt$) THEN |
|||
PRINT CHR$(34); w; CHR$(34); " is not a palindrome" |
|||
PRINT "Is a palindrome." |
|||
ELSE |
|||
PRINT "Is Not a palindrome." |
|||
END IF |
|||
END |
|||
FUNCTION IsPalindrome (AText$) |
|||
' Var |
|||
DIM CleanTXT$, RvrsTXT$ |
|||
CleanTXT$ = CleanText$(AText$) |
|||
RvrsTXT$ = RvrsText$(CleanTXT$) |
|||
IsPalindrome = (CleanTXT$ = RvrsTXT$) |
|||
END FUNCTION |
|||
FUNCTION CleanText$ (WhichText$) |
|||
' Var |
|||
DIM i%, j%, c$, NewText$, CpyTxt$, AddIt%, SubsTXT$ |
|||
CONST False = 0, True = NOT False |
|||
SubsTXT$ = "AIOUE" |
|||
CpyTxt$ = UCASE$(WhichText$) |
|||
j% = LEN(CpyTxt$) |
|||
FOR i% = 1 TO j% |
|||
c$ = MID$(CpyTxt$, i%, 1) |
|||
' See if it is a letter. Includes Spanish letters. |
|||
SELECT CASE c$ |
|||
CASE "A" TO "Z" |
|||
AddIt% = True |
|||
CASE " ", "¡", "¢", "£" |
|||
c$ = MID$(SubsTXT$, ASC(c$) - 159, 1) |
|||
AddIt% = True |
|||
CASE "‚" |
|||
c$ = "E" |
|||
AddIt% = True |
|||
CASE "¤" |
|||
c$ = "¥" |
|||
AddIt% = True |
|||
CASE ELSE |
|||
AddIt% = False |
|||
END SELECT |
|||
IF AddIt% THEN |
|||
NewText$ = NewText$ + c$ |
|||
END IF |
END IF |
||
NEXT |
NEXT i% |
||
CleanText$ = NewText$ |
|||
FUNCTION isPalindrome% (what AS STRING) |
|||
DIM whatcopy AS STRING, chk AS STRING, tmp AS STRING * 1, L0 AS INTEGER |
|||
END FUNCTION |
|||
FOR L0 = 1 TO LEN(what) |
|||
tmp = UCASE$(MID$(what, L0, 1)) |
|||
SELECT CASE tmp |
|||
CASE "A" TO "Z" |
|||
whatcopy = whatcopy + tmp |
|||
chk = tmp + chk |
|||
CASE "0" TO "9" |
|||
PRINT "Numbers are cheating! ("; CHR$(34); what; CHR$(34); ")" |
|||
isPalindrome = 0 |
|||
EXIT FUNCTION |
|||
END SELECT |
|||
NEXT |
|||
FUNCTION RvrsText$ (WhichText$) |
|||
isPalindrome = ((whatcopy) = chk) |
|||
' Var |
|||
END FUNCTION</lang> |
|||
DIM i%, c$, NewText$, j% |
|||
j% = LEN(WhichText$) |
|||
Output: |
|||
FOR i% = 1 TO j% |
|||
"My dog has fleas" is not a palindrome |
|||
NewText$ = MID$(WhichText$, i%, 1) + NewText$ |
|||
"Madam, I'm Adam." is a palindrome |
|||
NEXT i% |
|||
Numbers are cheating! ("1 on 1") |
|||
"1 on 1" is not a palindrome |
|||
RvrsText$ = NewText$ |
|||
"In girum imus nocte et consumimur igni" is a palindrome |
|||
END FUNCTION</syntaxhighlight> |
|||
{{out}} |
|||
This is a palindrome detector program. |
|||
Please, type a word or phrase: Madam, I'm Adam. |
|||
Is a palindrome. |
|||
This is a palindrome detector program. |
|||
Please, type a word or phrase: This is just a test. |
|||
Is not a palindrome. |
|||
==={{header|IS-BASIC}}=== |
|||
<syntaxhighlight lang="is-basic"> |
|||
100 PROGRAM "Palindr.bas" |
|||
110 LINE INPUT PROMPT "Text: ":TX$ |
|||
120 PRINT """";TX$;""" is "; |
|||
130 IF PALIND(TX$) THEN |
|||
140 PRINT "a palindrome." |
|||
150 ELSE |
|||
160 PRINT "not a palindrome." |
|||
170 END IF |
|||
180 DEF TRIM$(TX$) |
|||
190 LET T$="" |
|||
200 FOR I=1 TO LEN(TX$) |
|||
210 IF TX$(I)>="A" AND TX$(I)<="Z" THEN LET T$=T$&TX$(I) |
|||
220 NEXT |
|||
230 LET TRIM$=T$ |
|||
240 END DEF |
|||
250 DEF PALIND(TX$) |
|||
260 LET PALIND=-1:LET TX$=TRIM$(UCASE$(TX$)) |
|||
270 FOR I=1 TO LEN(TX$)/2 |
|||
280 IF TX$(I)<>TX$(LEN(TX$)-I+1) THEN LET PALIND=0:EXIT FOR |
|||
290 NEXT |
|||
300 END DEF</syntaxhighlight> |
|||
==={{header|Sinclair ZX81 BASIC}}=== |
|||
====Exact palindrome==== |
|||
The specification suggests, but does not insist, that we reverse the input string and then test for equality; this algorithm is more efficient. |
|||
<syntaxhighlight lang="basic"> 10 INPUT S$ |
|||
20 FOR I=1 TO LEN S$/2 |
|||
30 IF S$(I)<>S$(LEN S$-I+1) THEN GOTO 60 |
|||
40 NEXT I |
|||
50 GOTO 70 |
|||
60 PRINT "NOT A "; |
|||
70 PRINT "PALINDROME"</syntaxhighlight> |
|||
====Inexact palindrome==== |
|||
Add the following lines to convert the program into an inexact-palindrome checker (i.e. one that ignores non-alphabetic characters). The resulting program still works with only 1k of RAM. The ZX81 only supports its own character set, which does not include lower case, so that case-insensitive comparison and <i>a fortiori</i> Unicode are not possible. |
|||
<syntaxhighlight lang="basic"> 15 GOSUB 90 |
|||
80 STOP |
|||
90 LET T$="" |
|||
100 FOR I=1 TO LEN S$ |
|||
110 IF S$(I)>="A" AND S$(I)<="Z" THEN LET T$=T$+S$(I) |
|||
120 NEXT I |
|||
130 LET S$=T$ |
|||
140 RETURN</syntaxhighlight> |
|||
==={{header|BBC BASIC}}=== |
|||
<syntaxhighlight lang="bbcbasic"> test$ = "A man, a plan, a canal: Panama!" |
|||
PRINT """" test$ """" ; |
|||
IF FNpalindrome(FNletters(test$)) THEN |
|||
PRINT " is a palindrome" |
|||
ELSE |
|||
PRINT " is not a palindrome" |
|||
ENDIF |
|||
END |
|||
DEF FNpalindrome(A$) = (A$ = FNreverse(A$)) |
|||
DEF FNreverse(A$) |
|||
LOCAL B$, P% |
|||
FOR P% = LEN(A$) TO 1 STEP -1 |
|||
B$ += MID$(A$,P%,1) |
|||
NEXT |
|||
= B$ |
|||
DEF FNletters(A$) |
|||
LOCAL B$, C%, P% |
|||
FOR P% = 1 TO LEN(A$) |
|||
C% = ASC(MID$(A$,P%)) |
|||
IF C% > 64 AND C% < 91 OR C% > 96 AND C% < 123 THEN |
|||
B$ += CHR$(C% AND &5F) |
|||
ENDIF |
|||
NEXT |
|||
= B$</syntaxhighlight> |
|||
{{out}} |
|||
<pre>"A man, a plan, a canal: Panama!" is a palindrome</pre> |
|||
=={{header|Batch File}}== |
|||
<syntaxhighlight lang="dos">@echo off |
|||
setlocal enabledelayedexpansion |
|||
set /p string=Your string : |
|||
set count=0 |
|||
:loop |
|||
if "!%string%:~%count%,1!" neq "" ( |
|||
set reverse=!%string%:~%count%,1!!reverse! |
|||
set /a count+=1 |
|||
goto loop |
|||
) |
|||
set palindrome=isn't |
|||
if "%string%"=="%reverse%" set palindrome=is |
|||
echo %string% %palindrome% a palindrome. |
|||
pause |
|||
exit</syntaxhighlight> |
|||
Or, recursive (and without setlocal enabledelayedexpansion) (compatible with ReactOS cmd.exe) |
|||
<syntaxhighlight lang="dos">@echo off |
|||
set /p testString=Your string (all same case please) : |
|||
call :isPalindrome result %testString: =% |
|||
if %result%==1 echo %testString% is a palindrome |
|||
if %result%==0 echo %testString% isn't a palindrome |
|||
pause |
|||
goto :eof |
|||
:isPalindrome |
|||
set %1=0 |
|||
set string=%2 |
|||
if "%string:~2,1%"=="" ( |
|||
set %1=1 |
|||
goto :eof |
|||
) |
|||
if "%string:~0,1%"=="%string:~-1%" ( |
|||
call :isPalindrome %1 %string:~1,-1% |
|||
) |
|||
goto :eof</syntaxhighlight> |
|||
=={{header|BCPL}}== |
|||
<syntaxhighlight lang="bcpl">get "libhdr" |
|||
let palindrome(s) = valof |
|||
$( let l = s%0 |
|||
for i = 1 to l/2 |
|||
unless s%i = s%(l+1-i) |
|||
resultis false |
|||
resultis true |
|||
$) |
|||
let inexact(s) = valof |
|||
$( let temp = vec 1+256/BYTESPERWORD |
|||
temp%0 := 0 |
|||
for i = 1 to s%0 do |
|||
$( let ch = s%i | 32 |
|||
if '0'<=ch & ch<='9' | 'a'<=ch & ch<='z' then |
|||
$( temp%0 := temp%0 + 1 |
|||
temp%(temp%0) := ch |
|||
$) |
|||
$) |
|||
resultis palindrome(temp) |
|||
$) |
|||
let check(s) = |
|||
palindrome(s) -> "exact palindrome", |
|||
inexact(s) -> "inexact palindrome", |
|||
"not a palindrome" |
|||
let start() be |
|||
$( let tests = vec 8 |
|||
tests!0 := "rotor" |
|||
tests!1 := "racecar" |
|||
tests!2 := "RACEcar" |
|||
tests!3 := "level" |
|||
tests!4 := "redder" |
|||
tests!5 := "rosetta" |
|||
tests!6 := "A man, a plan, a canal: Panama" |
|||
tests!7 := "Egad, a base tone denotes a bad age" |
|||
tests!8 := "This is not a palindrome" |
|||
for i = 0 to 8 do |
|||
writef("'%S': %S*N", tests!i, check(tests!i)) |
|||
$)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>'rotor': exact palindrome |
|||
'racecar': exact palindrome |
|||
'RACEcar': inexact palindrome |
|||
'level': exact palindrome |
|||
'redder': exact palindrome |
|||
'rosetta': not a palindrome |
|||
'A man, a plan, a canal: Panama': inexact palindrome |
|||
'Egad, a base tone denotes a bad age': inexact palindrome |
|||
'This is not a palindrome': not a palindrome</pre> |
|||
=={{header|Befunge}}== |
=={{header|Befunge}}== |
||
Line 229: | Line 1,113: | ||
The following code reads a line from stdin and prints "True" if it is a palindrome, or False" otherwise. |
The following code reads a line from stdin and prints "True" if it is a palindrome, or False" otherwise. |
||
< |
<syntaxhighlight lang="befunge">v_$0:8p>:#v_:18p08g1-08p >:08g`!v |
||
~->p5p ^ 0v1p80-1g80vj!-g5g80g5_0'ev |
~->p5p ^ 0v1p80-1g80vj!-g5g80g5_0'ev |
||
:a^80+1:g8<>8g1+:18pv>0"eslaF">:#,_@ |
:a^80+1:g8<>8g1+:18pv>0"eslaF">:#,_@ |
||
[[relet]]-2010------>003-x -^"Tru"<</ |
[[relet]]-2010------>003-x -^"Tru"<</syntaxhighlight> |
||
{{works with|Befunge|93}} |
{{works with|Befunge|93}} |
||
Line 243: | Line 1,127: | ||
* The potential palindrome can be no longer than 76 characters (which beats the previous version's 11), and ''everything'' (spaces, punctuation, capitalization, etc.) is considered part of the palindrome. (Best to just use lower case letters and ''nothing else''.) |
* The potential palindrome can be no longer than 76 characters (which beats the previous version's 11), and ''everything'' (spaces, punctuation, capitalization, etc.) is considered part of the palindrome. (Best to just use lower case letters and ''nothing else''.) |
||
< |
<syntaxhighlight lang="befunge">v> "emordnilap a toN",,,,,,,,,,,,,,,,@,,,,,,,,,,,,,,,"Is a palindrome" < |
||
2^ < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
2^ < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
||
4 ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v |
4 ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v |
||
Line 260: | Line 1,144: | ||
>09g8p09g1+09pv |
>09g8p09g1+09pv |
||
|: < < |
|: < < |
||
^<</ |
^<</syntaxhighlight> |
||
=={{header|BQN}}== |
|||
3 functions in three different styles to check if a string is a palindrome. All three forms return 1 for palindrome, and 0 for non-palindrome. |
|||
BQN considers characters as single units, and hence the functions support unicode by default. |
|||
<syntaxhighlight lang="bqn">Pal ← ≡⊸⌽ |
|||
Pal1 ← ⊢≡⌽ |
|||
Pal2 ← {𝕩≡⌽𝕩}</syntaxhighlight> |
|||
=={{header|Bracmat}}== |
|||
<syntaxhighlight lang="bracmat">( ( palindrome |
|||
= a |
|||
. @(!arg:(%?a&utf$!a) ?arg !a) |
|||
& palindrome$!arg |
|||
| utf$!arg |
|||
) |
|||
& ( desep |
|||
= x |
|||
. @(!arg:?x (" "|"-"|",") ?arg) |
|||
& !x desep$!arg |
|||
| !arg |
|||
) |
|||
& "In girum imus nocte et consumimur igni" |
|||
"Я иду с мечем, судия" |
|||
"The quick brown fox" |
|||
"tregða, gón, reiði - er nóg að gert" |
|||
"人人為我,我為人人" |
|||
"가련하시다 사장집 아들딸들아 집장사 다시 하련가" |
|||
: ?candidates |
|||
& whl |
|||
' ( !candidates:%?candidate ?candidates |
|||
& out |
|||
$ ( !candidate |
|||
is |
|||
( palindrome$(low$(str$(desep$!candidate))) |
|||
& indeed |
|||
| not |
|||
) |
|||
a |
|||
palindrome |
|||
) |
|||
) |
|||
& |
|||
);</syntaxhighlight> |
|||
Output: |
|||
<pre>In girum imus nocte et consumimur igni is indeed a palindrome |
|||
Я иду с мечем, судия is indeed a palindrome |
|||
The quick brown fox is not a palindrome |
|||
tregða, gón, reiði - er nóg að gert is indeed a palindrome |
|||
人人為我,我為人人 is indeed a palindrome |
|||
가련하시다 사장집 아들딸들아 집장사 다시 하련가 |
|||
is |
|||
indeed |
|||
a |
|||
palindrome |
|||
</pre> |
|||
=={{header|Bruijn}}== |
|||
<syntaxhighlight lang="bruijn"> |
|||
:import std/String . |
|||
main [<~>0 =? 0] |
|||
:test (main "tacocat") ([[1]]) |
|||
:test (main "bruijn") ([[0]]) |
|||
</syntaxhighlight> |
|||
=={{header|Burlesque}}== |
|||
<syntaxhighlight lang="burlesque"> |
|||
zz{ri}f[^^<-== |
|||
</syntaxhighlight> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
Line 271: | Line 1,228: | ||
and if the length is odd, the middle doesn't need to be checked (so it's okay to do integer division by 2, which rounds down). |
and if the length is odd, the middle doesn't need to be checked (so it's okay to do integer division by 2, which rounds down). |
||
< |
<syntaxhighlight lang="c">#include <string.h> |
||
int palindrome(const char *s) |
int palindrome(const char *s) |
||
Line 282: | Line 1,239: | ||
} |
} |
||
return 1; |
return 1; |
||
}</ |
}</syntaxhighlight> |
||
More idiomatic version: |
More idiomatic version: |
||
< |
<syntaxhighlight lang="c">int palindrome(const char *s) |
||
{ |
{ |
||
const char *t; /* t is a pointer that traverses backwards from the end */ |
const char *t; /* t is a pointer that traverses backwards from the end */ |
||
Line 293: | Line 1,250: | ||
} |
} |
||
return 1; |
return 1; |
||
}</ |
}</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
Line 300: | Line 1,257: | ||
itself a palindrome. |
itself a palindrome. |
||
< |
<syntaxhighlight lang="c">int palindrome_r(const char *s, int b, int e) |
||
{ |
{ |
||
if ( e <= |
if ( (e - 1) <= b ) return 1; |
||
if ( s[b] != s[e-1] ) return 0; |
if ( s[b] != s[e-1] ) return 0; |
||
return palindrome_r(s, b+1, e-1); |
return palindrome_r(s, b+1, e-1); |
||
}</ |
}</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
#include <string.h> |
#include <string.h> |
||
/* testing */ |
/* testing */ |
||
Line 323: | Line 1,280: | ||
t, palindrome_r(t, 0, l) ? "" : "n't"); |
t, palindrome_r(t, 0, l) ? "" : "n't"); |
||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
=={{header|C++}}== |
|||
The C solutions also work in C++, but C++ allows a simpler one: |
|||
<lang cpp>#include <string> |
|||
#include <algorithm> |
|||
bool is_palindrome(std::string const& s) |
|||
{ |
|||
return std::equal(s.begin(), s.end(), s.rbegin()); |
|||
}</lang> |
|||
=={{header|C sharp|C#}}== |
=={{header|C sharp|C#}}== |
||
Line 339: | Line 1,286: | ||
'''Non-recursive''' |
'''Non-recursive''' |
||
< |
<syntaxhighlight lang="csharp">using System; |
||
class Program |
class Program |
||
Line 359: | Line 1,306: | ||
Console.WriteLine(IsPalindrome("ingirumimusnocteetconsumimurigni")); |
Console.WriteLine(IsPalindrome("ingirumimusnocteetconsumimurigni")); |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
'''Using LINQ operators''' |
|||
<syntaxhighlight lang="csharp">using System; |
|||
using System.Linq; |
|||
class Program |
|||
{ |
|||
static bool IsPalindrome(string text) |
|||
{ |
|||
return text == new String(text.Reverse().ToArray()); |
|||
} |
|||
static void Main(string[] args) |
|||
{ |
|||
Console.WriteLine(IsPalindrome("ingirumimusnocteetconsumimurigni")); |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
'''No string reversal''' |
|||
Reversing a string is very slow. A much faster way is to simply compare characters. |
|||
<syntaxhighlight lang="csharp">using System; |
|||
static class Program |
|||
{ |
|||
//As an extension method (must be declared in a static class) |
|||
static bool IsPalindrome(this string sentence) |
|||
{ |
|||
for (int l = 0, r = sentence.Length - 1; l < r; l++, r--) |
|||
if (sentence[l] != sentence[r]) return false; |
|||
return true; |
|||
} |
|||
static void Main(string[] args) |
|||
{ |
|||
Console.WriteLine("ingirumimusnocteetconsumimurigni".IsPalindrome()); |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|C++}}== |
|||
The C solutions also work in C++, but C++ allows a simpler one: |
|||
<syntaxhighlight lang="cpp">#include <string> |
|||
#include <algorithm> |
|||
bool is_palindrome(std::string const& s) |
|||
{ |
|||
return std::equal(s.begin(), s.end(), s.rbegin()); |
|||
}</syntaxhighlight> |
|||
Or, checking half is sufficient (on odd-length strings, this will ignore the middle element): |
|||
<syntaxhighlight lang="cpp">#include <string> |
|||
#include <algorithm> |
|||
bool is_palindrome(std::string const& s) |
|||
{ |
|||
return std::equal(s.begin(), s.begin()+s.length()/2, s.rbegin()); |
|||
}</syntaxhighlight> |
|||
=={{header|Clojure}}== |
=={{header|Clojure}}== |
||
< |
<syntaxhighlight lang="clojure">(defn palindrome? [s] |
||
(= s ( |
(= s (clojure.string/reverse s)))</syntaxhighlight> |
||
'''lower-level, but somewhat faster''' |
|||
'''Recursive''' |
|||
< |
<syntaxhighlight lang="clojure">(defn palindrome? [^String s] |
||
(loop [ |
(loop [front 0 back (dec (.length s))] |
||
(or (>= front back) |
|||
( |
(and (= (.charAt s front) (.charAt s back)) |
||
( |
(recur (inc front) (dec back)))))</syntaxhighlight> |
||
(recur (inc i) (dec j)) |
|||
:else false)))</lang> |
|||
'''Test''' |
'''Test''' |
||
Line 381: | Line 1,384: | ||
false |
false |
||
</pre> |
</pre> |
||
=={{header|CLU}}== |
|||
<syntaxhighlight lang="clu">% Reverse a string |
|||
str_reverse = proc (s: string) returns (string) |
|||
chs: array[char] := array[char]$predict(0, string$size(s)) |
|||
for c: char in string$chars(s) do |
|||
array[char]$addl(chs, c) |
|||
end |
|||
return (string$ac2s(chs)) |
|||
end str_reverse |
|||
% 'Normalize' a string (remove everything but letters and make uppercase) |
|||
normalize = proc (s: string) returns (string) |
|||
chs: array[char] := array[char]$predict(0, string$size(s)) |
|||
for c: char in string$chars(s) do |
|||
if c>='a' cand c<='z' then |
|||
c := char$i2c(char$c2i(c) - 32) |
|||
end |
|||
if c>='A' cand c<='Z' then |
|||
array[char]$addh(chs, c) |
|||
end |
|||
end |
|||
return (string$ac2s(chs)) |
|||
end normalize |
|||
% Check if a string is an exact palindrome |
|||
palindrome = proc (s: string) returns (bool) |
|||
return (s = str_reverse(s)) |
|||
end palindrome |
|||
% Check if a string is an inexact palindrome |
|||
inexact_palindrome = proc (s: string) returns (bool) |
|||
return (palindrome(normalize(s))) |
|||
end inexact_palindrome |
|||
% Test cases |
|||
start_up = proc () |
|||
po: stream := stream$primary_output() |
|||
tests: array[string] := array[string]$[ |
|||
"rotor", "racecar", "RACEcar", "level", "rosetta", |
|||
"A man, a plan, a canal: Panama", |
|||
"Egad, a base tone denotes a bad age", |
|||
"This is not a palindrome" |
|||
] |
|||
for test: string in array[string]$elements(tests) do |
|||
stream$puts(po, "\"" || test || "\": ") |
|||
if palindrome(test) then |
|||
stream$putl(po, "exact palindrome") |
|||
elseif inexact_palindrome(test) then |
|||
stream$putl(po, "inexact palindrome") |
|||
else |
|||
stream$putl(po, "not a palindrome") |
|||
end |
|||
end |
|||
end start_up</syntaxhighlight> |
|||
{{out}} |
|||
<pre>"rotor": exact palindrome |
|||
"racecar": exact palindrome |
|||
"RACEcar": inexact palindrome |
|||
"level": exact palindrome |
|||
"rosetta": not a palindrome |
|||
"A man, a plan, a canal: Panama": inexact palindrome |
|||
"Egad, a base tone denotes a bad age": inexact palindrome |
|||
"This is not a palindrome": not a palindrome</pre> |
|||
=={{header|COBOL}}== |
|||
{{works with|GnuCOBOL}} |
|||
<syntaxhighlight lang="cobol"> identification division. |
|||
function-id. palindromic-test. |
|||
data division. |
|||
linkage section. |
|||
01 test-text pic x any length. |
|||
01 result pic x. |
|||
88 palindromic value high-value |
|||
when set to false low-value. |
|||
procedure division using test-text returning result. |
|||
set palindromic to false |
|||
if test-text equal function reverse(test-text) then |
|||
set palindromic to true |
|||
end-if |
|||
goback. |
|||
end function palindromic-test. |
|||
</syntaxhighlight> |
|||
=={{header|CoffeeScript}}== |
|||
<syntaxhighlight lang="coffeescript"> |
|||
String::isPalindrome = -> |
|||
for i in [0...@length / 2] when @[i] isnt @[@length - (i + 1)] |
|||
return no |
|||
yes |
|||
String::stripped = -> @toLowerCase().replace /\W/gi, '' |
|||
console.log "'#{ str }' : #{ str.stripped().isPalindrome() }" for str in [ |
|||
'In girum imus nocte et consumimur igni' |
|||
'A man, a plan, a canal: Panama!' |
|||
'There is no spoon.' |
|||
] |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
'In girum imus nocte et consumimur igni' : true |
|||
'A man, a plan, a canal: Panama!' : true |
|||
'There is no spoon.' : false |
|||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
< |
<syntaxhighlight lang="lisp">(defun palindrome-p (s) |
||
(string= s (reverse s)))</ |
(string= s (reverse s)))</syntaxhighlight> |
||
===Alternate solution=== |
|||
I use [https://franz.com/downloads/clp/survey Allegro CL 10.1] |
|||
<syntaxhighlight lang="lisp"> |
|||
;; Project : Palindrome detection |
|||
(defun palindrome(x) |
|||
(if (string= x (reverse x)) |
|||
(format t "~d" ": palindrome" (format t x)) |
|||
(format t "~d" ": not palindrome" (format t x)))) |
|||
(terpri) |
|||
(setq x "radar") |
|||
(palindrome x) |
|||
(terpri) |
|||
(setq x "books") |
|||
(palindrome x) |
|||
(terpri) |
|||
</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
radar: palindrome |
|||
books: not palindrome |
|||
</pre> |
|||
=={{header|Component Pascal}}== |
|||
BlackBox Component Builder |
|||
<syntaxhighlight lang="oberon2"> |
|||
MODULE BbtPalindrome; |
|||
IMPORT StdLog; |
|||
PROCEDURE ReverseStr(str: ARRAY OF CHAR): POINTER TO ARRAY OF CHAR; |
|||
VAR |
|||
top,middle,i: INTEGER; |
|||
c: CHAR; |
|||
rStr: POINTER TO ARRAY OF CHAR; |
|||
BEGIN |
|||
NEW(rStr,LEN(str$) + 1); |
|||
top := LEN(str$) - 1; middle := (top - 1) DIV 2; |
|||
FOR i := 0 TO middle DO |
|||
rStr[i] := str[top - i]; |
|||
rStr[top - i] := str[i]; |
|||
END; |
|||
IF ODD(LEN(str$)) THEN rStr[middle + 1] := str[middle + 1] END; |
|||
RETURN rStr; |
|||
END ReverseStr; |
|||
PROCEDURE IsPalindrome(str: ARRAY OF CHAR): BOOLEAN; |
|||
BEGIN |
|||
RETURN str = ReverseStr(str)$; |
|||
END IsPalindrome; |
|||
PROCEDURE Do*; |
|||
VAR |
|||
x: CHAR; |
|||
BEGIN |
|||
StdLog.String("'salalas' is palindrome?:> "); |
|||
StdLog.Bool(IsPalindrome("salalas"));StdLog.Ln; |
|||
StdLog.String("'madamimadam' is palindrome?:> "); |
|||
StdLog.Bool(IsPalindrome("madamimadam"));StdLog.Ln; |
|||
StdLog.String("'abcbda' is palindrome?:> "); |
|||
StdLog.Bool(IsPalindrome("abcbda"));StdLog.Ln; |
|||
END Do; |
|||
END BbtPalindrome. |
|||
</syntaxhighlight> |
|||
Execute: ^Q BbtPalindrome.Do<br/> |
|||
{{out}} |
|||
<pre> |
|||
'salalas' is palindrome?:> $TRUE |
|||
'madamimadam' is palindrome?:> $TRUE |
|||
'abcbda' is palindrome?:> $FALSE |
|||
</pre> |
|||
=={{header|Cowgol}}== |
|||
<syntaxhighlight lang="cowgol">include "cowgol.coh"; |
|||
# Check if a string is a palindrome |
|||
sub palindrome(word: [uint8]): (r: uint8) is |
|||
r := 1; |
|||
# empty string is a palindrome |
|||
if [word] == 0 then |
|||
return; |
|||
end if; |
|||
# find the end of the word |
|||
var end_ := word; |
|||
while [@next end_] != 0 loop |
|||
end_ := @next end_; |
|||
end loop; |
|||
# check if bytes match in both directions |
|||
while word < end_ loop |
|||
if [word] != [end_] then |
|||
r := 0; |
|||
return; |
|||
end if; |
|||
word := @next word; |
|||
end_ := @prev end_; |
|||
end loop; |
|||
end sub; |
|||
# Check if a string is an inexact palindrome |
|||
sub inexact(word: [uint8]): (r: uint8) is |
|||
var buf: uint8[256]; |
|||
var ptr := &buf[0]; |
|||
# filter non-letters and non-numbers |
|||
while [word] != 0 loop |
|||
var c := [word]; |
|||
if (c >= 'a' and c <= 'z') or (c >= '0' and c <= '9') then |
|||
# copy lowercase letters and numbers over verbatim |
|||
[ptr] := c; |
|||
ptr := @next ptr; |
|||
elseif c >= 'A' and c <= 'Z' then |
|||
# make uppercase letters lowercase |
|||
[ptr] := c | 32; |
|||
ptr := @next ptr; |
|||
end if; |
|||
word := @next word; |
|||
end loop; |
|||
[ptr] := 0; |
|||
r := palindrome(&buf[0]); |
|||
end sub; |
|||
var tests: [uint8][] := { |
|||
"civic", "level", "racecar", |
|||
"A man, a plan, a canal: Panama", |
|||
"Egad, a base tone denotes a bad age", |
|||
"There is no spoon." |
|||
}; |
|||
var i: @indexof tests := 0; |
|||
while i < @sizeof tests loop |
|||
print(tests[i]); |
|||
print(": "); |
|||
if palindrome(tests[i]) == 1 then |
|||
print("exact palindrome\n"); |
|||
elseif inexact(tests[i]) == 1 then |
|||
print("inexact palindrome\n"); |
|||
else |
|||
print("not a palindrome\n"); |
|||
end if; |
|||
i := i + 1; |
|||
end loop;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>civic: exact palindrome |
|||
level: exact palindrome |
|||
racecar: exact palindrome |
|||
A man, a plan, a canal: Panama: inexact palindrome |
|||
Egad, a base tone denotes a bad age: inexact palindrome |
|||
There is no spoon.: not a palindrome</pre> |
|||
=={{header|Crystal}}== |
|||
===Declarative=== |
|||
<syntaxhighlight lang="ruby"> |
|||
def palindrome(s) |
|||
s == s.reverse |
|||
end |
|||
</syntaxhighlight> |
|||
===Imperative=== |
|||
<syntaxhighlight lang="ruby"> |
|||
def palindrome_imperative(s) : Bool |
|||
mid = s.size // 2 |
|||
last = s.size - 1 |
|||
(0...mid).each do |i| |
|||
if s[i] != s[last - i] |
|||
return false |
|||
end |
|||
end |
|||
true |
|||
end |
|||
</syntaxhighlight> |
|||
Also |
|||
<syntaxhighlight lang="ruby">def palindrome_2(s) |
|||
mid = s.size // 2 |
|||
mid.times { |j| return false if s[j] != s[-1 - j] } |
|||
true |
|||
end</syntaxhighlight> |
|||
Performance comparison |
|||
<syntaxhighlight lang="ruby"> |
|||
require "benchmark" |
|||
Benchmark.ips do |x| |
|||
x.report("declarative") { palindrome("hannah") } |
|||
x.report("imperative1") { palindrome_imperative("hannah")} |
|||
x.report("imperative2") { palindrome_2("hannah")} |
|||
end |
|||
</syntaxhighlight> |
|||
<pre>declarative 45.45M ( 22.00ns) (±11.16%) 32.0B/op fastest |
|||
imperative1 35.49M ( 28.18ns) (± 2.82%) 0.0B/op 1.28× slower |
|||
imperative2 40.73M ( 24.55ns) (± 3.82%) 0.0B/op 1.12× slower</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |
||
===High-level 32-bit Unicode Version=== |
|||
<syntaxhighlight lang="d">import std.traits, std.algorithm; |
|||
<lang d>bool isPalindrome1(string s) { |
|||
return s == s.dup.reverse; |
|||
}</lang> |
|||
bool isPalindrome1(C)(in C[] s) pure /*nothrow*/ |
|||
Low-level ASCII version: |
|||
if (isSomeChar!C) { |
|||
<lang d>bool isPalindrome2(string str) { |
|||
auto s2 = s.dup; |
|||
s2.reverse(); // works on Unicode too, not nothrow. |
|||
char* t = &str[$-1]; |
|||
return s == s2; |
|||
} |
|||
if (*s++ != *t--) |
|||
return false; |
|||
void main() { |
|||
return true; |
|||
alias pali = isPalindrome1; |
|||
}</lang> |
|||
assert(pali("")); |
|||
assert(pali("z")); |
|||
assert(pali("aha")); |
|||
assert(pali("sees")); |
|||
assert(!pali("oofoe")); |
|||
assert(pali("deified")); |
|||
assert(!pali("Deified")); |
|||
assert(pali("amanaplanacanalpanama")); |
|||
assert(pali("ingirumimusnocteetconsumimurigni")); |
|||
assert(pali("salà las")); |
|||
}</syntaxhighlight> |
|||
===Mid-level 32-bit Unicode Version=== |
|||
<syntaxhighlight lang="d">import std.traits; |
|||
bool isPalindrome2(C)(in C[] s) pure if (isSomeChar!C) { |
|||
Mid-level 32-bit Unicode version: |
|||
<lang d>bool isPalindrome3(T)(T[] s) { |
|||
dchar[] dstr; |
dchar[] dstr; |
||
foreach (dchar c; s) |
foreach (dchar c; s) // not nothrow |
||
dstr ~= c; |
dstr ~= c; |
||
Line 411: | Line 1,733: | ||
return false; |
return false; |
||
return true; |
return true; |
||
} |
|||
}</lang> |
|||
void main() { |
|||
alias isPalindrome2 pali; |
|||
assert(pali("")); |
|||
assert(pali("z")); |
|||
assert(pali("aha")); |
|||
assert(pali("sees")); |
|||
assert(!pali("oofoe")); |
|||
assert(pali("deified")); |
|||
assert(!pali("Deified")); |
|||
assert(pali("amanaplanacanalpanama")); |
|||
assert(pali("ingirumimusnocteetconsumimurigni")); |
|||
assert(pali("salà las")); |
|||
}</syntaxhighlight> |
|||
===Low-level 32-bit Unicode Version=== |
|||
<syntaxhighlight lang="d">import std.stdio, core.exception, std.traits; |
|||
// assume alloca() to be pure for this program |
|||
extern(C) pure nothrow void* alloca(in size_t size); |
|||
bool isPalindrome3(C)(in C[] s) pure if (isSomeChar!C) { |
|||
auto p = cast(dchar*)alloca(s.length * 4); |
|||
if (p == null) |
|||
// no fallback heap allocation used |
|||
throw new OutOfMemoryError(); |
|||
dchar[] dstr = p[0 .. s.length]; |
|||
// use std.utf.stride for an even lower level version |
|||
int i = 0; |
|||
foreach (dchar c; s) { // not nothrow |
|||
dstr[i] = c; |
|||
i++; |
|||
} |
|||
dstr = dstr[0 .. i]; |
|||
foreach (j; 0 .. dstr.length / 2) |
|||
if (dstr[j] != dstr[$ - j - 1]) |
|||
return false; |
|||
return true; |
|||
} |
|||
void main() { |
|||
alias isPalindrome3 pali; |
|||
assert(pali("")); |
|||
assert(pali("z")); |
|||
assert(pali("aha")); |
|||
assert(pali("sees")); |
|||
assert(!pali("oofoe")); |
|||
assert(pali("deified")); |
|||
assert(!pali("Deified")); |
|||
assert(pali("amanaplanacanalpanama")); |
|||
assert(pali("ingirumimusnocteetconsumimurigni")); |
|||
assert(pali("salà las")); |
|||
}</syntaxhighlight> |
|||
===Low-level ASCII Version=== |
|||
<syntaxhighlight lang="d">bool isPalindrome4(in string str) pure nothrow { |
|||
if (str.length == 0) return true; |
|||
immutable(char)* s = str.ptr; |
|||
immutable(char)* t = &(str[$ - 1]); |
|||
while (s < t) |
|||
if (*s++ != *t--) // ugly |
|||
return false; |
|||
return true; |
|||
} |
|||
void main() { |
|||
alias isPalindrome4 pali; |
|||
assert(pali("")); |
|||
assert(pali("z")); |
|||
assert(pali("aha")); |
|||
assert(pali("sees")); |
|||
assert(!pali("oofoe")); |
|||
assert(pali("deified")); |
|||
assert(!pali("Deified")); |
|||
assert(pali("amanaplanacanalpanama")); |
|||
assert(pali("ingirumimusnocteetconsumimurigni")); |
|||
//assert(pali("salà las")); |
|||
}</syntaxhighlight> |
|||
=={{header|Dart}}== |
|||
<syntaxhighlight lang="dartlang"> |
|||
bool isPalindrome(String s){ |
|||
for(int i = 0; i < s.length/2;i++){ |
|||
if(s[i] != s[(s.length-1) -i]) |
|||
return false; |
|||
} |
|||
return true; |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|Delphi}}== |
|||
<syntaxhighlight lang="delphi">uses |
|||
SysUtils, StrUtils; |
|||
function IsPalindrome(const aSrcString: string): Boolean; |
|||
begin |
|||
Result := SameText(aSrcString, ReverseString(aSrcString)); |
|||
end;</syntaxhighlight> |
|||
=={{header|Dyalect}}== |
|||
<syntaxhighlight lang="dyalect">func isPalindrom(str) { |
|||
str == str.Reverse() |
|||
} |
|||
print(isPalindrom("ingirumimusnocteetconsumimurigni"))</syntaxhighlight> |
|||
=={{header|Déjà Vu}}== |
|||
<syntaxhighlight lang="dejavu">palindrome?: |
|||
local :seq chars |
|||
local :len-seq -- len seq |
|||
for i range 0 / len-seq 2: |
|||
if /= seq! i seq! - len-seq i: |
|||
return false |
|||
true |
|||
!. palindrome? "ingirumimusnocteetconsumimurigni" |
|||
!. palindrome? "nope"</syntaxhighlight> |
|||
{{out}} |
|||
<pre>true |
|||
false</pre> |
|||
=={{header|E}}== |
=={{header|E}}== |
||
Line 419: | Line 1,867: | ||
The for loop syntax is <code>for <var>key pattern</var> => <var>value pattern</var> in <var>collection</var> { ... }</code>, <code>?</code> imposes an additional boolean condition on a pattern (it may be read “''such that''”), and if the pattern does not match in a for loop then the iteration is skipped, so false is returned only if <code>upper[last - i] != c</code>. |
The for loop syntax is <code>for <var>key pattern</var> => <var>value pattern</var> in <var>collection</var> { ... }</code>, <code>?</code> imposes an additional boolean condition on a pattern (it may be read “''such that''”), and if the pattern does not match in a for loop then the iteration is skipped, so false is returned only if <code>upper[last - i] != c</code>. |
||
< |
<syntaxhighlight lang="e">def isPalindrome(string :String) { |
||
def upper := string.toUpperCase() |
def upper := string.toUpperCase() |
||
def last := upper.size() - 1 |
def last := upper.size() - 1 |
||
Line 426: | Line 1,874: | ||
} |
} |
||
return true |
return true |
||
}</ |
}</syntaxhighlight> |
||
=={{header|EasyLang}}== |
|||
<syntaxhighlight lang="easylang"> |
|||
func$ reverse s$ . |
|||
a$[] = strchars s$ |
|||
for i = 1 to len a$[] div 2 |
|||
swap a$[i] a$[len a$[] - i + 1] |
|||
. |
|||
return strjoin a$[] |
|||
. |
|||
func palin s$ . |
|||
if s$ = reverse s$ |
|||
return 1 |
|||
. |
|||
return 0 |
|||
. |
|||
for s$ in [ "rotor" "rosetta" "step on no pets" "été" "🦊😀🦊" ] |
|||
if palin s$ = 1 |
|||
print s$ & " is a palindrome" |
|||
else |
|||
print s$ & " is not a palindrome" |
|||
. |
|||
. |
|||
</syntaxhighlight> |
|||
=={{header|EchoLisp}}== |
|||
<syntaxhighlight lang="lisp"> |
|||
;; returns #t or #f |
|||
(define (palindrome? string) |
|||
(equal? (string->list string) (reverse (string->list string)))) |
|||
;; to strip spaces, use the following |
|||
;;(define (palindrome? string) |
|||
;;(let ((string (string-replace string "/\ /" "" "g"))) |
|||
;;(equal? (string->list string) (reverse (string->list string))))) |
|||
</syntaxhighlight> |
|||
=={{header|ed}}== |
|||
A limitation: due to ed having no built-in loops, the part with palindrome beginning/end matching has to be repeated as many times as there are palindrome levels. As a sane default, 15 is used here. |
|||
<syntaxhighlight lang="sed"> |
|||
# by Artyom Bologov |
|||
H |
|||
,p |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
g/^(.)(.*)\1$/s//\2/ |
|||
v/^(.)(.+)\1$|^.?$/s/.*/Not a palindrome!/ |
|||
g/^.?$/s//Palindrome!/ |
|||
,p |
|||
Q |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>$ cat palindrome.ed | ed -lEGs palindrome.input |
|||
Newline appended |
|||
rotor |
|||
racecar |
|||
level |
|||
rosetta |
|||
oppo |
|||
Palindrome! |
|||
Palindrome! |
|||
Palindrome! |
|||
Not a palindrome! |
|||
Palindrome!</pre> |
|||
=={{header|Eiffel}}== |
|||
<syntaxhighlight lang="eiffel"> |
|||
is_palindrome (a_string: STRING): BOOLEAN |
|||
-- Is `a_string' a palindrome? |
|||
require |
|||
string_attached: a_string /= Void |
|||
local |
|||
l_index, l_count: INTEGER |
|||
do |
|||
from |
|||
Result := True |
|||
l_index := 1 |
|||
l_count := a_string.count |
|||
until |
|||
l_index >= l_count - l_index + 1 or not Result |
|||
loop |
|||
Result := (Result and a_string [l_index] = a_string [l_count - l_index + 1]) |
|||
l_index := l_index + 1 |
|||
end |
|||
end |
|||
</syntaxhighlight> |
|||
=={{header|Ela}}== |
|||
<syntaxhighlight lang="ela">open list string |
|||
isPalindrome xs = xs == reverse xs |
|||
isPalindrome <| toList "ingirumimusnocteetconsumimurigni" |
|||
</syntaxhighlight> |
|||
Function <code>reverse</code> is taken from list module and is defined as: |
|||
<syntaxhighlight lang="ela">reverse = foldl (flip (::)) (nil xs) |
|||
foldl f z (x::xs) = foldl f (f z x) xs |
|||
foldl _ z [] = z |
|||
</syntaxhighlight> |
|||
=={{header|Elixir}}== |
|||
<syntaxhighlight lang="elixir"> |
|||
defmodule PalindromeDetection do |
|||
def is_palindrome(str), do: str == String.reverse(str) |
|||
end |
|||
</syntaxhighlight> |
|||
Note: Because of Elixir's strong Unicode support, this even supports graphemes: |
|||
<pre> |
|||
iex(1)> PalindromeDetection.is_palindrome("salàlas") |
|||
true |
|||
iex(2)> PalindromeDetection.is_palindrome("as⃝df̅") |
|||
false |
|||
iex(3)> PalindromeDetection.is_palindrome("as⃝df̅f̅ds⃝a") |
|||
true |
|||
</pre> |
|||
=={{header|Elm}}== |
|||
<syntaxhighlight lang="elm">import String exposing (reverse, length) |
|||
import Html exposing (Html, Attribute, text, div, input) |
|||
import Html.Attributes exposing (placeholder, value, style) |
|||
import Html.Events exposing (on, targetValue) |
|||
import Html.App exposing (beginnerProgram) |
|||
-- The following function (copied from Haskell) satisfies the |
|||
-- rosettacode task description. |
|||
is_palindrome x = x == reverse x |
|||
-- The remainder of the code demonstrates the use of the function |
|||
-- in a complete Elm program. |
|||
main = beginnerProgram { model = "" , view = view , update = update } |
|||
update newStr oldStr = newStr |
|||
view : String -> Html String |
|||
view candidate = |
|||
div [] |
|||
([ input |
|||
[ placeholder "Enter a string to check." |
|||
, value candidate |
|||
, on "input" targetValue |
|||
, myStyle |
|||
] |
|||
[] |
|||
] ++ |
|||
[ let testResult = |
|||
is_palindrome candidate |
|||
statement = |
|||
if testResult then "PALINDROME!" else "not a palindrome" |
|||
in div [ myStyle] [text statement] |
|||
]) |
|||
myStyle : Attribute msg |
|||
myStyle = |
|||
style |
|||
[ ("width", "100%") |
|||
, ("height", "20px") |
|||
, ("padding", "5px 0 0 5px") |
|||
, ("font-size", "1em") |
|||
, ("text-align", "left") |
|||
]</syntaxhighlight> |
|||
Link to live demo: http://dc25.github.io/palindromeDetectionElm/ |
|||
=={{header|Emacs Lisp}}== |
|||
<syntaxhighlight lang="lisp">(defun palindrome (s) |
|||
(string= s (reverse s)))</syntaxhighlight> |
|||
The version below will work correctly with inexact palindromes, as defined in this exercise: |
|||
<syntaxhighlight lang="lisp"> |
|||
(defun test-if-palindrome (text) |
|||
(setq text (replace-regexp-in-string "[[:space:][:punct:]]" "" text)) ; remove spaces and punctuation, by replacing them with nothing |
|||
(string-equal-ignore-case text (reverse text))) ; ignore case when looking at reversed text |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
(test-if-palindrome "A man, a plan, a canal, Panama") |
|||
t |
|||
</pre> |
|||
=={{header|Erlang}}== |
=={{header|Erlang}}== |
||
<lang |
<syntaxhighlight lang="erlang"> |
||
-module( palindrome ). |
|||
String == lists:reverse(String).</lang> |
|||
-export( [is_palindrome/1, task/0] ). |
|||
is_palindrome( String ) -> String =:= lists:reverse(String). |
|||
task() -> |
|||
display( "abcba" ), |
|||
display( "abcdef" ), |
|||
Latin = "In girum imus nocte et consumimur igni", |
|||
No_spaces_same_case = lists:append( string:tokens(string:to_lower(Latin), " ") ), |
|||
display( Latin, No_spaces_same_case ). |
|||
display( String ) -> io:fwrite( "Is ~p a palindrom? ~p~n", [String, is_palindrome(String)] ). |
|||
display( String1, String2 ) -> io:fwrite( "Is ~p a palindrom? ~p~n", [String1, is_palindrome(String2)] ). |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
22> palindrome:task(). |
|||
Is "abcba" a palindrom? true |
|||
Is "abcdef" a palindrom? false |
|||
Is "In girum imus nocte et consumimur igni" a Latin palindrom? true |
|||
</pre> |
|||
=={{header|Euphoria}}== |
|||
<syntaxhighlight lang="euphoria">function isPalindrome(sequence s) |
|||
for i = 1 to length(s)/2 do |
|||
if s[i] != s[$-i+1] then |
|||
return 0 |
|||
end if |
|||
end for |
|||
return 1 |
|||
end function</syntaxhighlight> |
|||
<syntaxhighlight lang="euphoria"> |
|||
include std/sequence.e -- reverse |
|||
include std/console.e -- display |
|||
include std/text.e -- upper |
|||
include std/utils.e -- iif |
|||
IsPalindrome("abcba") |
|||
IsPalindrome("abcdef") |
|||
IsPalindrome("In girum imus nocte et consumimur igni") |
|||
procedure IsPalindrome(object s) |
|||
display("Is '[]' a palindrome? ",{s},0) |
|||
s = remove_all(' ',upper(s)) |
|||
display(iif(equal(s,reverse(s)),"true","false")) |
|||
end procedure</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Is 'abcba' a palindrome? true |
|||
Is 'abcdef' a palindrome? false |
|||
Is 'In girum imus nocte et consumimur igni' a palindrome? true |
|||
</pre> |
|||
=={{header|Excel}}== |
|||
===LAMBDA=== |
|||
Binding the following lambda expression to the name ISPALINDROME in the Name Manager for the Excel WorkBook: |
|||
(See [https://www.microsoft.com/en-us/research/blog/lambda-the-ultimatae-excel-worksheet-function/ LAMBDA: The ultimate Excel worksheet function]) |
|||
{{Works with| Office 265 Betas 2021}} |
|||
<syntaxhighlight lang="lisp">ISPALINDROME |
|||
=LAMBDA(s, |
|||
LET( |
|||
lcs, FILTERP( |
|||
LAMBDA(c, " " <> c) |
|||
)( |
|||
CHARS(LOWER(s)) |
|||
), |
|||
CONCAT(lcs) = CONCAT(REVERSE(lcs)) |
|||
) |
|||
)</syntaxhighlight> |
|||
and assuming that the following generic lambdas are also bound to the names CHARS, FILTERP, and REVERSE in the Name Manager for the active WorkBook: |
|||
<syntaxhighlight lang="lisp">CHARS |
|||
=LAMBDA(s, |
|||
MID(s, ROW(INDIRECT("1:" & LEN(s))), 1) |
|||
) |
|||
FILTERP |
|||
=LAMBDA(p, |
|||
LAMBDA(xs, |
|||
FILTER(xs, p(xs)) |
|||
) |
|||
) |
|||
REVERSE |
|||
=LAMBDA(xs, |
|||
LET( |
|||
n, ROWS(xs), |
|||
SORTBY( |
|||
xs, |
|||
SEQUENCE(n, 1, n, -1) |
|||
) |
|||
) |
|||
)</syntaxhighlight> |
|||
{{Out}} |
|||
{| class="wikitable" |
|||
|- |
|||
|||style="text-align:right; font-family:serif; font-style:italic; font-size:120%;"|fx |
|||
! colspan="2" style="text-align:left; vertical-align: bottom; font-family:Arial, Helvetica, sans-serif !important;"|=ISPALINDROME(A2) |
|||
|- style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff;" |
|||
| |
|||
| A |
|||
| B |
|||
|- style="text-align:right;" |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 1 |
|||
| style="text-align:right; font-weight:bold" | Test string |
|||
| style="text-align:left; font-weight:bold" | Is palindrome ? |
|||
|- style="text-align:right;" |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 2 |
|||
| style="text-align:right;" | In girum imus nocte et consumimur igni |
|||
| style="text-align:left; background-color:#cbcefb;" | TRUE |
|||
|- style="text-align:right;" |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 3 |
|||
| style="text-align:right;" | abban |
|||
| style="text-align:left" | FALSE |
|||
|- style="text-align:right;" |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 4 |
|||
| style="text-align:right;" | abba |
|||
| style="text-align:left" | TRUE |
|||
|- style="text-align:right;" |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 5 |
|||
| style="text-align:right;" | aba |
|||
| style="text-align:left" | TRUE |
|||
|- style="text-align:right;" |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 6 |
|||
| style="text-align:right; f" | ab |
|||
| style="text-align:left" | FALSE |
|||
|- style="text-align:right;" |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 7 |
|||
| style="text-align:right;" | a |
|||
| style="text-align:left" | TRUE |
|||
|} |
|||
=={{header|F Sharp|F#}}== |
=={{header|F Sharp|F#}}== |
||
<syntaxhighlight lang="fsharp">let isPalindrome (s: string) = |
|||
Forall2 applies the predicate to each member of the two arrays, until it finds a false or it reaches the end. |
|||
let arr = s.ToCharArray() |
|||
<lang fsharp>let isPalindrome (s: string) = |
|||
arr = Array.rev arr</syntaxhighlight> |
|||
Array.forall2 (fun a b -> a = b) ( arr ) ( Array.rev ( arr ) )</lang> |
|||
Examples: |
Examples: |
||
< |
<syntaxhighlight lang="fsharp">isPalindrome "abcba" |
||
val it : bool = true |
val it : bool = true |
||
isPalindrome ("In girum imus nocte et consumimur igni".Replace(" ", "").ToLower());; |
isPalindrome ("In girum imus nocte et consumimur igni".Replace(" ", "").ToLower());; |
||
val it : bool = true |
val it : bool = true |
||
isPalindrome "abcdef" |
isPalindrome "abcdef" |
||
val it : bool = false</ |
val it : bool = false</syntaxhighlight> |
||
=={{header|Factor}}== |
=={{header|Factor}}== |
||
< |
<syntaxhighlight lang="factor">USING: kernel sequences ; |
||
: palindrome? ( str -- ? ) dup reverse = ;</ |
: palindrome? ( str -- ? ) dup reverse = ;</syntaxhighlight> |
||
=={{header|Falcon}}== |
|||
'''VBA/Python programmer's approach not sure if it's the most falconic way''' |
|||
<syntaxhighlight lang="falcon"> |
|||
/* created by Aykayayciti Earl Lamont Montgomery |
|||
April 9th, 2018 */ |
|||
function is_palindrome(a) |
|||
a = strUpper(a).replace(" ", "") |
|||
b = a[-1:0] |
|||
return b == a |
|||
end |
|||
a = "mom" |
|||
> is_palindrome(a) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
true |
|||
[Finished in 1.7s] |
|||
</pre> |
|||
'''more falconic''' |
|||
<syntaxhighlight lang="falcon"> |
|||
/* created by Aykayayciti Earl Lamont Montgomery |
|||
April 9th, 2018 */ |
|||
b = "mom" |
|||
> strUpper(b).replace(" ", "") == strUpper(b[-1:0]) ? "Is a palindrome" : "Is not a palindrome" |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Is a palindrome |
|||
[Finished in 1.5s] |
|||
</pre> |
|||
=={{header|Fantom}}== |
|||
<syntaxhighlight lang="fantom"> |
|||
class Palindrome |
|||
{ |
|||
// Function to test if given string is a palindrome |
|||
public static Bool isPalindrome (Str str) |
|||
{ |
|||
str == str.reverse |
|||
} |
|||
// Give it a test run |
|||
public static Void main () |
|||
{ |
|||
echo (isPalindrome("")) |
|||
echo (isPalindrome("a")) |
|||
echo (isPalindrome("aa")) |
|||
echo (isPalindrome("aba")) |
|||
echo (isPalindrome("abb")) |
|||
echo (isPalindrome("salàlas")) |
|||
echo (isPalindrome("In girum imus nocte et consumimur igni".lower.replace(" ",""))) |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|FBSL}}== |
|||
<syntaxhighlight lang="qbasic">#APPTYPE CONSOLE |
|||
FUNCTION stripNonAlpha(BYVAL s AS STRING) AS STRING |
|||
DIM sTemp AS STRING = "" |
|||
DIM c AS STRING |
|||
FOR DIM i = 1 TO LEN(s) |
|||
c = MID(s, i, 1) |
|||
IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", c, 0, 1) THEN |
|||
sTemp = stemp & c |
|||
END IF |
|||
NEXT |
|||
RETURN sTemp |
|||
END FUNCTION |
|||
FUNCTION IsPalindrome(BYVAL s AS STRING) AS INTEGER |
|||
FOR DIM i = 1 TO STRLEN(s) \ 2 ' only check half of the string, as scanning from both ends |
|||
IF s{i} <> s{STRLEN - (i - 1)} THEN RETURN FALSE 'comparison is not case sensitive |
|||
NEXT |
|||
RETURN TRUE |
|||
END FUNCTION |
|||
PRINT IsPalindrome(stripNonAlpha("A Toyota")) |
|||
PRINT IsPalindrome(stripNonAlpha("Madam, I'm Adam")) |
|||
PRINT IsPalindrome(stripNonAlpha("the rain in Spain falls mainly on the rooftops")) |
|||
PAUSE |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 |
|||
1 |
|||
0 |
|||
</pre> |
|||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
< |
<syntaxhighlight lang="forth">: first over c@ ; |
||
: last >r 2dup + 1- c@ r> swap ; |
: last >r 2dup + 1- c@ r> swap ; |
||
: palindrome? ( c-addr u -- f ) |
: palindrome? ( c-addr u -- f ) |
||
Line 458: | Line 2,343: | ||
1 /string 1- |
1 /string 1- |
||
again ; |
again ; |
||
</syntaxhighlight> |
|||
</lang> |
|||
FIRST and LAST are once-off words that could be beheaded immediately afterwards. |
|||
The version taking advantage of Tail Call Optimization or a properly tail-recursive variant of RECURSE (easily added to any Forth) is very similar. |
|||
The horizontal formatting highlights the parallel code - and potential factor; |
|||
a library of many string tests like this could have ?SUCCESS and ?FAIL . |
|||
'''Below is a separate Forth program that detects palindrome phrases as well as single word palindromes. It was programmed using gforth.''' |
|||
<syntaxhighlight lang="forth"> |
|||
variable temp-addr |
|||
: valid-char? ( addr1 u -- f ) ( check for valid character ) |
|||
+ dup C@ 48 58 within |
|||
over C@ 65 91 within or |
|||
swap C@ 97 123 within or ; |
|||
: >upper ( c1 -- c2 ) |
|||
dup 97 123 within if 32 - then ; |
|||
: strip-input ( addr1 u -- addr2 u ) ( Strip characters, then copy stripped string to temp-addr ) |
|||
pad temp-addr ! |
|||
temp-addr @ rot rot 0 do dup I 2dup valid-char? if |
|||
+ C@ >upper temp-addr @ C! 1 temp-addr +! |
|||
else 2drop |
|||
then loop drop temp-addr @ pad - ; |
|||
: get-phrase ( -- addr1 u ) |
|||
." Type a phrase: " here 1024 accept here swap -trailing cr ; |
|||
: position-phrase ( addr1 u -- addr1 u addr2 u addr1 addr2 u ) |
|||
temp-addr @ over 2over 2over drop swap ; |
|||
: reverse-copy ( addr1 addr2 u -- addr1 addr2 ) |
|||
0 do over I' 1- I - + over I + 1 cmove loop 2drop ; |
|||
: palindrome? ( -- ) |
|||
get-phrase strip-input position-phrase reverse-copy compare 0= if |
|||
." << Valid >> Palindrome." |
|||
else ." << Not >> a Palindrome." |
|||
then cr ; |
|||
</syntaxhighlight> |
|||
Example: |
|||
palindrome?<br> |
|||
Type a phrase: A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal-Panama! |
|||
<< Valid >> Palindrome. |
|||
FIRST and LAST are once-off words that could be beheaded immediately afterwards. The version taking advantage of Tail Call Optimization or a properly tail-recursive variant of RECURSE (easily added to any Forth) is very similar. The horizontal formatting highlights the parallel code - and potential factor; a library of many string tests like this could have ?SUCCESS and ?FAIL . |
|||
=={{header|Fortran}}== |
=={{header|Fortran}}== |
||
{{works with|Fortran|90 and later}} |
{{works with|Fortran|90 and later}} |
||
< |
<syntaxhighlight lang="fortran">program palindro |
||
implicit none |
implicit none |
||
Line 477: | Line 2,409: | ||
print *, is_palindro("last test") |
print *, is_palindro("last test") |
||
contains</ |
contains</syntaxhighlight> |
||
'''Non-recursive''' |
'''Non-recursive''' |
||
< |
<syntaxhighlight lang="fortran">! non-recursive |
||
function is_palindro(t) |
function is_palindro(t) |
||
logical :: is_palindro |
logical :: is_palindro |
||
Line 506: | Line 2,438: | ||
forall(i=1:len(t)) s(len(t)-i+1:len(t)-i+1) = t(i:i) |
forall(i=1:len(t)) s(len(t)-i+1:len(t)-i+1) = t(i:i) |
||
isp = ( s == t ) |
isp = ( s == t ) |
||
end function is_palindro2</ |
end function is_palindro2</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="fortran"> recursive function is_palindro_r (t) result (isp) |
||
implicit none |
implicit none |
||
Line 517: | Line 2,449: | ||
isp = len (t) == 0 .or. t (: 1) == t (len (t) :) .and. is_palindro_r (t (2 : len (t) - 1)) |
isp = len (t) == 0 .or. t (: 1) == t (len (t) :) .and. is_palindro_r (t (2 : len (t) - 1)) |
||
end function is_palindro_r</ |
end function is_palindro_r</syntaxhighlight> |
||
<syntaxhighlight lang="fortran">end program palindro</syntaxhighlight> |
|||
=={{header|FreeBASIC}}== |
|||
<syntaxhighlight lang="freebasic">' version 20-06-2015 |
|||
' compile with: fbc -s console "filename".bas |
|||
#Ifndef TRUE ' define true and false for older freebasic versions |
|||
#Define FALSE 0 |
|||
#Define TRUE Not FALSE |
|||
#EndIf |
|||
Function reverse(norm As String) As Integer |
|||
Dim As String rev |
|||
Dim As Integer i, l = Len(norm) -1 |
|||
rev = norm |
|||
For i = 0 To l |
|||
rev[l-i] = norm[i] |
|||
Next |
|||
If norm = rev Then |
|||
Return TRUE |
|||
Else |
|||
Return FALSE |
|||
End If |
|||
End Function |
|||
Function cleanup(in As String, action As String = "") As String |
|||
' action = "" do nothing, [l|L] = convert to lowercase, |
|||
' [s|S] = strip spaces, [p|P] = strip punctuation. |
|||
If action = "" Then Return in |
|||
Dim As Integer i, p_, s_ |
|||
Dim As String ch |
|||
action = LCase(action) |
|||
For i = 1 To Len(action) |
|||
ch = Mid(action, i, 1) |
|||
If ch = "l" Then in = LCase(in) |
|||
If ch = "p" Then |
|||
p_ = 1 |
|||
ElseIf ch = "s" Then |
|||
s_ = 1 |
|||
End If |
|||
Next |
|||
If p_ = 0 And s_ = 0 Then Return in |
|||
Dim As String unwanted, clean |
|||
If s_ = 1 Then unwanted = " " |
|||
If p_ = 1 Then unwanted = unwanted + "`~!@#$%^&*()-=_+[]{}\|;:',.<>/?" |
|||
For i = 1 To Len(in) |
|||
ch = Mid(in, i, 1) |
|||
If InStr(unwanted, ch) = 0 Then clean = clean + ch |
|||
Next |
|||
Return clean |
|||
End Function |
|||
' ------=< MAIN >=------ |
|||
Dim As String test = "In girum imus nocte et consumimur igni" |
|||
'IIf ( cond, true, false ), true and false must be of the same type (num, string, UDT) |
|||
Print |
|||
Print " reverse(test) = "; IIf(reverse(test) = FALSE, "FALSE", "TRUE") |
|||
Print " reverse(cleanup(test,""l"")) = "; IIf(reverse(cleanup(test,"l")) = FALSE, "FALSE", "TRUE") |
|||
Print " reverse(cleanup(test,""ls"")) = "; IIf(reverse(cleanup(test,"ls")) = FALSE, "FALSE", "TRUE") |
|||
Print "reverse(cleanup(test,""PLS"")) = "; IIf(reverse(cleanup(test,"PLS")) = FALSE, "FALSE", "TRUE") |
|||
' empty keyboard buffer |
|||
While InKey <> "" : Wend |
|||
Print : Print : Print "Hit any key to end program" |
|||
Sleep |
|||
End</syntaxhighlight> |
|||
{{out}} |
|||
<pre> reverse(test) = FALSE |
|||
reverse(cleanup(test,"l")) = FALSE |
|||
reverse(cleanup(test,"ls")) = TRUE |
|||
reverse(cleanup(test,"PLS")) = TRUE</pre> |
|||
=={{header|Frink}}== |
|||
This version will even work with upper-plane Unicode characters. Many languages will not work correctly with upper-plane Unicode characters because they are represented as Unicode "surrogate pairs" which are represented as two characters in a UTF-16 stream. In addition, Frink uses a ''grapheme''-based reverse, which allows the algorithm below to operate on combined sequences of Unicode characters. |
|||
For example, the string "og\u0308o" represents an o, a g with combining diaeresis, followed by the letter o. Or, in other words, "og̈o". Note that while there are four Unicode codepoints, only three "graphemes" are displayed. Using Frink's smart "reverse" function preserves these combined graphemes and detects them correctly as palindromes. |
|||
<syntaxhighlight lang="frink">isPalindrome[x] := x == reverse[x] |
|||
</syntaxhighlight> |
|||
Test in Frink with upper-plane Unicode: |
|||
<syntaxhighlight lang="frink">isPalindrome["x\u{1f638}x"]</syntaxhighlight> |
|||
<code> |
|||
true |
|||
</code> |
|||
=={{header|FutureBasic}}== |
|||
<syntaxhighlight lang="futurebasic"> |
|||
include "NSLog.incl" |
|||
local fn IsCleanStringPalindrome( testStr as CFStringRef ) as BOOL |
|||
NSUInteger i |
|||
BOOL result = NO |
|||
NSUInteger strLen = len(testStr) |
|||
for i = 0 to strLen / 2 |
|||
if ( fn StringCharacterAtIndex( testStr, i ) != fn StringCharacterAtIndex( testStr, strLen -i -1 ) ) |
|||
result = NO |
|||
exit fn |
|||
end if |
|||
next |
|||
result = YES |
|||
end fn = result |
|||
local fn IsDirtyStringPalindrome( dirtyStr as CFStringRef ) |
|||
BOOL result = NO |
|||
CFStringRef tempStr |
|||
CFStringRef lowerCaseStr = fn StringLowercaseString( dirtyStr ) |
|||
CFStringRef removeStr = @"!\"#$%&'()*+,-./:;<=>?@[]^_ {|}~" |
|||
NSUInteger i, count = len(removeStr) |
|||
tempStr = lowerCaseStr |
|||
for i = 0 to count -1 |
|||
CFStringRef chrStr = fn StringWithFormat( @"%c", fn StringCharacterAtIndex( removeStr, i ) ) |
|||
tempStr = fn StringByReplacingOccurrencesOfString( tempStr, chrStr, @"" ) |
|||
next |
|||
result = fn IsCleanStringPalindrome( tempStr ) |
|||
end fn = result |
|||
local fn PalindromeTest( testStr as CFStringRef ) |
|||
BOOL result = NO |
|||
result = fn IsCleanStringPalindrome( testStr ) |
|||
if ( result == YES ) |
|||
NSLog( @"%17s : %@", fn StringUTF8String( @"Clean palindrome" ), testStr ) : exit fn |
|||
else |
|||
result = fn IsDirtyStringPalindrome( testStr ) |
|||
if ( result == YES ) |
|||
NSLog( @"%17s : %@", fn StringUTF8String( @"Dirty palindrome" ), testStr ) : exit fn |
|||
else |
|||
NSLog( @"%17s : %@", fn StringUTF8String( @"Not a palindrome" ), testStr ) |
|||
end if |
|||
end if |
|||
end fn |
|||
fn PalindromeTest( @"racecar" ) |
|||
fn PalindromeTest( @"level" ) |
|||
fn PalindromeTest( @"rosetta" ) |
|||
fn PalindromeTest( @"rotavator" ) |
|||
fn PalindromeTest( @"13231+464+989=989+464+13231" ) |
|||
fn PalindromeTest( @"Was it a car or a cat I saw?" ) |
|||
fn PalindromeTest( @"Did Hannah see bees? Hannah did." ) |
|||
fn PalindromeTest( @"This sentence is not a palindrome." ) |
|||
fn PalindromeTest( @"123 456 789 897 654 321" ) |
|||
fn PalindromeTest( @"123 456 789 987 654 321" ) |
|||
fn PalindromeTest( @"Radar" ) |
|||
fn PalindromeTest( @"abba" ) |
|||
fn PalindromeTest( @"boom " ) |
|||
fn PalindromeTest( @"radar" ) |
|||
fn PalindromeTest( @"civic" ) |
|||
fn PalindromeTest( @"great" ) |
|||
fn PalindromeTest( @"Madam, I'm Adam." ) |
|||
fn PalindromeTest( @"salàla" ) |
|||
fn PalindromeTest( @"A man, a plan, a canal: Panama" ) |
|||
fn PalindromeTest( @"a man a plan a canal panama" ) |
|||
fn PalindromeTest( @"Egad, a base tone denotes a bad age" ) |
|||
fn PalindromeTest( @"In girum imus nocte et consumimur igni" ) |
|||
fn PalindromeTest( @"sees" ) |
|||
fn PalindromeTest( @"solo" ) |
|||
fn PalindromeTest( @"solos" ) |
|||
HandleEvents |
|||
</syntaxhighlight> |
|||
{{output}} |
|||
<pre> |
|||
Clean palindrome : racecar |
|||
Clean palindrome : level |
|||
Not a palindrome : rosetta |
|||
Clean palindrome : rotavator |
|||
Clean palindrome : 13231+464+989=989+464+13231 |
|||
Dirty palindrome : Was it a car or a cat I saw? |
|||
Dirty palindrome : Did Hannah see bees? Hannah did. |
|||
Not a palindrome : This sentence is not a palindrome. |
|||
Not a palindrome : 123 456 789 897 654 321 |
|||
Clean palindrome : 123 456 789 987 654 321 |
|||
Dirty palindrome : Radar |
|||
Clean palindrome : abba |
|||
Not a palindrome : boom |
|||
Clean palindrome : radar |
|||
Clean palindrome : civic |
|||
Not a palindrome : great |
|||
Dirty palindrome : Madam, I'm Adam. |
|||
Not a palindrome : salàla |
|||
Dirty palindrome : A man, a plan, a canal: Panama |
|||
Dirty palindrome : a man a plan a canal panama |
|||
Dirty palindrome : Egad, a base tone denotes a bad age |
|||
Dirty palindrome : In girum imus nocte et consumimur igni |
|||
Clean palindrome : sees |
|||
Not a palindrome : solo |
|||
Clean palindrome : solos |
|||
</pre> |
|||
=={{header|Fōrmulæ}}== |
|||
{{FormulaeEntry|page=https://formulae.org/?script=examples/Palindrome_detection}} |
|||
'''Solution''' |
|||
[[File:Fōrmulæ - Palindrome detection 01.png]] |
|||
[[File:Fōrmulæ - Palindrome detection 02.png]] |
|||
'''Test cases''' |
|||
[[File:Fōrmulæ - Palindrome detection 03.png]] |
|||
[[File:Fōrmulæ - Palindrome detection 04.png]] |
|||
<lang fortran>end program palindro</lang> |
|||
=={{header|GAP}}== |
=={{header|GAP}}== |
||
< |
<syntaxhighlight lang="gap">ZapGremlins := function(s) |
||
local upper, lower, c, i, n, t; |
local upper, lower, c, i, n, t; |
||
upper := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; |
upper := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; |
||
Line 547: | Line 2,706: | ||
t := ZapGremlins(s); |
t := ZapGremlins(s); |
||
return t = Reversed(t); |
return t = Reversed(t); |
||
end;</ |
end;</syntaxhighlight> |
||
=={{header|Go}}== |
|||
Non-ASCII specifically disallowed as proper handling probably varies by language. Also the empty string specifically disallowed as it has only mathematical significance and does not meet the common concept of a word or phrase. Digits specifically allowed however, as they are trivial to handle. |
|||
<lang go> |
|||
package pal |
|||
=={{header|GML}}== |
|||
import "unicode" |
|||
<syntaxhighlight lang="go"> |
|||
//Setting a var from an argument passed to the script |
|||
var str; |
|||
str = argument0 |
|||
//Takes out all spaces/anything that is not a letter or a number and turns uppercase letters to lowercase |
|||
str = string_lettersdigits(string_lower(string_replace(str,' ',''))); |
|||
var inv; |
|||
inv = ''; |
|||
//for loop that reverses the sequence |
|||
var i; |
|||
for (i = 0; i < string_length(str); i += 1;) |
|||
{ |
|||
inv += string_copy(str,string_length(str)-i,1); |
|||
} |
|||
//returns true if the sequence is a palindrome else returns false |
|||
return (str == inv); |
|||
</syntaxhighlight> |
|||
Palindrome detection using a [http://rosettacode.org/wiki/Loop/Downward_For#GML Downward For-Loop] |
|||
<syntaxhighlight lang="go"> |
|||
//Remove everything except for letters and digits and convert the string to lowercase. source is what will be compared to str. |
|||
var str = string_lower(string_lettersdigits(string_replace(argument0," ",""))), source = ""; |
|||
//Loop through and store each character of str in source. |
|||
for (var i = string_length(str); i > 0; i--) { |
|||
source += string_char_at(str,i); |
|||
} |
|||
//Return if it is a palindrome. |
|||
return source == str; |
|||
</syntaxhighlight> |
|||
=={{header|Go}}== |
|||
<syntaxhighlight lang="go">package pal |
|||
func IsPal(s string) bool { |
func IsPal(s string) bool { |
||
mid := len(s) / 2 |
|||
last := len(s) - 1 |
|||
for i := 0; i < mid; i++ { |
|||
} |
|||
if s[i] != s[last-i] { |
|||
for _, c := range s { |
|||
switch { |
|||
case c > 127: |
|||
return false |
|||
case unicode.IsLetter(c): |
|||
n = append(n, unicode.ToLower(c)) |
|||
case unicode.IsDigit(c): |
|||
n = append(n, c) |
|||
} |
|||
} |
|||
for i, j := len(n)/2-1, len(n)-1; i >= 0; i-- { |
|||
if n[i] != n[j-i] { |
|||
return false |
return false |
||
} |
} |
||
} |
} |
||
return true |
return true |
||
}</syntaxhighlight> |
|||
} |
|||
</lang> |
|||
This version works with Unicode, |
|||
<syntaxhighlight lang="go"> |
|||
func isPalindrome(s string) bool { |
|||
runes := []rune(s) |
|||
numRunes := len(runes) - 1 |
|||
for i := 0; i < len(runes)/2; i++ { |
|||
if runes[i] != runes[numRunes-i] { |
|||
return false |
|||
} |
|||
} |
|||
return true |
|||
}</syntaxhighlight> |
|||
Or using more slicing, |
|||
<syntaxhighlight lang="go"> |
|||
func isPalindrome(s string) bool { |
|||
runes := []rune(s) |
|||
for len(runes) > 1 { |
|||
if runes[0] != runes[len(runes)-1] { |
|||
return false |
|||
} |
|||
runes = runes[1 : len(runes)-1] |
|||
} |
|||
return true |
|||
}</syntaxhighlight> |
|||
=={{header|GolfScript}}== |
|||
===Recursive=== |
|||
<syntaxhighlight lang="golfscript">{.,1>{(\)@={pal}0if}1if\;}:pal;</syntaxhighlight> |
|||
Test program: |
|||
<syntaxhighlight lang="groovy">"ABBA" pal |
|||
"a" pal |
|||
"13231+464+989=989+464+13231" pal |
|||
"123 456 789 897 654 321" pal</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1 |
|||
1 |
|||
1 |
|||
0</pre> |
|||
=={{header|Groovy}}== |
=={{header|Groovy}}== |
||
===Trivial=== |
|||
Solution: |
Solution: |
||
< |
<syntaxhighlight lang="groovy">def isPalindrome = { String s -> |
||
s == s?.reverse() |
s == s?.reverse() |
||
}</ |
}</syntaxhighlight> |
||
Test program: |
Test program: |
||
< |
<syntaxhighlight lang="groovy">println isPalindrome("") |
||
println isPalindrome("a") |
println isPalindrome("a") |
||
println isPalindrome("abcdefgfedcba") |
println isPalindrome("abcdefgfedcba") |
||
println isPalindrome("abcdeffedcba") |
println isPalindrome("abcdeffedcba") |
||
println isPalindrome("abcedfgfedcb")</ |
println isPalindrome("abcedfgfedcb")</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>true |
<pre>true |
||
true |
true |
||
Line 603: | Line 2,828: | ||
This solution assumes nulls are palindromes. |
This solution assumes nulls are palindromes. |
||
===Non-recursive=== |
|||
Solution: |
Solution: |
||
< |
<syntaxhighlight lang="groovy">def isPalindrome = { String s -> |
||
def n = s.size() |
def n = s.size() |
||
n < 2 || s[0..<n/2] == s[-1..(-n/2)] |
n < 2 || s[0..<n/2] == s[-1..(-n/2)] |
||
}</ |
}</syntaxhighlight> |
||
Test program and output are the same. |
Test program and output are the same. |
||
This solution does not handle nulls. |
|||
===Recursive=== |
|||
Solution follows the [[#C|C palindrome_r]] recursive solution: |
Solution follows the [[#C|C palindrome_r]] recursive solution: |
||
< |
<syntaxhighlight lang="groovy">def isPalindrome |
||
isPalindrome = { String s -> |
isPalindrome = { String s -> |
||
def n = s.size() |
def n = s.size() |
||
n < 2 || (s[0] == s[n-1] && isPalindrome(s[1..<(n-1)])) |
n < 2 || (s[0] == s[n-1] && isPalindrome(s[1..<(n-1)])) |
||
}</ |
}</syntaxhighlight> |
||
Test program and output are the same. |
Test program and output are the same. |
||
This solution does not handle nulls. |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
Line 630: | Line 2,857: | ||
A string is a palindrome if reversing it we obtain the same string. |
A string is a palindrome if reversing it we obtain the same string. |
||
< |
<syntaxhighlight lang="haskell">is_palindrome x = x == reverse x</syntaxhighlight> |
||
Or, applicative and point-free, with some pre-processing of data (shedding white space and upper case): |
|||
<syntaxhighlight lang="haskell">import Data.Bifunctor (second) |
|||
import Data.Char (toLower) |
|||
------------------- PALINDROME DETECTION ----------------- |
|||
isPalindrome :: Eq a => [a] -> Bool |
|||
isPalindrome = (==) <*> reverse |
|||
-- Or, comparing just the leftward characters with |
|||
-- with a reflection of just the rightward characters. |
|||
isPal :: String -> Bool |
|||
isPal s = |
|||
let (q, r) = quotRem (length s) 2 |
|||
in uncurry (==) $ |
|||
second (reverse . drop r) $ splitAt q s |
|||
--------------------------- TEST ------------------------- |
|||
main :: IO () |
|||
main = |
|||
mapM_ putStrLn $ |
|||
(showResult <$> [isPalindrome, isPal]) |
|||
<*> fmap |
|||
prepared |
|||
[ "", |
|||
"a", |
|||
"ab", |
|||
"aba", |
|||
"abba", |
|||
"In girum imus nocte et consumimur igni" |
|||
] |
|||
prepared :: String -> String |
|||
prepared cs = [toLower c | c <- cs, ' ' /= c] |
|||
showResult f s = (show s) <> " -> " <> show (f s)</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>"" -> True |
|||
"a" -> True |
|||
"ab" -> False |
|||
"aba" -> True |
|||
"abba" -> True |
|||
"ingirumimusnocteetconsumimurigni" -> True |
|||
"" -> True |
|||
"a" -> True |
|||
"ab" -> False |
|||
"aba" -> True |
|||
"abba" -> True |
|||
"ingirumimusnocteetconsumimurigni" -> True</pre> |
|||
'''Recursive''' |
'''Recursive''' |
||
See the C palindrome_r code for an explanation of the concept used in this solution |
See the C palindrome_r code for an explanation of the concept used in this solution, |
||
though it may be better suited to indexed arrays than to linked lists. |
|||
(last is expensive, and entails multiplied recursions over the right hand side |
|||
of the remaining list here). |
|||
< |
<syntaxhighlight lang="haskell">is_palindrome_r x | length x <= 1 = True |
||
| head x == last x = is_palindrome_r . tail. init $ x |
| head x == last x = is_palindrome_r . tail. init $ x |
||
| otherwise = False</ |
| otherwise = False</syntaxhighlight> |
||
=={{header|HicEst}}== |
=={{header|HicEst}}== |
||
{{incorrect|HicEst|The stripping of spaces and case conversion should be outside the palindrome detection.}} |
|||
<lang hicest> result = Palindrome( "In girum imus nocte et consumimur igni" ) ! returns 1 |
|||
<syntaxhighlight lang="hicest"> result = Palindrome( "In girum imus nocte et consumimur igni" ) ! returns 1 |
|||
END |
END |
||
Line 657: | Line 2,943: | ||
IF( Palindrome == 0 ) RETURN |
IF( Palindrome == 0 ) RETURN |
||
ENDDO |
ENDDO |
||
END</ |
END</syntaxhighlight> |
||
== Icon and Unicon == |
|||
=={{header|Icon}} and {{header|Unicon}}== |
|||
< |
<syntaxhighlight lang="icon">procedure main(arglist) |
||
every writes(s := !arglist) do write( if palindrome(s) then " is " else " is not", " a palindrome.") |
every writes(s := !arglist) do write( if palindrome(s) then " is " else " is not", " a palindrome.") |
||
end</ |
end</syntaxhighlight> |
||
The following simple procedure uses the built-in reverse. Reverse creates a transient string which will get garbage collected. |
The following simple procedure uses the built-in reverse. Reverse creates a transient string which will get garbage collected. |
||
< |
<syntaxhighlight lang="icon">procedure palindrome(s) #: return s if s is a palindrome |
||
return s == reverse(s) |
return s == reverse(s) |
||
end</ |
end</syntaxhighlight> |
||
{{libheader|Icon Programming Library}} |
{{libheader|Icon Programming Library}} |
||
Note: The IPL procedure [http://www.cs.arizona.edu/icon/library/src/procs/strings.icn strings] contains a palindrome tester called '''ispal''' that uses reverse and is equivalent to the version of '''palindrome''' above. |
Note: The IPL procedure [http://www.cs.arizona.edu/icon/library/src/procs/strings.icn strings] contains a palindrome tester called '''ispal''' that uses reverse and is equivalent to the version of '''palindrome''' above. |
||
This version |
This version uses positive and negative sub-scripting and works not only on strings but lists of strings, such as ["ab","ab"] or ["ab","x"] the first list would pass the test but the second wouldn't. |
||
< |
<syntaxhighlight lang="icon">procedure palindrome(x) #: return x if s is x palindrome |
||
local i |
local i |
||
every if x[i := 1 to (*x+ 1)/2] ~== x[-i] then fail |
every if x[i := 1 to (*x+ 1)/2] ~== x[-i] then fail |
||
return x |
return x |
||
end</ |
end</syntaxhighlight> |
||
=={{header|Insitux}}== |
|||
This function works also for vectors. |
|||
<syntaxhighlight lang="insitux">(var palindrome? (= (reverse %))) |
|||
(palindrome? "deified") ;returns true</syntaxhighlight> |
|||
Space and punctuation insensitive version: |
|||
<syntaxhighlight lang="insitux">(var palindrome? (comp (filter letter?) lower-case (= (reverse %)))) |
|||
(palindrome? "In girum imus nocte et consumimur igni.") ;returns true</syntaxhighlight> |
|||
==={{header|Unicon}}=== |
|||
This Icon solution works in Unicon. |
|||
=={{header|Ioke}}== |
=={{header|Ioke}}== |
||
< |
<syntaxhighlight lang="ioke">Text isPalindrome? = method(self chars == self chars reverse)</syntaxhighlight> |
||
=={{header|J}}== |
=={{header|J}}== |
||
Line 689: | Line 2,984: | ||
Reverse and match method |
Reverse and match method |
||
< |
<syntaxhighlight lang="j">isPalin0=: -: |.</syntaxhighlight> |
||
Example usage |
Example usage |
||
< |
<syntaxhighlight lang="j"> isPalin0 'ABBA' |
||
1 |
1 |
||
isPalin0 |
isPalin0 -.&' ' tolower 'In girum imus nocte et consumimur igni' |
||
1</ |
1</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
Tacit and explicit verbs: |
Tacit and explicit verbs: |
||
< |
<syntaxhighlight lang="j">isPalin1=: 0:`($:@(}.@}:))@.({.={:)`1:@.(1>:#) |
||
isPalin2=: monad define |
isPalin2=: monad define |
||
if. 1>:#y do. 1 return. end. |
if. 1>:#y do. 1 return. end. |
||
if. ({.={:)y do. isPalin2 }.}:y else. 0 end. |
if. ({.={:)y do. isPalin2 }.}:y else. 0 end. |
||
)</ |
)</syntaxhighlight> |
||
Note that while these recursive verbs are bulkier and more complicated, they are also several thousand times more inefficient than isPalin0. |
Note that while these recursive verbs are bulkier and more complicated, they are also several thousand times more inefficient than isPalin0. |
||
< |
<syntaxhighlight lang="j"> foo=: foo,|.foo=:2000$a. |
||
ts=:6!:2,7!:2 NB. time and space required to execute sentence |
ts=:6!:2,7!:2 NB. time and space required to execute sentence |
||
ts 'isPalin0 foo' |
ts 'isPalin0 foo' |
||
Line 719: | Line 3,014: | ||
1599.09 1164.23 |
1599.09 1164.23 |
||
'isPalin2 foo' %&ts 'isPalin0 foo' |
'isPalin2 foo' %&ts 'isPalin0 foo' |
||
3967.53 2627.04</ |
3967.53 2627.04</syntaxhighlight> |
||
=={{header|Jakt}}== |
|||
<syntaxhighlight lang="jakt"> |
|||
fn is_palindrome(anon string: String) throws -> bool { |
|||
mut points: [u32] = [] |
|||
for point in string.code_points() { |
|||
points.push(point) |
|||
} |
|||
mut i: usize = 0 |
|||
while i < points.size() / 2 { |
|||
if points[i] != points[points.size() - 1 - i] { |
|||
return false |
|||
} |
|||
i++ |
|||
} |
|||
return true |
|||
} |
|||
fn main() { |
|||
println("{}", is_palindrome("amanaplanacanalpanama")) |
|||
println("{}", is_palindrome("madamimadam")) |
|||
println("{}", is_palindrome("madamimddam")) |
|||
println("{}", is_palindrome("私は私")) |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|Java}}== |
=={{header|Java}}== |
||
'''Non-Recursive''' |
'''Non-Recursive''' |
||
< |
<syntaxhighlight lang="java">public static boolean pali(String testMe){ |
||
StringBuilder sb = new StringBuilder(testMe); |
StringBuilder sb = new StringBuilder(testMe); |
||
return testMe. |
return testMe.equals(sb.reverse().toString()); |
||
}</ |
}</syntaxhighlight> |
||
'''Recursive''' |
|||
'''Non-Recursive using indexes (supports upper-plane Unicode)''' |
|||
<lang java>public static boolean rPali(String testMe){ |
|||
<syntaxhighlight lang="java">public static boolean isPalindrome(String input) { |
|||
for (int i = 0, j = input.length() - 1; i < j; i++, j--) { |
|||
char startChar = input.charAt(i); |
|||
char endChar = input.charAt(j); |
|||
// Handle surrogate pairs in UTF-16 |
|||
if (Character.isLowSurrogate(endChar)) { |
|||
if (startChar != input.charAt(--j)) { |
|||
return false; |
|||
} |
|||
if (input.charAt(++i) != endChar) { |
|||
return false; |
|||
} |
|||
} else if (startChar != endChar) { |
|||
return false; |
|||
} |
|||
} |
|||
return true; |
|||
}</syntaxhighlight> |
|||
'''Recursive (this version does not work correctly with upper-plane Unicode)''' |
|||
<syntaxhighlight lang="java">public static boolean rPali(String testMe){ |
|||
if(testMe.length()<=1){ |
if(testMe.length()<=1){ |
||
return true; |
return true; |
||
} |
} |
||
if(!(testMe.charAt(0)+""). |
if(!(testMe.charAt(0)+"").equals(testMe.charAt(testMe.length()-1)+"")){ |
||
return false; |
return false; |
||
} |
} |
||
return rPali(testMe.substring(1, testMe.length()-1)); |
return rPali(testMe.substring(1, testMe.length()-1)); |
||
}</ |
}</syntaxhighlight> |
||
'''Recursive using indexes (this version does not work correctly with upper-plane Unicode)''' |
|||
<syntaxhighlight lang="java">public static boolean rPali(String testMe){ |
|||
int strLen = testMe.length(); |
|||
return rPaliHelp(testMe, strLen-1, strLen/2, 0); |
|||
} |
|||
public static boolean rPaliHelp(String testMe, int strLen, int testLen, int index){ |
|||
if(index > testLen){ |
|||
return true; |
|||
} |
|||
if(testMe.charAt(index) != testMe.charAt(strLen-index)){ |
|||
return false; |
|||
} |
|||
return rPaliHelp(testMe, strLen, testLen, index + 1); |
|||
} |
|||
</syntaxhighlight> |
|||
'''Regular Expression''' |
|||
([http://stackoverflow.com/questions/3664881/how-does-this-java-regex-detect-palindromes source]) |
|||
<syntaxhighlight lang="java">public static boolean pali(String testMe){ |
|||
return testMe.matches("|(?:(.)(?<=(?=^.*?(\\1\\2?)$).*))+(?<=(?=^\\2$).*)"); |
|||
}</syntaxhighlight> |
|||
=={{header|JavaScript}}== |
=={{header|JavaScript}}== |
||
<lang |
<syntaxhighlight lang="javascript">function isPalindrome(str) { |
||
return str === str.split("").reverse().join(""); |
|||
} |
|||
console.log(isPalindrome("ingirumimusnocteetconsumimurigni"));</syntaxhighlight> |
|||
function palindrome(str) { return str == str.reverse(); } |
|||
alert(palindrome("ingirumimusnocteetconsumimurigni"));</lang> |
|||
ES6 implementation |
|||
---- |
|||
<syntaxhighlight lang="javascript">var isPal = str => str === str.split("").reverse().join("");</syntaxhighlight> |
|||
<lang javascript>String.prototype.reverse = function () { |
|||
return this.split('').reverse().join(''); |
|||
}; |
|||
Or, ignoring spaces and variations in case: |
|||
String.prototype.isPalindrome = function () { |
|||
var s = this.toLowerCase().replace(/[^a-z]/g, ''); |
|||
return (s.reverse() === s); |
|||
}; |
|||
<syntaxhighlight lang="javascript">(() => { |
|||
('A man, a plan, a canoe, pasta, heros, rajahs, ' + |
|||
'a coloratura, maps, snipe, percale, macaroni, ' + |
|||
// isPalindrome :: String -> Bool |
|||
'a gag, a banana bag, a tan, a tag, ' + |
|||
const isPalindrome = s => { |
|||
'a banana bag again (or a camel), a crepe, pins, ' + |
|||
const cs = filter(c => ' ' !== c, s.toLocaleLowerCase()); |
|||
'Spam, a rut, a Rolo, cash, a jar, sore hats, ' + |
|||
return cs.join('') === reverse(cs).join(''); |
|||
'a peon, a canal – Panama!').isPalindrome();</lang> |
|||
}; |
|||
// TEST ----------------------------------------------- |
|||
const main = () => |
|||
isPalindrome( |
|||
'In girum imus nocte et consumimur igni' |
|||
) |
|||
// GENERIC FUNCTIONS ---------------------------------- |
|||
// filter :: (a -> Bool) -> [a] -> [a] |
|||
const filter = (f, xs) => ( |
|||
'string' !== typeof xs ? ( |
|||
xs |
|||
) : xs.split('') |
|||
).filter(f); |
|||
// reverse :: [a] -> [a] |
|||
const reverse = xs => |
|||
'string' !== typeof xs ? ( |
|||
xs.slice(0).reverse() |
|||
) : xs.split('').reverse().join(''); |
|||
// MAIN --- |
|||
return main(); |
|||
})();</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>true</pre> |
|||
=={{header|jq}}== |
|||
The definitional implementation would probably be fine except for very long strings: |
|||
<syntaxhighlight lang="jq"> |
|||
def palindrome: explode | reverse == .; |
|||
</syntaxhighlight> |
|||
So here is an implementation with a view to efficiency: |
|||
<syntaxhighlight lang="jq"> |
|||
def isPalindrome: |
|||
length as $n |
|||
| explode as $in |
|||
| first(range(0; $n/2) |
|||
| select($in[.] != $in[$n - 1 - .]) ) |
|||
// false |
|||
| not; |
|||
</syntaxhighlight> |
|||
'''Example''': |
|||
"salàlas" | palindrome |
|||
{{Out}} |
|||
true |
|||
=={{header|Jsish}}== |
|||
<syntaxhighlight lang="javascript">/* Palindrome detection, in Jsish */ |
|||
function isPalindrome(str:string, exact:boolean=true) { |
|||
if (!exact) { |
|||
str = str.toLowerCase(); |
|||
str = str.replace(/[ \t,;:!?.]/g, ''); |
|||
} |
|||
return str === str.match(/./g).reverse().join(''); |
|||
} |
|||
;isPalindrome('BUB'); |
|||
;isPalindrome('CUB'); |
|||
;isPalindrome('Bub'); |
|||
;isPalindrome('Bub', false); |
|||
;isPalindrome('In girum imus nocte et consumimur igni', false); |
|||
;isPalindrome('A man, a plan, a canal; Panama!', false); |
|||
;isPalindrome('Never odd or even', false); |
|||
/* |
|||
=!EXPECTSTART!= |
|||
isPalindrome('BUB') ==> true |
|||
isPalindrome('CUB') ==> false |
|||
isPalindrome('Bub') ==> false |
|||
isPalindrome('Bub', false) ==> true |
|||
isPalindrome('In girum imus nocte et consumimur igni', false) ==> true |
|||
isPalindrome('A man, a plan, a canal; Panama!', false) ==> true |
|||
isPalindrome('Never odd or even', false) ==> true |
|||
=!EXPECTEND!= |
|||
*/</syntaxhighlight> |
|||
Most of that code is for testing, using echo mode lines (semicolon in column 1) |
|||
{{out}} |
|||
<pre>prompt$ jsish --U palindrome.jsi |
|||
isPalindrome('BUB') ==> true |
|||
isPalindrome('CUB') ==> false |
|||
isPalindrome('Bub') ==> false |
|||
isPalindrome('Bub', false) ==> true |
|||
isPalindrome('In girum imus nocte et consumimur igni', false) ==> true |
|||
isPalindrome('A man, a plan, a canal; Panama!', false) ==> true |
|||
isPalindrome('Never odd or even', false) ==> true |
|||
prompt$ jsish -u palindrome.jsi |
|||
[PASS] palindrome.jsi</pre> |
|||
=={{header|Julia}}== |
|||
<syntaxhighlight lang="julia">palindrome(s) = s == reverse(s)</syntaxhighlight> |
|||
<b> Non-Recursive </b> |
|||
<syntaxhighlight lang="julia"> |
|||
function palindrome(s) |
|||
len = length(s) |
|||
for i = 1:(len/2) |
|||
if(s[len-i+1]!=s[i]) |
|||
return false |
|||
end |
|||
end |
|||
return true |
|||
end |
|||
</syntaxhighlight> |
|||
<b> Recursive </b> |
|||
<syntaxhighlight lang="julia"> |
|||
function palindrome(s) |
|||
len = length(s) |
|||
if(len==0 || len==1) |
|||
return true |
|||
end |
|||
if(s[1] == s[len]) |
|||
return palindrome(SubString(s,2,len-1)) |
|||
end |
|||
return false |
|||
end</syntaxhighlight> |
|||
=={{header|k}}== |
=={{header|k}}== |
||
<lang |
<syntaxhighlight lang="k">is_palindrome:{x~|x}</syntaxhighlight> |
||
=={{header|Kotlin}}== |
|||
<syntaxhighlight lang="scala">// version 1.1.2 |
|||
/* These functions deal automatically with Unicode as all strings are UTF-16 encoded in Kotlin */ |
|||
fun isExactPalindrome(s: String) = (s == s.reversed()) |
|||
fun isInexactPalindrome(s: String): Boolean { |
|||
var t = "" |
|||
for (c in s) if (c.isLetterOrDigit()) t += c |
|||
t = t.toLowerCase() |
|||
return t == t.reversed() |
|||
} |
|||
fun main(args: Array<String>) { |
|||
val candidates = arrayOf("rotor", "rosetta", "step on no pets", "été") |
|||
for (candidate in candidates) { |
|||
println("'$candidate' is ${if (isExactPalindrome(candidate)) "an" else "not an"} exact palindrome") |
|||
} |
|||
println() |
|||
val candidates2 = arrayOf( |
|||
"In girum imus nocte et consumimur igni", |
|||
"Rise to vote, sir", |
|||
"A man, a plan, a canal - Panama!", |
|||
"Ce repère, Perec" // note: 'è' considered a distinct character from 'e' |
|||
) |
|||
for (candidate in candidates2) { |
|||
println("'$candidate' is ${if (isInexactPalindrome(candidate)) "an" else "not an"} inexact palindrome") |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
'rotor' is an exact palindrome |
|||
'rosetta' is not an exact palindrome |
|||
'step on no pets' is an exact palindrome |
|||
'été' is an exact palindrome |
|||
'In girum imus nocte et consumimur igni' is an inexact palindrome |
|||
'Rise to vote, sir' is an inexact palindrome |
|||
'A man, a plan, a canal - Panama!' is an inexact palindrome |
|||
'Ce repère, Perec' is not an inexact palindrome |
|||
</pre> |
|||
=={{header|LabVIEW}}== |
|||
{{VI solution|LabVIEW_Palindrome_detection.png}} |
|||
=={{header|langur}}== |
|||
<syntaxhighlight lang="langur"> |
|||
val ispal = fn s:len(s) > 0 and s == reverse(s) |
|||
val tests = { |
|||
"": false, |
|||
"z": true, |
|||
"aha": true, |
|||
"αηα": true, |
|||
"αννα": true, |
|||
"αννασ": false, |
|||
"sees": true, |
|||
"seas": false, |
|||
"deified": true, |
|||
"solo": false, |
|||
"solos": true, |
|||
"amanaplanacanalpanama": true, |
|||
"a man a plan a canal panama": false, # true if we remove spaces |
|||
"ingirumimusnocteetconsumimurigni": true, |
|||
} |
|||
for word in sort(keys(tests)) { |
|||
val foundpal = ispal(word) |
|||
writeln word, ": ", foundpal, if(foundpal == tests[word]: ""; " (FAILED TEST)") |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>: false |
|||
a man a plan a canal panama: false |
|||
aha: true |
|||
amanaplanacanalpanama: true |
|||
deified: true |
|||
ingirumimusnocteetconsumimurigni: true |
|||
seas: false |
|||
sees: true |
|||
solo: false |
|||
solos: true |
|||
z: true |
|||
αηα: true |
|||
αννα: true |
|||
αννασ: false</pre> |
|||
=={{header|Lasso}}== |
|||
<syntaxhighlight lang="lasso">define ispalindrome(text::string) => { |
|||
local(_text = string(#text)) // need to make copy to get rid of reference issues |
|||
#_text -> replace(regexp(`(?:$|\W)+`), -ignorecase) |
|||
local(reversed = string(#_text)) |
|||
#reversed -> reverse |
|||
return #_text == #reversed |
|||
} |
|||
ispalindrome('Tätatät') // works with high ascii |
|||
ispalindrome('Hello World') |
|||
ispalindrome('A man, a plan, a canoe, pasta, heros, rajahs, a coloratura, maps, snipe, percale, macaroni, a gag, a banana bag, a tan, a tag, a banana bag again (or a camel), a crepe, pins, Spam, a rut, a Rolo, cash, a jar, sore hats, a peon, a canal – Panama!')</syntaxhighlight> |
|||
{{out}} |
|||
<pre>true |
|||
false |
|||
true</pre> |
|||
=={{header|Liberty BASIC}}== |
|||
<syntaxhighlight lang="lb">print isPalindrome("In girum imus nocte et consumimur igni") |
|||
print isPalindrome(removePunctuation$("In girum imus nocte et consumimur igni", "S")) |
|||
print isPalindrome(removePunctuation$("In girum imus nocte et consumimur igni", "SC")) |
|||
function isPalindrome(string$) |
|||
isPalindrome = 1 |
|||
for i = 1 to int(len(string$)/2) |
|||
if mid$(string$, i, 1) <> mid$(string$, len(string$)-i+1, 1) then isPalindrome = 0 : exit function |
|||
next i |
|||
end function |
|||
function removePunctuation$(string$, remove$) |
|||
'P = remove puctuation. S = remove spaces C = remove case |
|||
If instr(upper$(remove$), "C") then string$ = lower$(string$) |
|||
If instr(upper$(remove$), "P") then removeCharacters$ = ",.!'()-&*?<>:;~[]{}" |
|||
If instr(upper$(remove$), "S") then removeCharacters$ = removeCharacters$;" " |
|||
for i = 1 to len(string$) |
|||
if instr(removeCharacters$, mid$(string$, i, 1)) then string$ = left$(string$, i-1);right$(string$, len(string$)-i) : i = i - 1 |
|||
next i |
|||
removePunctuation$ = string$ |
|||
end function</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
0 |
|||
0 |
|||
1 |
|||
</pre> |
|||
=={{header|LiveCode}}== |
|||
This implementation defaults to exact match, but has an optional parameter to do inexact.<syntaxhighlight lang="livecode">function palindrome txt exact |
|||
if exact is empty or exact is not false then |
|||
set caseSensitive to true --default is false |
|||
else |
|||
replace space with empty in txt |
|||
put lower(txt) into txt |
|||
end if |
|||
return txt is reverse(txt) |
|||
end palindrome |
|||
function reverse str |
|||
repeat with i = the length of str down to 1 |
|||
put byte i of str after revstr |
|||
end repeat |
|||
return revstr |
|||
end reverse</syntaxhighlight> |
|||
=={{header|Logo}}== |
=={{header|Logo}}== |
||
< |
<syntaxhighlight lang="logo">to palindrome? :w |
||
output equal? :w reverse :w |
output equal? :w reverse :w |
||
end</ |
end</syntaxhighlight> |
||
=={{header|Lua}}== |
=={{header|Lua}}== |
||
< |
<syntaxhighlight lang="lua">function ispalindrome(s) return s == string.reverse(s) end</syntaxhighlight> |
||
=={{header|M4}}== |
=={{header|M4}}== |
||
'''Non-recursive''' |
'''Non-recursive''' |
||
This uses the <code>invert</code> from [[Reversing a string]]. |
This uses the <code>invert</code> from [[Reversing a string]]. |
||
< |
<syntaxhighlight lang="m4">define(`palindrorev',`ifelse(`$1',invert(`$1'),`yes',`no')')dnl |
||
palindrorev(`ingirumimusnocteetconsumimurigni') |
palindrorev(`ingirumimusnocteetconsumimurigni') |
||
palindrorev(`this is not palindrome')</ |
palindrorev(`this is not palindrome')</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
<syntaxhighlight lang="m4">define(`striptwo',`substr(`$1',1,eval(len(`$1')-2))')dnl |
|||
<lang m4>define(`striptwo',`substr(`$1',1,eval(len(`$1')-2))')dnl |
|||
define(`cmplast',`ifelse(`striptwo(`$1')',,`yes',dnl |
define(`cmplast',`ifelse(`striptwo(`$1')',,`yes',dnl |
||
substr(`$1',0,1),substr(`$1',eval(len(`$1')-1),1),`yes',`no')')dnl |
substr(`$1',0,1),substr(`$1',eval(len(`$1')-1),1),`yes',`no')')dnl |
||
Line 791: | Line 3,436: | ||
ifelse(eval(len(`$1')<1),1,`yes',cmplast(`$1'),`yes',`palindro(striptwo(`$1'))',`no')')dnl |
ifelse(eval(len(`$1')<1),1,`yes',cmplast(`$1'),`yes',`palindro(striptwo(`$1'))',`no')')dnl |
||
palindro(`ingirumimusnocteetconsumimurigni') |
palindro(`ingirumimusnocteetconsumimurigni') |
||
palindro(`this is not palindrome')</ |
palindro(`this is not palindrome')</syntaxhighlight> |
||
=={{header| |
=={{header|MACRO-11}}== |
||
<syntaxhighlight lang="macro11"> .TITLE PALIN |
|||
Custom functions: |
|||
.MCALL .GTLIN,.PRINT,.EXIT |
|||
PALIN:: .GTLIN #INBUF ; READ INPUT |
|||
MOV #INBUF,R0 |
|||
TSTB (R0) ; END OF INPUT? |
|||
BEQ 3$ |
|||
JSR PC,EPALIN ; CHECK (EXACT) PALINDROME |
|||
BNE 1$ |
|||
.PRINT #4$ |
|||
BR PALIN |
|||
1$: MOV #INBUF,R0 ; CHECK INEXACT PALINDROME |
|||
JSR PC,IPALIN |
|||
BNE 2$ |
|||
.PRINT #5$ |
|||
BR PALIN |
|||
2$: .PRINT #6$ ; NOT A PALINDROME AT ALL |
|||
BR PALIN |
|||
3$: .EXIT |
|||
4$: .ASCIZ /EXACT PALINDROME/ |
|||
5$: .ASCIZ /INEXACT PALINDROME/ |
|||
6$: .ASCIZ /NOT A PALINDROME/ |
|||
.EVEN |
|||
; IS STRING AT R0 AN EXACT PALINDROME? |
|||
; ZERO FLAG SET IF TRUE |
|||
EPALIN: MOV R0,R1 |
|||
1$: TSTB (R1)+ ; FIND END OF STRING |
|||
BNE 1$ |
|||
DEC R1 |
|||
2$: CMPB (R0)+,-(R1) ; SCAN BACKWARDS AND FORWARDS |
|||
BNE 4$ ; NOT PALINDROME? |
|||
CMP R0,R1 ; DONE YET? |
|||
BLT 2$ |
|||
3$: CLR R1 |
|||
4$: RTS PC |
|||
; IS STRING AT R0 AN INEXACT PALINDROME? |
|||
'''Non-recursive''' |
|||
IPALIN: MOV #3$,R1 ; COPY TO BUFFER |
|||
BR 2$ |
|||
1$: BICB #40,R2 ; MAKE UPPERCASE IF LETTER |
|||
CMPB R2,#101 ; < A = DISREGARD |
|||
BLT 2$ |
|||
CMPB R2,#132 ; > Z = DISREGARD |
|||
BGT 2$ |
|||
MOVB R2,(R1)+ ; STORE IN BUFFER |
|||
2$: MOVB (R0)+,R2 ; GET CHARACTER |
|||
BNE 1$ ; END? |
|||
CLRB (R1) ; ZERO TERMINATE BUFFER |
|||
MOV #3$,R0 ; NOW SEE IF RESULT IS EXACT PALINDROME |
|||
BR EPALIN |
|||
3$: .BLKB 200 ; BUFFER |
|||
INBUF: .BLKB 200 |
|||
<lang Mathematica>PalindromeQ[i_String] := StringReverse[i] == i</lang> |
|||
.END PALIN</syntaxhighlight> |
|||
{{out}} |
|||
<pre>.palin racecar |
|||
EXACT PALINDROME |
|||
.palin raceCAR |
|||
'''Recursive''' |
|||
INEXACT PALINDROME |
|||
.palin rosetta |
|||
<lang Mathematica>PalindromeRecQ[str_String] := If[ |
|||
NOT A PALINDROME</pre> |
|||
Length[Characters[str]] <= 1, |
|||
True, |
|||
If[Characters[str][[1]] == |
|||
Characters[str][[Length[Characters[str]]]], |
|||
PalindromeRecQ[ |
|||
StringJoin[Take[Characters[str], {2, Length[Characters[str]] - 1}]] |
|||
], |
|||
False |
|||
] |
|||
]</lang> |
|||
Examples: |
|||
<lang Mathematica>PalindromeQ["TNT"] |
|||
PalindromeRecQ["TNT"] |
|||
PalindromeQ["test"] |
|||
PalindromeRecQ["test"] |
|||
PalindromeQ["deified"] |
|||
PalindromeRecQ["deified"] |
|||
PalindromeQ["salàlas"] |
|||
PalindromeRecQ["salàlas"] |
|||
PalindromeQ["ingirumimusnocteetconsumimurigni"] |
|||
PalindromeRecQ["ingirumimusnocteetconsumimurigni"]</lang> |
|||
=={{header|Maple}}== |
|||
Note that the code block doesn't correctly show the à in salàlas. |
|||
Output: |
|||
This uses functions from Maple's built-in <code>StringTools</code> package. |
|||
<lang Mathematica>True |
|||
True |
|||
<syntaxhighlight lang="maple"> |
|||
with(StringTools): |
|||
IsPalindrome("ingirumimusnocteetconsumimurigni"); |
|||
IsPalindrome("In girum imus nocte et consumimur igni"); |
|||
IsPalindrome(LowerCase(DeleteSpace("In girum imus nocte et consumimur igni"))); |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
true |
|||
false |
|||
true |
|||
</pre> |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
Built-in function handling lists, numbers, and strings: |
|||
<syntaxhighlight lang="mathematica">PalindromeQ</syntaxhighlight> |
|||
{{out|Examples}} |
|||
<pre>PalindromeQ["TNT"] |
|||
PalindromeQ["test"] |
|||
PalindromeQ["deified"] |
|||
PalindromeQ["salálas"] |
|||
PalindromeQ["ingirumimusnocteetconsumimurigni"]</pre> |
|||
{{out}} |
|||
<pre>True |
|||
False |
False |
||
False |
|||
True |
|||
True |
|||
True |
|||
True |
True |
||
True |
True |
||
True</ |
True</pre> |
||
=={{header|MATLAB}}== |
=={{header|MATLAB}}== |
||
< |
<syntaxhighlight lang="matlab">function trueFalse = isPalindrome(string) |
||
trueFalse = all(string == fliplr(string)); %See if flipping the string produces the original string |
trueFalse = all(string == fliplr(string)); %See if flipping the string produces the original string |
||
Line 853: | Line 3,557: | ||
end |
end |
||
end</ |
end</syntaxhighlight> |
||
Sample Usage |
{{out|Sample Usage}} |
||
< |
<syntaxhighlight lang="matlab">>> isPalindrome('In girum imus nocte et consumimur igni') |
||
ans = |
ans = |
||
1 |
1 |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Maxima}}== |
|||
<syntaxhighlight lang="maxima">palindromep(s) := block([t], t: sremove(" ", sdowncase(s)), sequal(t, sreverse(t)))$ |
|||
palindromep("Sator arepo tenet opera rotas"); /* true */</syntaxhighlight> |
|||
=={{header|MAXScript}}== |
=={{header|MAXScript}}== |
||
Line 867: | Line 3,576: | ||
'''Non-recursive''' |
'''Non-recursive''' |
||
< |
<syntaxhighlight lang="maxscript">fn isPalindrome s = |
||
( |
( |
||
local reversed = "" |
local reversed = "" |
||
for i in s.count to 1 by -1 do reversed += s[i] |
for i in s.count to 1 by -1 do reversed += s[i] |
||
return reversed == s |
return reversed == s |
||
)</ |
)</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="maxscript">fn isPalindrome_r s = |
||
( |
( |
||
if s.count <= 1 then |
if s.count <= 1 then |
||
Line 890: | Line 3,599: | ||
isPalindrome_r (substring s 2 (s.count-2)) |
isPalindrome_r (substring s 2 (s.count-2)) |
||
) |
) |
||
)</ |
)</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="maxscript">local p = "ingirumimusnocteetconsumimurigni" |
||
format ("'%' is a palindrome? %\n") p (isPalindrome p) |
format ("'%' is a palindrome? %\n") p (isPalindrome p) |
||
format ("'%' is a palindrome? %\n") p (isPalindrome_r p)</ |
format ("'%' is a palindrome? %\n") p (isPalindrome_r p)</syntaxhighlight> |
||
=={{header|min}}== |
|||
{{works with|min|0.19.3}} |
|||
<syntaxhighlight lang="min">(dup reverse ==) :palindrome? |
|||
(dup "" split reverse "" join ==) :str-palindrome? |
|||
"apple" str-palindrome? puts |
|||
"racecar" str-palindrome? puts |
|||
(a b c) palindrome? puts |
|||
(a b b a) palindrome? puts</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
false |
|||
true |
|||
false |
|||
true |
|||
</pre> |
|||
=={{header|MiniScript}}== |
|||
<syntaxhighlight lang="miniscript">isPalindrome = function(s) |
|||
// convert to lowercase, and strip non-letters |
|||
stripped = "" |
|||
for c in s.lower |
|||
if c >= "a" and c <= "z" then stripped = stripped + c |
|||
end for |
|||
// check palindromity |
|||
mid = floor(stripped.len/2) |
|||
for i in range(0, mid) |
|||
if stripped[i] != stripped[-i - 1] then return false |
|||
end for |
|||
return true |
|||
end function |
|||
testStr = "Madam, I'm Adam" |
|||
answer = [testStr, "is"] |
|||
if not isPalindrome(testStr) then answer.push "NOT" |
|||
answer.push "a palindrome" |
|||
print answer.join</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Madam, I'm Adam is a palindrome |
|||
</pre> |
|||
=={{header|Mirah}}== |
|||
<syntaxhighlight lang="mirah">def reverse(s:string) |
|||
StringBuilder.new(s).reverse.toString() |
|||
end |
|||
def palindrome?(s:string) |
|||
s.equals(reverse(s)) |
|||
end |
|||
puts palindrome?("anna") # ==> true |
|||
puts palindrome?("Erik") # ==> false |
|||
puts palindrome?("palindroom-moordnilap") # ==> true |
|||
puts nil # ==> null</syntaxhighlight> |
|||
=={{header|ML}}== |
|||
==={{header|mLite}}=== |
|||
<syntaxhighlight lang="ocaml">fun to_locase s = implode ` map (c_downcase) ` explode s |
|||
fun only_alpha s = implode ` filter (fn x = c_alphabetic x) ` explode s |
|||
fun is_palin |
|||
( h1 :: t1, h2 :: t2, n = 0 ) = true |
|||
| ( h1 :: t1, h2 :: t2, n ) where ( h1 eql h2 ) = is_palin( t1, t2, n - 1) |
|||
| ( h1 :: t1, h2 :: t2, n ) = false |
|||
| (str s) = |
|||
let |
|||
val es = explode ` to_locase ` only_alpha s; |
|||
val res = rev es; |
|||
val k = (len es) div 2 |
|||
in |
|||
is_palin (es, res, k) |
|||
end |
|||
fun test_is_palin s = |
|||
(print "\""; print s; print "\" is a palindrome: "; print ` is_palin s; println "") |
|||
fun test (f, arg, res, ok, notok) = if (f arg eql res) then ("'" @ arg @ "' " @ ok) else ("'" @ arg @ "' " @ notok) |
|||
; |
|||
println ` test (is_palin, "In girum imus nocte, et consumimur igni", true, "is a palindrome", "is NOT a palindrome"); |
|||
println ` test (is_palin, "Madam, I'm Adam.", true, "is a palindrome", "is NOT a palindrome"); |
|||
println ` test (is_palin, "salàlas", true, "is a palindrome", "is NOT a palindrome"); |
|||
println ` test (is_palin, "radar", true, "is a palindrome", "is NOT a palindrome"); |
|||
println ` test (is_palin, "Lagerregal", true, "is a palindrome", "is NOT a palindrome"); |
|||
println ` test (is_palin, "Ein Neger mit Gazelle zagt im Regen nie.", true, "is a palindrome", "is NOT a palindrome"); |
|||
println ` test (is_palin, "something wrong", true, "is a palindrome", "is NOT a palindrome");</syntaxhighlight> |
|||
Output: |
|||
<pre>'In girum imus nocte, et consumimur igni' is a palindrome |
|||
'Madam, I'm Adam.' is a palindrome |
|||
'salàlas' is a palindrome |
|||
'radar' is a palindrome |
|||
'Lagerregal' is a palindrome |
|||
'Ein Neger mit Gazelle zagt im Regen nie.' is a palindrome |
|||
'something wrong' is NOT a palindrome |
|||
</pre> |
|||
==={{header|Standard ML}}=== |
|||
<syntaxhighlight lang="sml"> |
|||
fun palindrome s = |
|||
let val cs = explode s in |
|||
cs = rev cs |
|||
end |
|||
</syntaxhighlight> |
|||
=={{header|MMIX}}== |
=={{header|MMIX}}== |
||
< |
<syntaxhighlight lang="mmix">argc IS $0 |
||
argv IS $1 |
argv IS $1 |
||
Line 966: | Line 3,783: | ||
1H TRAP 0,Fputs,StdOut % print |
1H TRAP 0,Fputs,StdOut % print |
||
3H XOR $255,$255,$255 |
3H XOR $255,$255,$255 |
||
TRAP 0,Halt,0 % exit(0)</ |
TRAP 0,Halt,0 % exit(0)</syntaxhighlight> |
||
=={{header|Modula-2}}== |
|||
<syntaxhighlight lang="modula2">MODULE Palindrome; |
|||
FROM FormatString IMPORT FormatString; |
|||
FROM Terminal IMPORT WriteString,ReadChar; |
|||
PROCEDURE IsPalindrome(str : ARRAY OF CHAR) : BOOLEAN; |
|||
VAR i,m : INTEGER; |
|||
VAR buf : ARRAY[0..63] OF CHAR; |
|||
BEGIN |
|||
i := 0; |
|||
m := HIGH(str) - 1; |
|||
WHILE i<m DO |
|||
IF str[i] # str[m-i] THEN |
|||
RETURN FALSE |
|||
END; |
|||
INC(i) |
|||
END; |
|||
RETURN TRUE |
|||
END IsPalindrome; |
|||
PROCEDURE Print(str : ARRAY OF CHAR); |
|||
VAR buf : ARRAY[0..63] OF CHAR; |
|||
BEGIN |
|||
FormatString("%s: %b\n", buf, str, IsPalindrome(str)); |
|||
WriteString(buf) |
|||
END Print; |
|||
BEGIN |
|||
Print(""); |
|||
Print("z"); |
|||
Print("aha"); |
|||
Print("sees"); |
|||
Print("oofoe"); |
|||
Print("deified"); |
|||
Print("Deified"); |
|||
Print("amanaplanacanalpanama"); |
|||
Print("ingirumimusnocteetconsumimurigni"); |
|||
ReadChar |
|||
END Palindrome.</syntaxhighlight> |
|||
=={{header|Modula-3}}== |
=={{header|Modula-3}}== |
||
< |
<syntaxhighlight lang="modula3">MODULE Palindrome; |
||
IMPORT Text; |
IMPORT Text; |
||
Line 983: | Line 3,841: | ||
RETURN TRUE; |
RETURN TRUE; |
||
END isPalindrome; |
END isPalindrome; |
||
END Palindrome.</ |
END Palindrome.</syntaxhighlight> |
||
=={{header|Nanoquery}}== |
|||
<syntaxhighlight lang="nanoquery">def is_palindrome(s) |
|||
temp = "" |
|||
for char in s |
|||
if "abcdefghikjklmnopqrstuvwxyz" .contains. lower(char) |
|||
temp += lower(char) |
|||
end |
|||
end |
|||
return list(temp) = list(temp).reverse() |
|||
end</syntaxhighlight> |
|||
=={{header|Nemerle}}== |
|||
<syntaxhighlight lang="nemerle">using System; |
|||
using System.Console; |
|||
using Nemerle.Utility.NString; //contains methods Explode() and Implode() which convert string -> list[char] and back |
|||
module Palindrome |
|||
{ |
|||
IsPalindrome( text : string) : bool |
|||
{ |
|||
Implode(Explode(text).Reverse()) == text; |
|||
} |
|||
Main() : void |
|||
{ |
|||
WriteLine("radar is a palindrome: {0}", IsPalindrome("radar")); |
|||
} |
|||
}</syntaxhighlight> |
|||
And a function to remove spaces and punctuation and convert to lowercase |
|||
<syntaxhighlight lang="nemerle">Clean( text : string ) : string |
|||
{ |
|||
def sepchars = Explode(",.;:-?!()' "); |
|||
Concat( "", Split(text, sepchars)).ToLower() |
|||
}</syntaxhighlight> |
|||
=={{header|NetRexx}}== |
|||
{{Trans|REXX}} |
|||
<syntaxhighlight lang="netrexx"> |
|||
y='In girum imus nocte et consumimur igni' |
|||
-- translation: We walk around in the night and |
|||
-- we are burnt by the fire (of love) |
|||
say |
|||
say 'string = 'y |
|||
say |
|||
pal=isPal(y) |
|||
if pal==0 then say "The string isn't palindromic." |
|||
else say 'The string is palindromic.' |
|||
method isPal(x) static |
|||
x=x.upper().space(0) /* removes all blanks (spaces) */ |
|||
/* and translate to uppercase. */ |
|||
return x==x.reverse() /* returns 1 if exactly equal */ |
|||
</syntaxhighlight> |
|||
=={{header|NewLISP}}== |
|||
Works likewise for strings and for lists |
|||
<syntaxhighlight lang="lisp"> |
|||
(define (palindrome? s) |
|||
(setq r s) |
|||
(reverse r) ; Reverse is destructive. |
|||
(= s r)) |
|||
;; Make ‘reverse’ non-destructive and avoid a global variable |
|||
(define (palindrome? s) |
|||
(= s (reverse (copy s)))) |
|||
</syntaxhighlight> |
|||
=={{header|Nim}}== |
|||
The following program detects if UTF-8 strings are exact palindromes. If "exact" is set to "false", it ignores the white spaces and the differences of letter case to detect inexact palindromes. Differences in punctuation are still relevant. |
|||
<syntaxhighlight lang="nim">import unicode |
|||
func isPalindrome(rseq: seq[Rune]): bool = |
|||
## Return true if a sequence of runes is a palindrome. |
|||
for i in 1..(rseq.len shr 1): |
|||
if rseq[i - 1] != rseq[^i]: |
|||
return false |
|||
result = true |
|||
func isPalindrome(str: string; exact = true): bool {.inline.} = |
|||
## Return true if a UTF-8 string is a palindrome. |
|||
## If "exact" is false, ignore white spaces and ignore case. |
|||
if exact: |
|||
result = str.toRunes.isPalindrome() |
|||
else: |
|||
var rseq: seq[Rune] |
|||
for rune in str.runes: |
|||
if not rune.isWhiteSpace: |
|||
rseq.add rune.toLower |
|||
result = rseq.isPalindrome() |
|||
when isMainModule: |
|||
proc check(s: string) = |
|||
var exact, inexact: bool |
|||
exact = s.isPalindrome() |
|||
if not exact: |
|||
inexact = s.isPalindrome(exact = false) |
|||
let txt = if exact: " is an exact palindrome." |
|||
elif inexact: " is an inexact palindrome." |
|||
else: " is not a palindrome." |
|||
echo '"', s, '"', txt |
|||
check "rotor" |
|||
check "été" |
|||
check "αννα" |
|||
check "salà las" |
|||
check "In girum imus nocte et consumimur igni" |
|||
check "Esope reste ici et se repose" |
|||
check "This is a palindrom"</syntaxhighlight> |
|||
{{out}} |
|||
<pre>"rotor" is an exact palindrome. |
|||
"été" is an exact palindrome. |
|||
"αννα" is an exact palindrome. |
|||
"salà las" is an inexact palindrome. |
|||
"In girum imus nocte et consumimur igni" is an inexact palindrome. |
|||
"Esope reste ici et se repose" is an inexact palindrome. |
|||
"This is a palindrom" is not a palindrome.</pre> |
|||
=={{header|Objeck}}== |
=={{header|Objeck}}== |
||
< |
<syntaxhighlight lang="objeck"> |
||
bundle Default { |
bundle Default { |
||
class Test { |
class Test { |
||
Line 1,007: | Line 3,992: | ||
} |
} |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|OCaml}}== |
=={{header|OCaml}}== |
||
< |
<syntaxhighlight lang="ocaml">let is_palindrome s = |
||
let |
let l = String.length s in |
||
let rec comp n = |
|||
try |
|||
n = 0 || (s.[l-n] = s.[n-1] && comp (n-1)) in |
|||
comp (l / 2)</syntaxhighlight> |
|||
let j = last - i in |
|||
if str.[i] <> str.[j] then raise Exit |
|||
done; |
|||
(true) |
|||
with Exit -> |
|||
(false)</lang> |
|||
and here a function to remove the white spaces in the string: |
and here a function to remove the white spaces in the string: |
||
< |
<syntaxhighlight lang="ocaml">let rem_space str = |
||
let len = String.length str in |
let len = String.length str in |
||
let res = |
let res = Bytes.create len in |
||
let rec aux i j = |
let rec aux i j = |
||
if i >= len |
if i >= len |
||
then ( |
then (Bytes.sub_string res 0 j) |
||
else match str.[i] with |
else match str.[i] with |
||
| ' ' | '\n' | '\t' | '\r' -> |
| ' ' | '\n' | '\t' | '\r' -> |
||
aux (i+1) (j) |
aux (i+1) (j) |
||
| _ -> |
| _ -> |
||
Bytes.set res j str.[i]; |
|||
aux (i+1) (j+1) |
aux (i+1) (j+1) |
||
in |
in |
||
aux 0 0 |
aux 0 0 |
||
</syntaxhighlight> |
|||
and to make the test case insensitive, just use the function <tt>String. |
and to make the test case insensitive, just use the function <tt>String.lowercase_ascii</tt>. |
||
=={{header|Octave}}== |
=={{header|Octave}}== |
||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="octave">function v = palindro_r(s) |
||
if ( length(s) == 1 ) |
if ( length(s) == 1 ) |
||
v = true; |
v = true; |
||
Line 1,056: | Line 4,037: | ||
v = false; |
v = false; |
||
endif |
endif |
||
endfunction</ |
endfunction</syntaxhighlight> |
||
'''Non-recursive''' |
'''Non-recursive''' |
||
< |
<syntaxhighlight lang="octave">function v = palindro(s) |
||
v = all( (s == s(length(s):-1:1)) == 1); |
v = all( (s == s(length(s):-1:1)) == 1); |
||
endfunction</ |
endfunction</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="octave">palindro_r("ingirumimusnocteetconsumimurigni") |
||
palindro("satorarepotenetoperarotas")</ |
palindro("satorarepotenetoperarotas")</syntaxhighlight> |
||
=={{header|Oforth}}== |
|||
<syntaxhighlight lang="oforth">String method: isPalindrome self reverse self == ;</syntaxhighlight> |
|||
=={{header|Ol}}== |
|||
<syntaxhighlight lang="scheme"> |
|||
; simple case - only lowercase letters |
|||
(define (palindrome? str) |
|||
(let ((l (string->runes str))) |
|||
(equal? l (reverse l)))) |
|||
(print (palindrome? "ingirumimusnocteetconsumimurigni")) |
|||
; ==> #true |
|||
(print (palindrome? "thisisnotapalindrome")) |
|||
; ==> #false |
|||
; complex case - with ignoring letter case and punctuation |
|||
(define (alpha? x) |
|||
(<= #\a x #\z)) |
|||
(define (lowercase x) |
|||
(if (<= #\A x #\Z) |
|||
(- x (- #\A #\a)) |
|||
x)) |
|||
(define (palindrome? str) |
|||
(let ((l (filter alpha? (map lowercase (string->runes str))))) |
|||
(equal? l (reverse l)))) |
|||
(print (palindrome? "A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal-Panama!")) |
|||
; ==> #true |
|||
(print (palindrome? "This is not a palindrome")) |
|||
; ==> #false |
|||
</syntaxhighlight> |
|||
=={{header|Oz}}== |
=={{header|Oz}}== |
||
< |
<syntaxhighlight lang="oz">fun {IsPalindrome S} |
||
{Reverse S} == S |
{Reverse S} == S |
||
end</ |
end</syntaxhighlight> |
||
=={{header|PARI/GP}}== |
=={{header|PARI/GP}}== |
||
<lang>ispal(s)={ |
<syntaxhighlight lang="parigp">ispal(s)={ |
||
s=Vec(s); |
s=Vec(s); |
||
for(i=1,#v\2, |
for(i=1,#v\2, |
||
Line 1,079: | Line 4,095: | ||
); |
); |
||
1 |
1 |
||
};</ |
};</syntaxhighlight> |
||
A version for numbers: |
|||
=={{header|PHP}}== |
|||
{{works with|PARI/GP|2.6.0 and above}} |
|||
<lang php><?php |
|||
<syntaxhighlight lang="parigp">ispal(s)={ |
|||
function is_palindrome($string) { |
|||
my(d=digits(n)); |
|||
return $string == strrev($string); |
|||
for(i=1,#d\2, |
|||
} |
|||
if(d[i]!=d[n+1=i],return(0)) |
|||
?></lang> |
|||
); |
|||
1 |
|||
};</syntaxhighlight> |
|||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
{{works with|Free Pascal}} |
{{works with|Free Pascal}} |
||
< |
<syntaxhighlight lang="pascal">program Palindro; |
||
{ RECURSIVE } |
{ RECURSIVE } |
||
Line 1,112: | Line 4,131: | ||
else |
else |
||
is_palindro := false |
is_palindro := false |
||
end;</ |
end;</syntaxhighlight> |
||
< |
<syntaxhighlight lang="pascal">procedure test_r(s : String; r : Boolean); |
||
begin |
begin |
||
write('"', s, '" is '); |
write('"', s, '" is '); |
||
Line 1,132: | Line 4,151: | ||
test_r(s1, is_palindro(s1)); |
test_r(s1, is_palindro(s1)); |
||
test_r(s2, is_palindro(s2)) |
test_r(s2, is_palindro(s2)) |
||
end.</ |
end.</syntaxhighlight> |
||
<syntaxhighlight lang="pascal">program PalindromeDetection; |
|||
var |
|||
input, output: string; |
|||
s: char; i: integer; |
|||
begin |
|||
writeln('write down your input:'); |
|||
readln(input); |
|||
output:=''; |
|||
for i:=1 to length(input) do |
|||
begin |
|||
s:=input[i]; |
|||
output:=s+output; |
|||
end; |
|||
writeln(''); |
|||
if(input=output)then |
|||
writeln('input was palindrome') |
|||
else |
|||
writeln('input was not palindrome'); |
|||
end.</syntaxhighlight> |
|||
=={{header|PascalABC.NET}}== |
|||
<syntaxhighlight lang="delphi"> |
|||
function IsPalindrome(s: string) := s = s[::-1]; |
|||
begin |
|||
Println(IsPalindrome('arozaupalanalapuazora')); |
|||
Println(IsPalindrome('abcd')); |
|||
end. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
True |
|||
False |
|||
</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
There is more than one way to do this. |
|||
* '''palindrome''' uses the built-in function <tt>reverse()</tt>. |
|||
'''Non-recursive''' |
|||
* '''palindrome_c''' uses iteration; it is a translation of the [[{{PAGENAME}}#C|C solution]]. |
|||
* '''palindrome_r''' uses recursion. |
|||
* '''palindrome_e''' uses a recursive regular expression. |
|||
All of these functions take a parameter, |
|||
palindrome( ) checks if the two halves of the string are mirror images, and palindrome_c( ) is a translation of the C non-recursive solution. |
|||
or default to <tt>$_</tt> if there is no parameter. |
|||
None of these functions ignore case or strip characters; |
|||
if you want do that, you can use <tt>($s = lc $s) =~ s/[\W_]//g</tt> |
|||
before you call these functions. |
|||
<syntaxhighlight lang="perl"># Palindrome.pm |
|||
<lang perl>sub palindrome |
|||
package Palindrome; |
|||
use strict; |
|||
use warnings; |
|||
use Exporter 'import'; |
|||
our @EXPORT = qw(palindrome palindrome_c palindrome_r palindrome_e); |
|||
sub palindrome |
|||
{ |
{ |
||
my $s = (@_ ? shift : $_); |
|||
return $s eq reverse $s; |
return $s eq reverse $s; |
||
} |
} |
||
sub palindrome_c |
sub palindrome_c |
||
{ |
{ |
||
my $s = (@_ ? shift : $_); |
|||
for my $i (0 .. length($s) >> 1) |
for my $i (0 .. length($s) >> 1) |
||
{ |
{ |
||
return 0 unless substr($s, $i, 1) eq substr($s, -1-$i, 1); |
return 0 unless substr($s, $i, 1) eq substr($s, -1 - $i, 1); |
||
} |
} |
||
return 1; |
return 1; |
||
} |
|||
}</lang> |
|||
sub palindrome_r |
|||
'''Recursive''' |
|||
{ |
|||
my $s = (@_ ? shift : $_); |
|||
if (length $s <= 1) { return 1; } |
|||
elsif (substr($s, 0, 1) ne substr($s, -1, 1)) { return 0; } |
|||
else { return palindrome_r(substr($s, 1, -1)); } |
|||
} |
|||
sub palindrome_e |
|||
<lang perl>sub palindrome_r |
|||
{ |
{ |
||
(@_ ? shift : $_) =~ /^(.?|(.)(?1)\2)$/ + 0 |
|||
}</syntaxhighlight> |
|||
if (length $s <= 1) { return 1; } |
|||
elsif (substr($s, 0, 1) ne substr($s, -1, 1)) { return 0; } |
|||
else { return palindrome_r(substr($s, 1, -1)); } |
|||
}</lang> |
|||
This example shows how to use the functions: |
|||
'''Testing''' |
|||
<syntaxhighlight lang="perl"># pbench.pl |
|||
<lang perl>sub mtest |
|||
use strict; |
|||
{ |
|||
use warnings; |
|||
my ( $t, $func ) = @_; |
|||
printf("sequence \"%s\" is%s palindrome\n", |
|||
$t, &$func($t) ? "" : "n't"); |
|||
} |
|||
mtest "ingirumimusnocteetconsumimurigni", \&palindrome; |
|||
mtest "ingirumimusnocteetconsumimurigni", \&palindrome_r; |
|||
mtest "ingirumimusnocteetconsumimurigni", \&palindrome_c; |
|||
use Benchmark qw(cmpthese); |
|||
exit;</lang> |
|||
use Palindrome; |
|||
printf("%d, %d, %d, %d: %s\n", |
|||
palindrome, palindrome_c, palindrome_r, palindrome_e, $_) |
|||
for |
|||
qw/a aa ab abba aBbA abca abba1 1abba |
|||
ingirumimusnocteetconsumimurigni/, |
|||
'ab cc ba', 'ab ccb a'; |
|||
printf "\n"; |
|||
'''Regular Expression''' |
|||
my $latin = "ingirumimusnocteetconsumimurigni"; |
|||
Perl supports recursive regular expressions, which offer yet another way to compute this predicate. |
|||
cmpthese(100_000, { |
|||
<lang perl>sub palindrome {lc (@_ ? shift : $_) =~ /^(.?|(.)(?1)\2)$/ + 0} |
|||
palindrome => sub { palindrome $latin }, |
|||
palindrome_c => sub { palindrome_c $latin }, |
|||
palindrome_r => sub { palindrome_r $latin }, |
|||
palindrome_e => sub { palindrome_e $latin }, |
|||
});</syntaxhighlight> |
|||
{{out}} on a machine running Perl 5.10.1 on amd64-openbsd: |
|||
print palindrome, " : $_\n" for |
|||
<pre>$ perl pbench.pl |
|||
qw/a aa ab abba aBbA abca abba1 1abba |
|||
1, 1, 1, 1: a |
|||
ingirumimusnocteetconsumimurigni/, |
|||
1, 1, 1, 1: aa |
|||
'ab cc ba', 'ab ccb a';</lang><pre>Output: |
|||
0, 0, 0, 0: ab |
|||
1 : |
1, 1, 1, 1: abba |
||
0 : |
0, 0, 0, 0: aBbA |
||
0, 0, 0, 0: abca |
|||
1 : abba |
|||
0, 0, 0, 0: abba1 |
|||
1 : aBbA |
|||
0 : |
0, 0, 0, 0: 1abba |
||
1, 1, 1, 1: ingirumimusnocteetconsumimurigni |
|||
0 : abba1 |
|||
1, 1, 1, 1: ab cc ba |
|||
0 : 1abba |
|||
0, 0, 0, 0: ab ccb a |
|||
1 : ingirumimusnocteetconsumimurigni |
|||
1 : ab cc ba |
|||
0 : ab ccb a |
|||
</pre> |
|||
(warning: too few iterations for a reliable count) |
|||
=={{header|Perl 6}}== |
|||
Rate palindrome_r palindrome_e palindrome_c palindrome |
|||
{{works with|Rakudo Star|2010.08}} |
|||
palindrome_r 51020/s -- -50% -70% -97% |
|||
palindrome_e 102041/s 100% -- -41% -94% |
|||
palindrome_c 172414/s 238% 69% -- -90% |
|||
palindrome 1666667/s 3167% 1533% 867% --</pre> |
|||
With this machine, palindrome() ran far faster than the alternatives |
|||
<lang perl6>sub palin(Str $s --> Bool) { |
|||
(and too fast for a reliable count). |
|||
my @chars = $s.lc.comb(/\w/); |
|||
The Perl regular expression engine recursed twice as fast as the Perl interpreter. |
|||
while @chars > 1 { |
|||
return False unless @chars.shift eq @chars.pop; |
|||
=={{header|Phix}}== |
|||
} |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
return True; |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">is_palindrome</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">==</span><span style="color: #7060A8;">reverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">is_palindrome</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"rotator"</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- prints 1</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">is_palindrome</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"tractor"</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- prints 0</span> |
|||
<span style="color: #008080;">constant</span> <span style="color: #000000;">punctuation</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">" `~!@#$%^&*()-=_+[]{}\\|;:',.<>/?"</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000000;">nulls</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">""</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">punctuation</span><span style="color: #0000FF;">))</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">utf8_to_utf32</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">lower</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">substitute_all</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">punctuation</span><span style="color: #0000FF;">,</span><span style="color: #000000;">nulls</span><span style="color: #0000FF;">)))</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">==</span><span style="color: #7060A8;">reverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #000080;font-style:italic;">-- these all print 1 (true)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"Madam, I'm Adam."</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"A man, a plan, a canal: Panama!"</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"In girum imus nocte et consumimur igni"</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"人人為我,我為人人"</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"Я иду с мечем, судия"</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"아들딸들아"</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"가련하시다 사장집 아들딸들아 집장사 다시 하련가"</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">extra_credit</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"tregða, gón, reiði - er nóg að gert"</span><span style="color: #0000FF;">)</span> |
|||
<!--</syntaxhighlight>--> |
|||
=={{header|Phixmonti}}== |
|||
<syntaxhighlight lang="Phixmonti">include ..\Utilitys.pmt |
|||
def palindrome? dup reverse == enddef |
|||
( "abba" "boom" "radar" "civic" "great" ) |
|||
len for get |
|||
dup print " : palindrome? " print palindrome? |
|||
if "true" else "false" endif ? |
|||
endfor |
|||
def letter? dup 'z' <= swap 'a' >= and enddef |
|||
"" >ps |
|||
"In girum imus nocte, et consumimur igni" dup ? lower |
|||
len for get |
|||
dup letter? |
|||
if |
|||
ps> swap chain >ps |
|||
else |
|||
drop |
|||
endif |
|||
endfor |
|||
ps> palindrome? if "This is an inexact palindrome!" else "Not a palindrome." endif ? |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>abba : palindrome? true |
|||
boom : palindrome? false |
|||
radar : palindrome? true |
|||
civic : palindrome? true |
|||
great : palindrome? false |
|||
In girum imus nocte, et consumimur igni |
|||
This is an inexact palindrome! |
|||
=== Press any key to exit ===</pre> |
|||
=={{header|PHP}}== |
|||
<syntaxhighlight lang="php"><?php |
|||
function is_palindrome($string) { |
|||
return $string == strrev($string); |
|||
} |
} |
||
?></syntaxhighlight> |
|||
Regular expression-based solution ([http://www.polygenelubricants.com/2010/09/matching-palindromes-in-pcre-regex.html source]) |
|||
my @tests = |
|||
<syntaxhighlight lang="php"><?php |
|||
"A man, a plan, a canal: Panama.", |
|||
function is_palindrome($string) { |
|||
"My dog has fleas", |
|||
return preg_match('/^(?:(.)(?=.*(\1(?(2)\2|))$))*.?\2?$/', $string); |
|||
"Madam, I'm Adam.", |
|||
} |
|||
"1 on 1", |
|||
?></syntaxhighlight> |
|||
"In girum imus nocte et consumimur igni"; |
|||
=={{header|Picat}}== |
|||
for @tests { say (palin($_) ?? "Yes" !! "No"),"\t",$_ };</lang> |
|||
<syntaxhighlight lang="picat">go => |
|||
Output: |
|||
Tests = ["In girum imus nocte et consumimur igni", |
|||
<pre> |
|||
"this is a non palindrome string", |
|||
Yes A man, a plan, a canal: Panama. |
|||
"anna ABcdcBA anna", |
|||
No My dog has fleas |
|||
"anna ABcdcBA annax", |
|||
Yes Madam, I'm Adam. |
|||
"A man, a plan, a canoe, pasta, heros, rajahs" ++ |
|||
No 1 on 1 |
|||
"a coloratura, maps, snipe, percale, macaroni, " ++ |
|||
Yes In girum imus nocte et consumimur igni |
|||
"a gag, a banana bag, a tan, a tag, " ++ |
|||
</pre> |
|||
"a banana bag again (or a camel), a crepe, pins, " ++ |
|||
One can also just flip the string and compare, but this way minimizes comparisons without resorting to recursion or indexes. |
|||
"Spam, a rut, a Rolo, cash, a jar, sore hats, " ++ |
|||
"a peon, a canal - Panama!", |
|||
10, |
|||
111111, |
|||
12221, |
|||
9384212, |
|||
10.01 |
|||
], |
|||
foreach(Test in Tests) |
|||
if is_palindrome(Test) then |
|||
println([Test, "exact palindrome"]) |
|||
elseif is_palindrome_inexact(Test) then |
|||
println([Test, "inexact palindrome"]) |
|||
else |
|||
println([Test, "no"]) |
|||
end |
|||
end, |
|||
nl. |
|||
% Detect palindromes for strings (and numbers). |
|||
is_palindrome(N), number(N) => is_palindrome(N.to_string()). |
|||
is_palindrome(S) => S == S.reverse(). |
|||
% Detect inexact palindromes. |
|||
is_palindrome_inexact(N), number(N) => is_palindrome_inexact(N.to_string()). |
|||
is_palindrome_inexact(S) => |
|||
is_palindrome(strip(S)). |
|||
% convert to lowercase and |
|||
% skips punctuation and white space. |
|||
strip(S) = [C : C in S.to_lowercase(), |
|||
not C.membchk("!?,.;-_ \t\n()[]{}")].</syntaxhighlight> |
|||
{{out}} |
|||
<pre>[In girum imus nocte et consumimur igni,inexact palindrome] |
|||
[this is a non palindrome string,no] |
|||
[anna ABcdcBA anna,exact palindrome] |
|||
[anna ABcdcBA annax,no] |
|||
[A man, a plan, a canoe, pasta, heros, rajahsa coloratura, maps, snipe, percale, macaroni, a gag, a banana bag, a tan, a tag, a banana bag again (or a camel), a crepe, pins, Spam, a rut, a Rolo, cash, a jar, sore hats, a peon, a canal - Panama!,inexact palindrome] |
|||
[10,no] |
|||
[11,exact palindrome] |
|||
[111111,exact palindrome] |
|||
[12221,exact palindrome] |
|||
[9384212,no] |
|||
[10.01,exact palindrome]</pre> |
|||
=={{header|PicoLisp}}== |
=={{header|PicoLisp}}== |
||
< |
<syntaxhighlight lang="picolisp">(de palindrome? (S) |
||
(= (setq S (chop S)) (reverse S)) )</ |
(= (setq S (chop S)) (reverse S)) )</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>: (palindrome? "ingirumimusnocteetconsumimurigni") |
<pre>: (palindrome? "ingirumimusnocteetconsumimurigni") |
||
-> T</pre> |
-> T</pre> |
||
=={{header|Pike}}== |
=={{header|Pike}}== |
||
< |
<syntaxhighlight lang="pike">int main(){ |
||
if(pal("rotator")){ |
if(pal("rotator")){ |
||
write("palindrome!\n"); |
write("palindrome!\n"); |
||
Line 1,255: | Line 4,451: | ||
return 0; |
return 0; |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
=={{header|PL/I}}== |
=={{header|PL/I}}== |
||
To satisfy the revised specification (which contradicts the preceding explanation) |
|||
<lang PL/I> |
|||
the following trivially solves the problem in PL/I: |
|||
is_palindrome: procedure (text) returns (bit(1)); |
|||
<syntaxhighlight lang="pl/i">is_palindrome = (text = reverse(text));</syntaxhighlight> |
|||
The following solution strips spaces: |
|||
<syntaxhighlight lang="text">is_palindrome: procedure (text) returns (bit(1)); |
|||
declare text character (*) varying; |
declare text character (*) varying; |
||
Line 1,276: | Line 4,476: | ||
return (substr(text, 1, j)); |
return (substr(text, 1, j)); |
||
end remove_blanks; |
end remove_blanks; |
||
end is_palindrome; |
end is_palindrome;</syntaxhighlight> |
||
</lang> |
|||
=={{header|PL/M}}== |
|||
<syntaxhighlight lang="plm">100H: |
|||
/* CHECK EXACT PALINDROME ASSUMING $-TERMINATED STRING */ |
|||
PALINDROME: PROCEDURE(PTR) BYTE; |
|||
DECLARE (PTR, FRONT, BACK) ADDRESS, STR BASED PTR BYTE; |
|||
/* FIND END */ |
|||
FRONT, BACK = 0; |
|||
DO WHILE STR(BACK) <> '$'; |
|||
BACK = BACK + 1; |
|||
END; |
|||
BACK = BACK - 1; |
|||
/* CHECK MATCH */ |
|||
DO WHILE (FRONT < BACK) AND (STR(FRONT) = STR(BACK)); |
|||
FRONT = FRONT + 1; |
|||
BACK = BACK - 1; |
|||
END; |
|||
RETURN FRONT >= BACK; |
|||
END PALINDROME; |
|||
/* CHECK INEXACT PALINDROME: FILTER OUT NON-LETTERS AND NUMBERS */ |
|||
INEXACT$PALINDROME: PROCEDURE(PTR) BYTE; |
|||
/* 256 BYTES OUGHT TO BE ENOUGH FOR EVERYONE */ |
|||
DECLARE (PTR, OPTR) ADDRESS; |
|||
DECLARE FILTER (256) BYTE; |
|||
DECLARE (IN BASED PTR, OUT BASED OPTR) BYTE; |
|||
OPTR = .FILTER; |
|||
DO WHILE IN <> '$'; |
|||
OUT = IN OR 32; |
|||
/* LOWERCASE CHARACTERS ARE NOT IN THE PL/M CHARSET, |
|||
BUT WE CAN JUST WRITE THE ASCII VALUES AS NUMBERS */ |
|||
IF (OUT >= '0' AND OUT <= '9') |
|||
OR (OUT >= 97 AND OUT <= 122) THEN |
|||
OPTR = OPTR + 1; |
|||
PTR = PTR + 1; |
|||
END; |
|||
OUT = '$'; |
|||
RETURN PALINDROME(.FILTER); |
|||
END INEXACT$PALINDROME; |
|||
/* CP/M BDOS CALLS */ |
|||
BDOS: PROCEDURE(FUNC, ARG); |
|||
DECLARE FUNC BYTE, ARG ADDRESS; |
|||
GO TO 5; |
|||
END BDOS; |
|||
PRINT: PROCEDURE(STRING); |
|||
DECLARE STRING ADDRESS; |
|||
CALL BDOS(9, STRING); |
|||
END PRINT; |
|||
/* TEST SOME STRINGS */ |
|||
DECLARE STRINGS (8) ADDRESS; |
|||
STRINGS(0) = .'ROTOR$'; |
|||
STRINGS(1) = .'RACECAR$'; |
|||
STRINGS(2) = .'LEVEL$'; |
|||
STRINGS(3) = .'REDDER$'; |
|||
STRINGS(4) = .'RACECAR$'; |
|||
STRINGS(5) = .'A MAN, A PLAN, A CANAL: PANAMA$'; |
|||
STRINGS(6) = .'EGAD, A BASE TONE DENOTES A BAD AGE.$'; |
|||
STRINGS(7) = .'ROSETTA$'; |
|||
DECLARE N BYTE; |
|||
DO N = 0 TO LAST(STRINGS); |
|||
CALL PRINT(STRINGS(N)); |
|||
CALL PRINT(.': $'); |
|||
IF PALINDROME(STRINGS(N)) THEN |
|||
CALL PRINT(.'EXACT$'); |
|||
ELSE IF INEXACT$PALINDROME(STRINGS(N)) THEN |
|||
CALL PRINT(.'INEXACT$'); |
|||
ELSE |
|||
CALL PRINT(.'NOT A PALINDROME$'); |
|||
CALL PRINT(.(13,10,'$')); |
|||
END; |
|||
CALL BDOS(0,0); |
|||
EOF</syntaxhighlight> |
|||
{{out}} |
|||
<pre>ROTOR: EXACT |
|||
RACECAR: EXACT |
|||
LEVEL: EXACT |
|||
REDDER: EXACT |
|||
RACECAR: EXACT |
|||
A MAN, A PLAN, A CANAL: PANAMA: INEXACT |
|||
EGAD, A BASE TONE DENOTES A BAD AGE.: INEXACT |
|||
ROSETTA: NOT A PALINDROME</pre> |
|||
=={{header|Plain English}}== |
|||
Strings and substrings all come with two byte pointers by default: |
|||
* <code>first</code>, which points to the first byte in the string. |
|||
* <code>last</code>, which points to the last byte in the string. |
|||
<code>first</code> is an address, while <code>first's target</code> is the byte at that address. |
|||
No need to actually reverse the string; just compare the first's target with the last's target until they meet in the middle. |
|||
<syntaxhighlight lang="plainenglish">To decide if a string is palindromic: |
|||
Slap a substring on the string. |
|||
Loop. |
|||
If the substring's first is greater than the substring's last, say yes. |
|||
If the substring's first's target is not the substring's last's target, say no. |
|||
Add 1 to the substring's first. |
|||
Subtract 1 from the substring's last. |
|||
Repeat.</syntaxhighlight> |
|||
=={{header|Pointless}}== |
|||
'''Basic Function''' |
|||
<syntaxhighlight lang="pointless">isPalindrome(chars) = |
|||
chars == reverse(chars)</syntaxhighlight> |
|||
'''With Pre-processing''' |
|||
<syntaxhighlight lang="pointless">output = |
|||
"A man, a plan, a canal -- Panama" |
|||
|> toList |
|||
|> filter(inFunc(alNums)) |
|||
|> map(toLower) |
|||
|> isPalindrome |
|||
|> println</syntaxhighlight> |
|||
{{out}} |
|||
<pre>true</pre> |
|||
=={{header|Potion}}== |
|||
<syntaxhighlight lang="potion"># The readable recursive version |
|||
palindrome_i = (s, b, e): |
|||
if (e <= b): true. |
|||
elsif (s ord(b) != s ord(e)): false. |
|||
else: palindrome_i(s, b+1, e-1). |
|||
. |
|||
palindrome = (s): |
|||
palindrome_i(s, 0, s length - 1). |
|||
palindrome(argv(1))</syntaxhighlight> |
|||
=={{header|PowerBASIC}}== |
=={{header|PowerBASIC}}== |
||
Line 1,283: | Line 4,621: | ||
The output is identical to the [[#BASIC|QBasic]] version, above. |
The output is identical to the [[#BASIC|QBasic]] version, above. |
||
< |
<syntaxhighlight lang="powerbasic">FUNCTION isPalindrome (what AS STRING) AS LONG |
||
DIM whatcopy AS STRING, chk AS STRING, tmp AS STRING * 1, L0 AS LONG |
DIM whatcopy AS STRING, chk AS STRING, tmp AS STRING * 1, L0 AS LONG |
||
Line 1,314: | Line 4,652: | ||
END IF |
END IF |
||
NEXT |
NEXT |
||
END FUNCTION</ |
END FUNCTION</syntaxhighlight> |
||
=={{header|PowerShell}}== |
|||
An exact version based on reversing the string: |
|||
<syntaxhighlight lang="powershell"> |
|||
Function Test-Palindrome( [String] $Text ){ |
|||
$CharArray = $Text.ToCharArray() |
|||
[Array]::Reverse($CharArray) |
|||
$Text -eq [string]::join('', $CharArray) |
|||
} |
|||
</syntaxhighlight> |
|||
===PowerShell (Regex Version)=== |
|||
This version is much faster because it does not manipulate arrays. [This is not clear; the above version was slowed down by using -join instead of [string]::join, and -like instead of -eq. After changing those it is similar, if not faster, than this version]. |
|||
<syntaxhighlight lang="powershell"> |
|||
function Test-Palindrome |
|||
{ |
|||
<# |
|||
.SYNOPSIS |
|||
Tests if a string is a palindrome. |
|||
.DESCRIPTION |
|||
Tests if a string is a true palindrome or, optionally, an inexact palindrome. |
|||
.EXAMPLE |
|||
Test-Palindrome -Text "racecar" |
|||
.EXAMPLE |
|||
Test-Palindrome -Text '"Deliver desserts," demanded Nemesis, "emended, named, stressed, reviled."' -Inexact |
|||
#> |
|||
[CmdletBinding()] |
|||
[OutputType([bool])] |
|||
Param |
|||
( |
|||
# The string to test for palindrominity. |
|||
[Parameter(Mandatory=$true)] |
|||
[string] |
|||
$Text, |
|||
# When specified, detects an inexact palindrome. |
|||
[switch] |
|||
$Inexact |
|||
) |
|||
if ($Inexact) |
|||
{ |
|||
# Strip all punctuation and spaces |
|||
$Text = [Regex]::Replace("$Text($7&","[^1-9a-zA-Z]","") |
|||
} |
|||
$Text -match "^(?'char'[a-z])+[a-z]?(?:\k'char'(?'-char'))+(?(char)(?!))$" |
|||
} |
|||
</syntaxhighlight> |
|||
<syntaxhighlight lang="powershell"> |
|||
Test-Palindrome -Text 'radar' |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
True |
|||
</pre> |
|||
<syntaxhighlight lang="powershell"> |
|||
Test-Palindrome -Text "In girum imus nocte et consumimur igni." |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
False |
|||
</pre> |
|||
<syntaxhighlight lang="powershell"> |
|||
Test-Palindrome -Text "In girum imus nocte et consumimur igni." -Inexact |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
True |
|||
</pre> |
|||
===PowerShell (Unicode category aware, no string reverse)=== |
|||
An inexact version can remove punctuation by looking at Unicode categories for each character, either using .Net methods or a regex. |
|||
<syntaxhighlight lang="powershell">Function Test-Palindrome { |
|||
[CmdletBinding()] |
|||
Param( |
|||
[Parameter(ValueFromPipeline)] |
|||
[string[]]$Text |
|||
) |
|||
process { |
|||
:stringLoop foreach ($T in $Text) |
|||
{ |
|||
# Normalize Unicode combining characters, |
|||
# so character á compares the same as (a+combining accent) |
|||
$T = $T.Normalize([Text.NormalizationForm]::FormC) |
|||
# Remove anything from outside the Unicode category |
|||
# "Letter from any language" |
|||
$T = $T -replace '\P{L}', '' |
|||
# Walk from each end of the string inwards, |
|||
# comparing a char at a time. |
|||
# Avoids string copy / reverse overheads. |
|||
$Left, $Right = 0, [math]::Max(0, ($T.Length - 1)) |
|||
while ($Left -lt $Right) |
|||
{ |
|||
if ($T[$Left] -ne $T[$Right]) |
|||
{ |
|||
# return early if string is not a palindrome |
|||
[PSCustomObject]@{ |
|||
Text = $T |
|||
IsPalindrome = $False |
|||
} |
|||
continue stringLoop |
|||
} |
|||
else |
|||
{ |
|||
$Left++ |
|||
$Right-- |
|||
} |
|||
} |
|||
# made it to here, then string is a palindrome |
|||
[PSCustomObject]@{ |
|||
Text = $T |
|||
IsPalindrome = $True |
|||
} |
|||
} |
|||
} |
|||
} |
|||
'ánu-ná', 'nowt' | Test-Palindrome</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
PS C:\> 'ánu-ná', 'nowt' | Test-Palindrome |
|||
Text IsPalindrome |
|||
---- ------------ |
|||
ánuná True |
|||
now False |
|||
</pre> |
|||
=={{header|Processing}}== |
|||
<syntaxhighlight lang="processing"> |
|||
void setup(){ |
|||
println(isPalindrome(InsertPalindromeHere)); |
|||
} |
|||
boolean isPalindrome(string check){ |
|||
char[] letters = new char[check.length]; |
|||
string invert = " "; |
|||
string modCheck = " " + check; |
|||
for(int i = 0; i < letters.length; i++){ |
|||
letters[i] = check.charAt(i); |
|||
} |
|||
for(int i = letters.length-1; i >= 0; i--){ |
|||
invert = invert + letters[i]; |
|||
} |
|||
if(invert == modCheck){ |
|||
return true; |
|||
} else { |
|||
return false; |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
"true" or "false" depending |
|||
</pre> |
|||
====Alternative Implementation: using StringBuilder, implementing exact and inexact check==== |
|||
<syntaxhighlight lang="processing"> |
|||
void setup(){ |
|||
println("PalindromeDetection"); |
|||
String[] tests = { |
|||
"abcba", |
|||
"aa", |
|||
"a", |
|||
"", |
|||
" ", |
|||
"ab", |
|||
"abcdba", |
|||
"A man, a plan, a canal: Panama!", |
|||
"Dammit, I’m Mad!", |
|||
"Never odd or even", |
|||
"ingirumimusnocteetconsumimurigni" |
|||
}; |
|||
for (int i = 0; i < tests.length; i++){ |
|||
println((i + 1) + ". '" + tests[i] + "' isExactPalindrome: " + isExactPalindrome(tests[i]) + " isInexactPalindrome: " + isInexactPalindrome(tests[i])); |
|||
} |
|||
} |
|||
/* |
|||
* Check for exact palindrome using StringBuilder and String since String in Java does not provide any reverse functionality because Strings are immutable. |
|||
*/ |
|||
boolean isExactPalindrome(String s){ |
|||
StringBuilder sb = new StringBuilder(s); |
|||
return s.equals(sb.reverse().toString()); |
|||
} |
|||
/* |
|||
* Check for inexact palindrome using the check for exact palindromeabove. |
|||
*/ |
|||
boolean isInexactPalindrome(String s){ |
|||
// removes all whitespaces and non-visible characters, |
|||
// remove anything besides alphabet characters |
|||
// ignore case |
|||
return isExactPalindrome(s.replaceAll("\\s+","").replaceAll("[^A-Za-z]+", "").toLowerCase()); |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
PalindromeDetection |
|||
1. 'abcba' isExactPalindrome: true isInexactPalindrome: true |
|||
2. 'aa' isExactPalindrome: true isInexactPalindrome: true |
|||
3. 'a' isExactPalindrome: true isInexactPalindrome: true |
|||
4. '' isExactPalindrome: true isInexactPalindrome: true |
|||
5. ' ' isExactPalindrome: true isInexactPalindrome: true |
|||
6. 'ab' isExactPalindrome: false isInexactPalindrome: false |
|||
7. 'abcdba' isExactPalindrome: false isInexactPalindrome: false |
|||
8. 'A man, a plan, a canal: Panama!' isExactPalindrome: false isInexactPalindrome: true |
|||
9. 'Dammit, I’m Mad!' isExactPalindrome: false isInexactPalindrome: true |
|||
10. 'Never odd or even' isExactPalindrome: false isInexactPalindrome: true |
|||
11. 'ingirumimusnocteetconsumimurigni' isExactPalindrome: true isInexactPalindrome: true |
|||
</pre> |
|||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
||
Line 1,321: | Line 4,878: | ||
From [http://www2.dcs.hull.ac.uk/NEAT/dnd/AI/prolog/tutorial2.html this tutorial]. |
From [http://www2.dcs.hull.ac.uk/NEAT/dnd/AI/prolog/tutorial2.html this tutorial]. |
||
< |
<syntaxhighlight lang="prolog">palindrome(Word) :- name(Word,List), reverse(List,List).</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
{{works with|SWI Prolog}} |
{{works with|SWI Prolog}} |
||
< |
<syntaxhighlight lang="prolog">pali(Str) :- sub_string(Str, 0, 1, _, X), string_concat(Str2, X, Str), string_concat(X, Mid, Str2), pali(Mid). |
||
pali(Str) :- string_length(Str, Len), Len < 2.</ |
pali(Str) :- string_length(Str, Len), Len < 2.</syntaxhighlight> |
||
Changing '''string''' into '''atom''' makes the program run also on GNU Prolog. I.e. |
Changing '''string''' into '''atom''' makes the program run also on GNU Prolog. I.e. |
||
Line 1,333: | Line 4,890: | ||
{{works with|GNU Prolog}} |
{{works with|GNU Prolog}} |
||
< |
<syntaxhighlight lang="prolog">pali(Str) :- sub_atom(Str, 0, 1, _, X), atom_concat(Str2, X, Str), atom_concat(X, Mid, Str2), pali(Mid). |
||
pali(Str) :- atom_length(Str, Len), Len < 2.</ |
pali(Str) :- atom_length(Str, Len), Len < 2.</syntaxhighlight> |
||
=={{header|PureBasic}}== |
=={{header|PureBasic}}== |
||
{{works with|PureBasic|4.41}} |
{{works with|PureBasic|4.41}} |
||
< |
<syntaxhighlight lang="purebasic">Procedure IsPalindrome(StringToTest.s) |
||
If StringToTest=ReverseString(StringToTest) |
If StringToTest=ReverseString(StringToTest) |
||
ProcedureReturn 1 |
ProcedureReturn 1 |
||
Line 1,343: | Line 4,901: | ||
ProcedureReturn 0 |
ProcedureReturn 0 |
||
EndIf |
EndIf |
||
EndProcedure</ |
EndProcedure</syntaxhighlight> |
||
=={{header|Python}}== |
=={{header|Python}}== |
||
Now that Python 2.7 and Python 3.4 are quite different, We should include the version IMHO. |
|||
'''Non-recursive''' |
'''Non-recursive''' |
||
This one uses the ''reversing the string'' technique |
This one uses the ''reversing the string'' technique |
||
(to reverse a string Python can use the odd |
|||
but right syntax <tt>string[::-1]</tt>) |
but right syntax <tt>string[::-1]</tt>) |
||
< |
<syntaxhighlight lang="python">def is_palindrome(s): |
||
return s == s[::-1]</ |
return s == s[::-1]</syntaxhighlight> |
||
'''Non-recursive, Ignoring Punctuation/Case/Spaces''' |
|||
A word is a palindrome if the letters are the same forwards as backwards, but the other methods given here will return False for, e.g., an input of "Go hang a salami, I'm a lasagna hog" or "A man, a plan, a canal: Panama." An implementation that traverses the string and ignores case differences, spaces, and non-alpha characters is pretty trivial. |
|||
<syntaxhighlight lang="python">def is_palindrome(s): |
|||
low = 0 |
|||
high = len(s) - 1 |
|||
while low < high: |
|||
if not s[low].isalpha(): |
|||
low += 1 |
|||
elif not s[high].isalpha(): |
|||
high -= 1 |
|||
else: |
|||
if s[low].lower() != s[high].lower(): |
|||
return False |
|||
else: |
|||
low += 1 |
|||
high -= 1 |
|||
return True</syntaxhighlight> |
|||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="python">def is_palindrome_r(s): |
||
if len(s) <= 1: |
if len(s) <= 1: |
||
return True |
return True |
||
Line 1,363: | Line 4,943: | ||
return False |
return False |
||
else: |
else: |
||
return is_palindrome_r(s[1:-1])</ |
return is_palindrome_r(s[1:-1])</syntaxhighlight> |
||
Python has short-circuit evaluation of Boolean operations |
Python has short-circuit evaluation of Boolean operations |
||
so a shorter and still easy to understand recursive function is |
|||
< |
<syntaxhighlight lang="python">def is_palindrome_r2(s): |
||
return not s or s[0] == s[-1] and is_palindrome_r2(s[1:-1])</ |
return not s or s[0] == s[-1] and is_palindrome_r2(s[1:-1])</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="python">def test(f, good, bad): |
||
assert all(f(x) for x in good) |
assert all(f(x) for x in good) |
||
assert not any(f(x) for x in bad) |
assert not any(f(x) for x in bad) |
||
Line 1,380: | Line 4,961: | ||
notpals = ('aA', 'abA', 'abxBa', 'abxxBa') |
notpals = ('aA', 'abA', 'abxBa', 'abxxBa') |
||
for ispal in is_palindrome, is_palindrome_r, is_palindrome_r2: |
for ispal in is_palindrome, is_palindrome_r, is_palindrome_r2: |
||
test(ispal, pals, notpals)</ |
test(ispal, pals, notpals)</syntaxhighlight> |
||
''' Palindrome Using Regular Expressions Python 2.7 ''' |
|||
<syntaxhighlight lang="python">def p_loop(): |
|||
import re, string |
|||
re1="" # Beginning of Regex |
|||
re2="" # End of Regex |
|||
pal=raw_input("Please Enter a word or phrase: ") |
|||
pd = pal.replace(' ','') |
|||
for c in string.punctuation: |
|||
pd = pd.replace(c,"") |
|||
if pal == "" : |
|||
return -1 |
|||
c=len(pd) # Count of chars. |
|||
loops = (c+1)/2 |
|||
for x in range(loops): |
|||
re1 = re1 + "(\w)" |
|||
if (c%2 == 1 and x == 0): |
|||
continue |
|||
p = loops - x |
|||
re2 = re2 + "\\" + str(p) |
|||
regex= re1+re2+"$" # regex is like "(\w)(\w)(\w)\2\1$" |
|||
#print(regex) # To test regex before re.search |
|||
m = re.search(r'^'+regex,pd,re.IGNORECASE) |
|||
if (m): |
|||
print("\n "+'"'+pal+'"') |
|||
print(" is a Palindrome\n") |
|||
return 1 |
|||
else: |
|||
print("Nope!") |
|||
return 0</syntaxhighlight> |
|||
'''Checking the left half against a reflection of the right half''' |
|||
<syntaxhighlight lang="python">'''Palindrome detection''' |
|||
# isPalindrome :: String -> Bool |
|||
def isPalindrome(s): |
|||
'''True if the string is unchanged under reversal. |
|||
(The left half is a reflection of the right half) |
|||
''' |
|||
d, m = divmod(len(s), 2) |
|||
return s[0:d] == s[d + m:][::-1] |
|||
# ------------------------- TEST ------------------------- |
|||
# main :: IO () |
|||
def main(): |
|||
'''Test''' |
|||
print('\n'.join( |
|||
f'{repr(s)} -> {isPalindrome(cleaned(s))}' for s in [ |
|||
"", |
|||
"a", |
|||
"ab", |
|||
"aba", |
|||
"abba", |
|||
"In girum imus nocte et consumimur igni" |
|||
] |
|||
)) |
|||
# cleaned :: String -> String |
|||
def cleaned(s): |
|||
'''A lower-case copy of s, with spaces pruned.''' |
|||
return [c.lower() for c in s if ' ' != c] |
|||
# MAIN --- |
|||
if __name__ == '__main__': |
|||
main() |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>'' -> True |
|||
'a' -> True |
|||
'ab' -> False |
|||
'aba' -> True |
|||
'abba' -> True |
|||
'In girum imus nocte et consumimur igni' -> True</pre> |
|||
'''Twiddle Indexing''' |
|||
I have no idea what this technique is called, so I'm going with "Twiddle Indexing". |
|||
<pre> Twiddle Indexing v. Negative Indexing |
|||
0 1 2 3 4 <-- index |
|||
[ a, b, c, d, e ] |
|||
~4 ~3 ~2 ~1 ~0 <-- twiddle index |
|||
0 1 2 3 4 <-- index |
|||
[ a, b, c, d, e ] |
|||
-5 -4 -3 -2 -1 <-- negative index</pre> |
|||
<syntaxhighlight lang="python">def palindromic(str): |
|||
for i in range(len(str)//2): |
|||
if str[i] != str[~i]: |
|||
return(False) |
|||
return(True)</syntaxhighlight> |
|||
=={{header|Quackery}}== |
|||
<syntaxhighlight lang="quackery"> [ dup reverse = ] is palindromic ( [ --> b ) |
|||
[ [] swap witheach |
|||
[ upper dup |
|||
dup lower = iff |
|||
drop else join ] |
|||
palindromic ] is inexactpalindrome ( $ --> b )</syntaxhighlight> |
|||
===Twiddle Indexing=== |
|||
<syntaxhighlight lang="quackery"> [ true swap |
|||
dup size 2 / times |
|||
[ dup i peek |
|||
over i ~ peek != if |
|||
[ dip not conclude ] ] |
|||
drop ] is palindromic ( [ --> b )</syntaxhighlight> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
'''Recursive''' |
'''Recursive''' |
||
Note that the recursive method will fail if the string length is too long. |
Note that the recursive method will fail if the string length is too long. |
||
R will assume an infinite recursion if a recursion nests deeper than 5,000. |
|||
<lang R>palindro <- function(p) { |
|||
Options may be set in the environment to increase this to 500,000. |
|||
<syntaxhighlight lang="rsplus">palindro <- function(p) { |
|||
if ( nchar(p) == 1 ) { |
if ( nchar(p) == 1 ) { |
||
return(TRUE) |
return(TRUE) |
||
Line 1,398: | Line 5,100: | ||
} |
} |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
'''Iterative''' |
'''Iterative''' |
||
< |
<syntaxhighlight lang="rsplus">palindroi <- function(p) { |
||
for(i in 1:floor(nchar(p)/2) ) { |
for(i in 1:floor(nchar(p)/2) ) { |
||
r <- nchar(p) - i + 1 |
r <- nchar(p) - i + 1 |
||
Line 1,407: | Line 5,109: | ||
} |
} |
||
TRUE |
TRUE |
||
}</ |
}</syntaxhighlight> |
||
'''Comparative''' |
'''Comparative''' |
||
Line 1,413: | Line 5,115: | ||
This method is somewhat faster than the other two. |
This method is somewhat faster than the other two. |
||
Note that this method incorrectly regards an empty string as not a palindrome. |
Note that this method incorrectly regards an empty string as not a palindrome. |
||
Please leave this bug in the code, and take a look a the [[Testing_a_Function]] page. |
|||
<lang R>revstring <- function(stringtorev) { |
|||
<syntaxhighlight lang="rsplus">revstring <- function(stringtorev) { |
|||
return( |
return( |
||
paste( |
paste( |
||
Line 1,421: | Line 5,124: | ||
) |
) |
||
} |
} |
||
palindroc <- function(p) {return(revstring(p)==p)}</ |
palindroc <- function(p) {return(revstring(p)==p)}</syntaxhighlight> |
||
''' |
'''Rev''' |
||
R has a built-in function for reversing vectors, so we only have to coerce our input in to the proper form. |
|||
Unicode is supported, but this ignores the "inexact palindromes" extra credit requirement because, without some sort of regex, supporting Unicode while stripping punctuation and white space is hard in R. |
|||
<syntaxhighlight lang="rsplus">is.Palindrome <- function(string) |
|||
{ |
|||
characters <- unlist(strsplit(string, "")) |
|||
all(characters == rev(characters)) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
The rev solution is not benchmarked. |
|||
<pre> |
<pre> |
||
test <- "ingirumimusnocteetconsumimurigni" |
test <- "ingirumimusnocteetconsumimurigni" |
||
Line 1,439: | Line 5,153: | ||
0 0 0 |
0 0 0 |
||
</pre> |
</pre> |
||
=={{header|Racket}}== |
|||
<syntaxhighlight lang="racket"> |
|||
(define (palindromb str) |
|||
(let* ([lst (string->list (string-downcase str))] |
|||
[slst (remove* '(#\space) lst)]) |
|||
(string=? (list->string (reverse slst)) (list->string slst)))) |
|||
;;example output |
|||
> (palindromb "able was i ere i saw elba") |
|||
#t |
|||
> (palindromb "waht the hey") |
|||
#f |
|||
> (palindromb "In girum imus nocte et consumimur igni") |
|||
#t |
|||
> |
|||
</syntaxhighlight> |
|||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
<syntaxhighlight lang="raku" line>subset Palindrom of Str where { |
|||
.flip eq $_ given .comb(/\w+/).join.lc |
|||
} |
|||
my @tests = q:to/END/.lines; |
|||
A man, a plan, a canal: Panama. |
|||
My dog has fleas |
|||
Madam, I'm Adam. |
|||
1 on 1 |
|||
In girum imus nocte et consumimur igni |
|||
END |
|||
for @tests { say $_ ~~ Palindrom, "\t", $_ }</syntaxhighlight> |
|||
{{out}} |
|||
<pre>True A man, a plan, a canal: Panama. |
|||
False My dog has fleas |
|||
True Madam, I'm Adam. |
|||
False 1 on 1 |
|||
True In girum imus nocte et consumimur igni |
|||
</pre> |
|||
=={{header|Rascal}}== |
|||
The most simple solution: |
|||
<syntaxhighlight lang="rascal">import String; |
|||
public bool palindrome(str text) = toLowerCase(text) == reverse(text);</syntaxhighlight> |
|||
A solution that handles sentences with spaces and capitals: |
|||
<syntaxhighlight lang="rascal">import String; |
|||
public bool palindrome(str text){ |
|||
text = replaceAll(toLowerCase(text), " ", ""); |
|||
return text == reverse(text); |
|||
} |
|||
</syntaxhighlight> |
|||
Example: |
|||
<syntaxhighlight lang="rascal">rascal>palindrome("In girum imus nocte et consumimur igni") |
|||
bool: true</syntaxhighlight> |
|||
=={{header|REBOL}}== |
=={{header|REBOL}}== |
||
< |
<syntaxhighlight lang="rebol">REBOL [ |
||
Title: "Palindrome Recognizer" |
Title: "Palindrome Recognizer" |
||
Date: 2010-01-03 |
|||
Author: oofoe |
|||
URL: http://rosettacode.org/wiki/Palindrome |
URL: http://rosettacode.org/wiki/Palindrome |
||
] |
] |
||
Line 1,472: | Line 5,246: | ||
assert [palindrome? "In girum imus nocte et consumimur igni"] ; Spaces not removed. |
assert [palindrome? "In girum imus nocte et consumimur igni"] ; Spaces not removed. |
||
; I know we're doing palindromes, not alliteration, but who could resist...?</ |
; I know we're doing palindromes, not alliteration, but who could resist...?</syntaxhighlight> |
||
Output: |
|||
{{out}} |
|||
<pre>Simple palindromes, with an exception for variety: |
<pre>Simple palindromes, with an exception for variety: |
||
ok [palindrome? "z"] |
ok [palindrome? "z"] |
||
Line 1,489: | Line 5,262: | ||
=={{header|Retro}}== |
=={{header|Retro}}== |
||
<syntaxhighlight lang="retro"> |
|||
<lang Retro> |
|||
:palindrome? (s-f) dup s:hash [ s:reverse s:hash ] dip eq? ; |
|||
with strings' |
|||
with hashing' |
|||
: palindrome? ( $-f ) dup hash [ reverse hash ] dip = ; |
|||
'ingirumimusnocteetconsumimurigni palindrome? n:put |
|||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header| |
=={{header|Refal}}== |
||
<syntaxhighlight lang="refal">$ENTRY Go { |
|||
<lang REXX> |
|||
= <Test 'rotor'> |
|||
y='In girum imus nocte et consumimur igni' |
|||
<Test 'racecar'> |
|||
<Test 'RACEcar'> |
|||
<Test 'level'> |
|||
<Test 'rosetta'> |
|||
<Test 'A man, a plan, a canal: Panama'> |
|||
<Test 'Egad, a base tone denotes a bad age'> |
|||
<Test 'This is not a palindrome'>; |
|||
}; |
|||
Test { |
|||
/*translation: We walk around in the night and */ |
|||
e.W, <Palindrome e.W> <InexactPalindrome e.W>: { |
|||
/* we are burnt by the fire (of love). */ |
|||
True s.1 = <Prout e.W ': exact palindrome'>; |
|||
s.1 True = <Prout e.W ': inexact palindrome'>; |
|||
False False = <Prout e.W ': not a palindrome'>; |
|||
}; |
|||
}; |
|||
InexactPalindrome { |
|||
say |
|||
e.W = <Palindrome <Filter ('ABCDEFGHIJKLMNOPQRSTUVWXYZ') <Upper e.W>>>; |
|||
say 'string='y |
|||
}; |
|||
say |
|||
Filter { |
|||
pal=isPal(y) |
|||
(e.Keep) = ; |
|||
(e.Keep) s.C e.W, e.Keep: { |
|||
e.1 s.C e.2 = s.C <Filter (e.Keep) e.W>; |
|||
e.1 = <Filter (e.Keep) e.W>; |
|||
}; |
|||
}; |
|||
Palindrome { |
|||
if pal==0 then say "The string isn't palindromic." |
|||
= True; |
|||
else say 'The string is palindromic.' |
|||
s.C = True; |
|||
s.C e.W s.C = <Palindrome e.W>; |
|||
e.X = False; |
|||
};</syntaxhighlight> |
|||
{{out}} |
|||
<pre>rotor: exact palindrome |
|||
marinus@frankenstein:~/refal$ refc palin && refgo palin |
|||
Refal-5 Compiler. Version PZ Jan 25 2024 |
|||
Copyright: Refal Systems Inc. |
|||
rotor: exact palindrome |
|||
racecar: exact palindrome |
|||
RACEcar: inexact palindrome |
|||
level: exact palindrome |
|||
rosetta: not a palindrome |
|||
A man, a plan, a canal: Panama: inexact palindrome |
|||
Egad, a base tone denotes a bad age: inexact palindrome |
|||
This is not a palindrome: not a palindrome</pre> |
|||
=={{header|REXX}}== |
|||
say |
|||
===version 1=== |
|||
exit |
|||
<syntaxhighlight lang="rexx">/*REXX pgm checks if phrase is palindromic; ignores the case of the letters. */ |
|||
parse arg y /*get (optional) phrase from the C.L. */ |
|||
if y='' then y='In girum imus nocte et consumimur igni' /*[↓] translation.*/ |
|||
/*We walk around in the night and we are burnt by the fire (of love).*/ |
|||
say 'string = ' y |
|||
if isTpal(y) then say 'The string is a true palindrome.' |
|||
else if isPal(y) then say 'The string is an inexact palindrome.' |
|||
else say "The string isn't palindromic." |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*────────────────────────────────────────────────────────────────────────────*/ |
|||
isTpal: return reverse(arg(1))==arg(1) |
|||
isPal: return isTpal(translate(space(x,0)))</syntaxhighlight> |
|||
{{out|output|text=''':'''}} |
|||
<pre> |
|||
string = In girum imus nocte et consumimur igni |
|||
The string is an inexact palindrome. |
|||
</pre> |
|||
=== version 2 === |
|||
{{works with|ARexx}} |
|||
{{works with|Regina}} |
|||
(Works with Regina 3.8 and later, with options: AREXX_BIFS and AREXX_SEMANTICS) |
|||
It should be noted that the '''COMPRESS''' function is not a Classic REXX BIF and isn't present in many REXXes. |
|||
/*------------------------------------------------------------------*/ |
|||
<br>The '''SPACE(string,0)''' BIF can be used instead. |
|||
It should also be noted that '''UPPER''' BIF is not present in some REXXes. |
|||
isPal: procedure; arg x /*this uppercases the value of arg X. */ |
|||
<br>Use the '''PARSE UPPER''' statement or '''TRANSLATE()''' BIF instead. |
|||
/*PARSE ARG X --- wouldn't. */ |
|||
<syntaxhighlight lang="rexx"> |
|||
/* REXX */ |
|||
/*Check whether a string is a palindrome */ |
|||
/*ARG X is equivalent to: */ |
|||
parse pull string |
|||
/*PARSE UPPER ARG X */ |
|||
select |
|||
when palindrome(string) then say string 'is an exact palindrome.' |
|||
when palindrome(compress(upper(string))) then say string 'is an inexact palindrome.' |
|||
otherwise say string 'is not palindromic.' |
|||
end |
|||
exit 0 |
|||
palindrome: procedure |
|||
x=space(x,0) /*removes all blanks (spaces). */ |
|||
parse arg string |
|||
return x==reverse(x) /*returns 1 if exactly equal, */ |
|||
return string==reverse(string) |
|||
/*returns 0 if not. */ |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
ABBA is an exact palindrome. |
|||
In girum imus nocte et consumimur igni is an inexact palindrome. |
|||
djdjdj is not palindromic. |
|||
</pre> |
|||
=={{header|Ring}}== |
|||
/*------------------------------------------------------------------*/ |
|||
<syntaxhighlight lang="ring"> |
|||
aString = "radar" |
|||
bString = "" |
|||
for i=len(aString) to 1 step -1 |
|||
bString = bString + aString[i] |
|||
next |
|||
see aString |
|||
if aString = bString see " is a palindrome." + nl |
|||
else see " is not a palindrome" + nl ok |
|||
</syntaxhighlight> |
|||
=={{header|RPL}}== |
|||
≪ "" |
|||
OVER SIZE 1 '''FOR''' j |
|||
OVER j DUP SUB + -1 '''STEP''' |
|||
== |
|||
≫ ‘<span style="color:blue">XPAL?</span>’ STO |
|||
====Stretch==== |
|||
RPL does not support Unicode. To detect inexact palindromes, we just need a clean-up word: |
|||
≪ "" |
|||
1 3 PICK SIZE '''FOR''' j |
|||
OVER j DUP SUB |
|||
'''IF''' DUP "a" ≥ OVER "z" ≤ AND '''THEN''' NUM 32 - CHR '''END''' |
|||
'''IF''' DUP "A" ≥ OVER "Z" ≤ AND '''THEN''' + '''ELSE''' DROP '''END''' |
|||
'''NEXT''' SWAP DROP |
|||
≫ ‘<span style="color:blue">AZONLY</span>’ STO |
|||
≪ <span style="color:blue">AZONLY</span> "" |
|||
OVER SIZE 1 '''FOR''' j |
|||
OVER j DUP SUB + -1 '''STEP''' |
|||
== |
|||
≫ ‘<span style="color:blue">IPAL?</span>’ STO |
|||
"rotor" <span style="color:blue">XPAL?</span> |
|||
"In girum imus nocte et consumimur igni." <span style="color:blue">IPAL?</span> |
|||
/*also: if x==reverse(x) then return 1 */ |
|||
{{out}} |
|||
/* else return 0 */ |
|||
<pre> |
|||
2: 1 |
|||
1: 1 |
|||
/*Note: the exactly equal to (==) must be used instead of */ |
|||
/* equal to (=) because a string of 0100 */ |
|||
/* would be equal to +100 */ |
|||
/* would be equal to 100. */ |
|||
/* would be equal to 1e2 */ |
|||
/* would be equal to 1e+2 */ |
|||
/* would be equal to +1e2 */ |
|||
/* would be equal to 1e02 */ |
|||
/* would be equal to _100 */ |
|||
/* would be equal to 100_ */ |
|||
/* where _ is a blank. */ |
|||
</lang> |
|||
Output: |
|||
<pre style="height:30ex;overflow:scroll"> |
|||
string=In girum imus nocte et consumimur igni |
|||
The string is palindromic. |
|||
</pre> |
</pre> |
||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
Line 1,562: | Line 5,419: | ||
'''Non-recursive''' |
'''Non-recursive''' |
||
< |
<syntaxhighlight lang="ruby">def palindrome?(s) |
||
s == s.reverse |
s == s.reverse |
||
end</ |
end</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="ruby">def r_palindrome?(s) |
||
if s.length <= 1 |
if s.length <= 1 |
||
true |
true |
||
Line 1,574: | Line 5,431: | ||
false |
false |
||
else |
else |
||
r_palindrome?(s[1..-2]) |
|||
end |
end |
||
end</ |
end</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
Note that the recursive method is ''much'' slower -- using the 2151 character palindrome by Dan Hoey [http://www2.vo.lu/homepages/phahn/anagrams/panama.htm here], we have: |
Note that the recursive method is ''much'' slower -- using the 2151 character palindrome by Dan Hoey [http://www2.vo.lu/homepages/phahn/anagrams/panama.htm here], we have: |
||
< |
<syntaxhighlight lang="ruby">str = "A man, a plan, a caret, [...2110 chars deleted...] a canal--Panama.".downcase.delete('^a-z') |
||
puts |
puts palindrome?(str) # => true |
||
puts |
puts r_palindrome?(str) # => true |
||
require 'benchmark' |
require 'benchmark' |
||
Benchmark.bm do |b| |
Benchmark.bm do |b| |
||
b.report('iterative') {10000.times { |
b.report('iterative') {10000.times {palindrome?(str)}} |
||
b.report('recursive') {10000.times { |
b.report('recursive') {10000.times {r_palindrome?(str)}} |
||
end</ |
end</syntaxhighlight> |
||
{{out}} |
|||
output |
|||
<pre>true |
<pre>true |
||
true |
true |
||
Line 1,596: | Line 5,453: | ||
iterative 0.062000 0.000000 0.062000 ( 0.055000) |
iterative 0.062000 0.000000 0.062000 ( 0.055000) |
||
recursive 16.516000 0.000000 16.516000 ( 16.562000)</pre> |
recursive 16.516000 0.000000 16.516000 ( 16.562000)</pre> |
||
=={{header|Rhovas}}== |
|||
Simplest solution using <code>String.reverse</code>: |
|||
<syntaxhighlight lang="scala"> |
|||
func isPalindromeReverse(string: String): Boolean { |
|||
return string == string.reverse(); |
|||
} |
|||
</syntaxhighlight> |
|||
Alternate character-based solution using pattern matching. Unlike <code>String.reverse</code>, this has limited unicode support due to surrogates (code points split into multiple characters). |
|||
<syntaxhighlight lang="scala"> |
|||
func isPalindromeChars(chars: List<String>): Boolean { |
|||
match (chars) { |
|||
[]: return true; |
|||
[elem]: return true; |
|||
[first, middle*, last]: return first == last && isPalindromeChars(middle); |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
Overall result and test cases: |
|||
<syntaxhighlight lang="scala"> |
|||
func isPalindrome(string: String): Boolean { |
|||
return isPalindromeReverse(string) && isPalindromeChars(string.chars); |
|||
} |
|||
assert isPalindrome(""); |
|||
assert isPalindrome("f"); |
|||
assert isPalindrome("noon"); |
|||
assert isPalindrome("kayak"); |
|||
assert isPalindrome("step on no pets"); |
|||
assert !isPalindrome("palindrome"); |
|||
assert !isPalindrome("A man, a plan, a canal - Panama!"); //inexact |
|||
assert isPalindrome("§★♖★§"); //single utf16 code points |
|||
assert isPalindromeReverse("🗲"); //string reverse handles surrogates |
|||
assert !isPalindromeChars("🗲".chars); //.chars splits surrogates into two chars |
|||
</syntaxhighlight> |
|||
=={{header|Run BASIC}}== |
|||
<syntaxhighlight lang="runbasic">data "My dog has fleas", "Madam, I'm Adam.", "1 on 1", "In girum imus nocte et consumimur igni" |
|||
for i = 1 to 4 |
|||
read w$ |
|||
print w$;" is ";isPalindrome$(w$);" Palindrome" |
|||
next |
|||
function isPalindrome$(str$) |
|||
for i = 1 to len(str$) |
|||
a$ = upper$(mid$(str$,i,1)) |
|||
if (a$ >= "A" and a$ <= "Z") or (a$ >= "0" and a$ <= "9") then b$ = b$ + a$: c$ = a$ + c$ |
|||
next i |
|||
if b$ <> c$ then isPalindrome$ = "not" |
|||
end function</syntaxhighlight> |
|||
{{out}} |
|||
<pre>My dog has fleas is not Palindrome |
|||
Madam, I'm Adam. is Palindrome |
|||
1 on 1 is not Palindrome |
|||
In girum imus nocte et consumimur igni is Palindrome</pre> |
|||
=={{header|Rust}}== |
|||
<syntaxhighlight lang="rust">fn is_palindrome(string: &str) -> bool { |
|||
let half_len = string.len() / 2; |
|||
string |
|||
.chars() |
|||
.take(half_len) |
|||
.eq(string.chars().rev().take(half_len)) |
|||
} |
|||
macro_rules! test { |
|||
( $( $x:tt ),* ) => { $( println!("'{}': {}", $x, is_palindrome($x)); )* }; |
|||
} |
|||
fn main() { |
|||
test!( |
|||
"", |
|||
"a", |
|||
"ada", |
|||
"adad", |
|||
"ingirumimusnocteetconsumimurigni", |
|||
"人人為我,我為人人", |
|||
"Я иду с мечем, судия", |
|||
"아들딸들아", |
|||
"The quick brown fox" |
|||
); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
'': true |
|||
'a': true |
|||
'ada': true |
|||
'adad': false |
|||
'ingirumimusnocteetconsumimurigni': true |
|||
'人人為我,我為人人': true |
|||
'Я иду с мечем, судия': false |
|||
'아들딸들아': true |
|||
'The quick brown fox': false |
|||
</pre> |
|||
The above soluion checks if the codepoints form a pallindrome, but it is perhaps more correct to consider if the graphemes form a pallindrome. This can be accomplished with an external library and a slight modification to <code>is_palindrome</code>. |
|||
<syntaxhighlight lang="rust">extern crate unicode_segmentation; |
|||
use unicode_segmentation::UnicodeSegmentation; |
|||
fn is_palindrome(string: &str) -> bool { |
|||
string.graphemes(true).eq(string.graphemes(true).rev()) |
|||
}</syntaxhighlight> |
|||
=={{header|SAS}}== |
|||
Description |
|||
<syntaxhighlight lang="sas"> |
|||
The macro "palindro" has two parameters: string and ignorewhitespace. |
|||
string is the expression to be checked. |
|||
ignorewhitespace, (Y/N), determines whether or not to ignore blanks and punctuation. |
|||
This macro was written in SAS 9.2. If you use a version before SAS 9.1.3, |
|||
the compress function options will not work. |
|||
</syntaxhighlight> |
|||
Code |
|||
<syntaxhighlight lang="sas"> |
|||
%MACRO palindro(string, ignorewhitespace); |
|||
DATA _NULL_; |
|||
%IF %UPCASE(&ignorewhitespace)=Y %THEN %DO; |
|||
/* The arguments of COMPRESS (sp) ignore blanks and puncutation */ |
|||
/* We take the string and record it in reverse order using the REVERSE function. */ |
|||
%LET rev=%SYSFUNC(REVERSE(%SYSFUNC(COMPRESS(&string,,sp)))); |
|||
%LET string=%SYSFUNC(COMPRESS(&string.,,sp)); |
|||
%END; |
|||
%ELSE %DO; |
|||
%LET rev=%SYSFUNC(REVERSE(&string)); |
|||
%END; |
|||
/*%PUT rev=&rev.;*/ |
|||
/*%PUT string=&string.;*/ |
|||
/* Here we determine if the string and its reverse are the same. */ |
|||
%IF %UPCASE(&string)=%UPCASE(&rev.) %THEN %DO; |
|||
%PUT TRUE; |
|||
%END; |
|||
%ELSE %DO; |
|||
%PUT FALSE; |
|||
%END; |
|||
RUN; |
|||
%MEND; |
|||
</syntaxhighlight> |
|||
Example macro call and output |
|||
<syntaxhighlight lang="sas"> |
|||
%palindro("a man, a plan, a canal: panama",y); |
|||
TRUE |
|||
NOTE: DATA statement used (Total process time): |
|||
real time 0.00 seconds |
|||
cpu time 0.00 seconds |
|||
%palindro("a man, a plan, a canal: panama",n); |
|||
FALSE |
|||
NOTE: DATA statement used (Total process time): |
|||
real time 0.00 seconds |
|||
cpu time 0.00 seconds |
|||
</syntaxhighlight> |
|||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
{{libheader|Scala}} |
|||
'''Non-recursive''' |
|||
=== Non-recursive, robustified=== |
|||
<syntaxhighlight lang="scala"> def isPalindrome(s: String): Boolean = (s.size >= 2) && s == s.reverse</syntaxhighlight> |
|||
===Bonus: Detect and account for odd space and punctuation=== |
|||
<syntaxhighlight lang="scala"> def isPalindromeSentence(s: String): Boolean = |
|||
(s.size >= 2) && { |
|||
val p = s.replaceAll("[^\\p{L}]", "").toLowerCase |
|||
p == p.reverse |
|||
} |
|||
</syntaxhighlight> |
|||
===Recursive=== |
|||
The coercion to string is necessary because otherwise Scala uses on RichString instead, and comparing a String to |
|||
<syntaxhighlight lang="scala">import scala.annotation.tailrec |
|||
a RichString would fail. |
|||
def isPalindromeRec(s: String) = { |
|||
@tailrec |
|||
def inner(s: String): Boolean = |
|||
(s.length <= 1) || (s.head == s.last) && inner(s.tail.init) |
|||
(s.size >= 2) && inner(s) |
|||
'''Test''' |
|||
}</syntaxhighlight> |
|||
<lang scala>scala> isPalindrome("amanaplanacanalpanama") |
|||
'''Testing''' |
|||
res0: Boolean = true |
|||
<syntaxhighlight lang="scala"> // Testing |
|||
assert(!isPalindrome("")) |
|||
assert(!isPalindrome("z")) |
|||
assert(isPalindrome("amanaplanacanalpanama")) |
|||
assert(!isPalindrome("Test 1,2,3")) |
|||
assert(isPalindrome("1 2 1")) |
|||
assert(!isPalindrome("A man a plan a canal Panama.")) |
|||
assert(!isPalindromeSentence("")) |
|||
scala> isPalindrome("Test 1,2,3") |
|||
assert(!isPalindromeSentence("z")) |
|||
res1: Boolean = false |
|||
assert(isPalindromeSentence("amanaplanacanalpanama")) |
|||
assert(!isPalindromeSentence("Test 1,2,3")) |
|||
assert(isPalindromeSentence("1 2 1")) |
|||
assert(isPalindromeSentence("A man a plan a canal Panama.")) |
|||
assert(!isPalindromeRec("")) |
|||
scala> isPalindrome("1 2 1") |
|||
assert(!isPalindromeRec("z")) |
|||
res2: Boolean = true</lang> |
|||
assert(isPalindromeRec("amanaplanacanalpanama")) |
|||
assert(!isPalindromeRec("Test 1,2,3")) |
|||
assert(isPalindromeRec("1 2 1")) |
|||
assert(!isPalindromeRec("A man a plan a canal Panama.")) |
|||
println("Successfully completed without errors.")</syntaxhighlight> |
|||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
'''Non-recursive''' |
'''Non-recursive''' |
||
< |
<syntaxhighlight lang="scheme">(define (palindrome? s) |
||
(let ((chars (string->list s))) |
(let ((chars (string->list s))) |
||
(equal? chars (reverse chars))))</ |
(equal? chars (reverse chars))))</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="scheme">(define (palindrome? s) |
||
(let loop ((i 0 |
(let loop ((i 0) |
||
(j (- (string-length s) 1))) |
|||
(or (>= i j) |
(or (>= i j) |
||
( |
(and (char=? (string-ref s i) (string-ref s j)) |
||
(loop (+ i 1) (- j 1)))))) |
|||
(else #f))))))</lang> |
|||
;; Or: |
|||
(define (palindrome? s) |
|||
(let loop ((s (string->list s)) |
|||
(r (reverse (string->list s)))) |
|||
(or (null? s) |
|||
(and (char=? (car s) (car r)) |
|||
(loop (cdr s) (cdr r)))))) |
|||
> (palindrome? "ingirumimusnocteetconsumimurigni") |
|||
#t |
#t |
||
> (palindrome? "This is not a palindrome") |
> (palindrome? "This is not a palindrome") |
||
#f |
#f |
||
></ |
></syntaxhighlight> |
||
=={{header|sed}}== |
|||
<syntaxhighlight lang="sed">h |
|||
:l |
|||
s/^\(.\)\(.*\)\1$/\2/ |
|||
tl |
|||
/../d |
|||
x</syntaxhighlight><pre> |
|||
$ printf '%s\n' a zz az bag gag none madamimadam otto | sed -f palindrome.sed |
|||
a |
|||
zz |
|||
gag |
|||
madamimadam |
|||
otto |
|||
</pre> |
|||
=={{header|Seed7}}== |
|||
<syntaxhighlight lang="seed7">const func boolean: palindrome (in string: stri) is func |
|||
result |
|||
var boolean: isPalindrome is TRUE; |
|||
local |
|||
var integer: index is 0; |
|||
var integer: length is 0; |
|||
begin |
|||
length := length(stri); |
|||
for index range 1 to length div 2 do |
|||
if stri[index] <> stri[length - index + 1] then |
|||
isPalindrome := FALSE; |
|||
end if; |
|||
end for; |
|||
end func;</syntaxhighlight> |
|||
For palindromes where spaces shuld be ignore use: |
|||
<syntaxhighlight lang="seed7">palindrome(replace("in girum imus nocte et consumimur igni", " ", ""))</syntaxhighlight> |
|||
=={{header|SequenceL}}== |
|||
'''Using the Reverse Library Function''' |
|||
<syntaxhighlight lang="sequencel">import <Utilities/Sequence.sl>; |
|||
isPalindrome(string(1)) := equalList(string, reverse(string));</syntaxhighlight> |
|||
'''Version Using an Indexed Function''' |
|||
<syntaxhighlight lang="sequencel">isPalindrome(string(1)) := |
|||
let |
|||
compares[i] := string[i] = string[size(string) - (i - 1)] foreach i within 1 ... (size(string) / 2); |
|||
in |
|||
all(compares);</syntaxhighlight> |
|||
=={{header|Sidef}}== |
|||
'''Built-in''' |
|||
<syntaxhighlight lang="ruby">say "noon".is_palindrome # true</syntaxhighlight> |
|||
'''Non-recursive''' |
|||
<syntaxhighlight lang="ruby">func palindrome(s) { |
|||
s == s.reverse |
|||
}</syntaxhighlight> |
|||
'''Recursive''' |
|||
<syntaxhighlight lang="ruby">func palindrome(s) { |
|||
if (s.len <= 1) { |
|||
true |
|||
} |
|||
elsif (s.first != s.last) { |
|||
false |
|||
} |
|||
else { |
|||
__FUNC__(s.first(-1).last(-1)) |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|Simula}}== |
|||
<syntaxhighlight lang="simula">BEGIN |
|||
BOOLEAN PROCEDURE ISPALINDROME(T); TEXT T; |
|||
BEGIN |
|||
BOOLEAN RESULT; |
|||
INTEGER I, J; |
|||
I := 1; |
|||
J := T.LENGTH; |
|||
RESULT := TRUE; |
|||
WHILE RESULT AND I < J DO |
|||
BEGIN |
|||
CHARACTER L, R; |
|||
T.SETPOS(I); L := T.GETCHAR; I := I + 1; |
|||
T.SETPOS(J); R := T.GETCHAR; J := J - 1; |
|||
RESULT := L = R; |
|||
END; |
|||
ISPALINDROME := RESULT; |
|||
END ISPALINDROME; |
|||
TEXT T; |
|||
FOR T :- "", "A", "AA", "ABA", "SALALAS", "MADAMIMADAM", |
|||
"AB", "AAB", "ABCBDA" |
|||
DO |
|||
BEGIN |
|||
OUTTEXT(IF ISPALINDROME(T) THEN "IS " ELSE "ISN'T"); |
|||
OUTTEXT(" PALINDROME: "); |
|||
OUTCHAR('"'); |
|||
OUTTEXT(T); |
|||
OUTCHAR('"'); |
|||
OUTIMAGE; |
|||
END; |
|||
END.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
IS PALINDROME: "" |
|||
IS PALINDROME: "A" |
|||
IS PALINDROME: "AA" |
|||
IS PALINDROME: "ABA" |
|||
IS PALINDROME: "SALALAS" |
|||
IS PALINDROME: "MADAMIMADAM" |
|||
ISN'T PALINDROME: "AB" |
|||
ISN'T PALINDROME: "AAB" |
|||
ISN'T PALINDROME: "ABCBDA" |
|||
</pre> |
|||
=={{header|Slate}}== |
=={{header|Slate}}== |
||
'''Non-Recursive''' |
'''Non-Recursive''' |
||
< |
<syntaxhighlight lang="slate">s@(String traits) isPalindrome |
||
[ |
[ |
||
(s lexicographicallyCompare: s reversed) isZero |
(s lexicographicallyCompare: s reversed) isZero |
||
].</ |
].</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
Defined on Sequence since we are not using String-specific methods: |
Defined on Sequence since we are not using String-specific methods: |
||
< |
<syntaxhighlight lang="slate">s@(Sequence traits) isPalindrome |
||
[ |
[ |
||
s isEmpty |
s isEmpty |
||
ifTrue: [True] |
ifTrue: [True] |
||
ifFalse: [(s first = s last) /\ [(s sliceFrom: 1 to: s indexLast - 1) isPalindrome]] |
ifFalse: [(s first = s last) /\ [(s sliceFrom: 1 to: s indexLast - 1) isPalindrome]] |
||
].</ |
].</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="slate">define: #p -> 'ingirumimusnocteetconsumimurigni'. |
||
inform: 'sequence ' ; p ; ' is ' ; (p isPalindrome ifTrue: [''] ifFalse: ['not ']) ; 'a palindrome.'.</ |
inform: 'sequence ' ; p ; ' is ' ; (p isPalindrome ifTrue: [''] ifFalse: ['not ']) ; 'a palindrome.'.</syntaxhighlight> |
||
=={{header|Smalltalk}}== |
=={{header|Smalltalk}}== |
||
{{works with|Squeak}} |
{{works with|Squeak}} |
||
< |
<syntaxhighlight lang="smalltalk">isPalindrome := [:aString | |
||
str := (aString select: [:chr| chr isAlphaNumeric]) collect: [:chr | chr asLowercase]. |
str := (aString select: [:chr| chr isAlphaNumeric]) collect: [:chr | chr asLowercase]. |
||
str = str reversed. |
str = str reversed. |
||
]. |
]. |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{works with|GNU Smalltalk}} |
{{works with|GNU Smalltalk}} |
||
< |
<syntaxhighlight lang="smalltalk">String extend [ |
||
palindro [ "Non-recursive" |
palindro [ "Non-recursive" |
||
^ self = (self reverse) |
^ self = (self reverse) |
||
Line 1,680: | Line 5,855: | ||
] |
] |
||
] |
] |
||
].</ |
].</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="smalltalk">('hello' palindro) printNl. |
||
('hello' palindroR) printNl. |
('hello' palindroR) printNl. |
||
('ingirumimusnocteetconsumimurigni' palindro) printNl. |
('ingirumimusnocteetconsumimurigni' palindro) printNl. |
||
('ingirumimusnocteetconsumimurigni' palindroR) printNl.</ |
('ingirumimusnocteetconsumimurigni' palindroR) printNl.</syntaxhighlight> |
||
{{works with|VisualWorks Pharo Squeak}} |
|||
<syntaxhighlight lang="smalltalk">SequenceableCollection>>isPalindrome |
|||
^self reverse = self |
|||
</syntaxhighlight> |
|||
=={{header|SNOBOL4}}== |
=={{header|SNOBOL4}}== |
||
< |
<syntaxhighlight lang="snobol4"> define('pal(str)') :(pal_end) |
||
pal str notany(&ucase &lcase) = :s(pal) |
pal str notany(&ucase &lcase) = :s(pal) |
||
str = replace(str,&ucase,&lcase) |
str = replace(str,&ucase,&lcase) |
||
Line 1,707: | Line 5,887: | ||
palchk('In girum imus nocte et consumimur igni') |
palchk('In girum imus nocte et consumimur igni') |
||
palchk('The quick brown fox jumped over the lazy dogs') |
palchk('The quick brown fox jumped over the lazy dogs') |
||
end</ |
end</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>Able was I ere I saw Elba |
<pre>Able was I ere I saw Elba |
||
Palindrome: True |
Palindrome: True |
||
Line 1,716: | Line 5,896: | ||
The quick brown fox jumped over the lazy dogs |
The quick brown fox jumped over the lazy dogs |
||
Palindrome: False</pre> |
Palindrome: False</pre> |
||
=={{header|SparForte}}== |
|||
As a structured script. |
|||
<syntaxhighlight lang="ada">#!/usr/local/bin/spar |
|||
pragma annotate( summary, "palindrome" ); |
|||
pragma annotate( description, "Write at least one function/method (or whatever it is" ); |
|||
pragma annotate( description, "called in your preferred language) to check if a" ); |
|||
pragma annotate( description, "sequence of characters (or bytes) is a palindrome or" ); |
|||
pragma annotate( description, "not. The function must return a boolean value (or" ); |
|||
pragma annotate( description, "something that can be used as boolean value, like an" ); |
|||
pragma annotate( description, "integer)." ); |
|||
pragma annotate( see_also, "http://rosettacode.org/wiki/Palindrome_detection" ); |
|||
pragma annotate( author, "Ken O. Burtch" ); |
|||
pragma license( unrestricted ); |
|||
pragma restriction( no_external_commands ); |
|||
procedure palindrome is |
|||
function is_palindrome( text : string ) return boolean is |
|||
begin |
|||
for offset in 0..strings.length( text ) / 2 -1 loop |
|||
if strings.element( text, offset+1) /= strings.element( text, positive( strings.length( text ) - offset ) ) then |
|||
return false; |
|||
end if; |
|||
end loop; |
|||
return true; |
|||
end is_palindrome; |
|||
sentence : string; |
|||
result : boolean; |
|||
begin |
|||
sentence := "this is a test"; |
|||
result := is_palindrome( sentence ); |
|||
put( sentence ) @ ( " : " ) @ ( result ); |
|||
new_line; |
|||
sentence := "ablewasiereisawelba"; |
|||
result := is_palindrome( sentence ); |
|||
put( sentence ) @ ( " : " ) @ ( result ); |
|||
new_line; |
|||
end palindrome;</syntaxhighlight> |
|||
=={{header|SQL}}== |
|||
<syntaxhighlight lang="sql">SET @txt = REPLACE('In girum imus nocte et consumimur igni', ' ', ''); |
|||
SELECT REVERSE(@txt) = @txt;</syntaxhighlight> |
|||
=={{header|Swift}}== |
|||
{{works with|Swift|1.2}} |
|||
<syntaxhighlight lang="swift">import Foundation |
|||
// Allow for easy character checking |
|||
extension String { |
|||
subscript (i: Int) -> String { |
|||
return String(Array(self)[i]) |
|||
} |
|||
} |
|||
func isPalindrome(str:String) -> Bool { |
|||
if (count(str) == 0 || count(str) == 1) { |
|||
return true |
|||
} |
|||
let removeRange = Range<String.Index>(start: advance(str.startIndex, 1), end: advance(str.endIndex, -1)) |
|||
if (str[0] == str[count(str) - 1]) { |
|||
return isPalindrome(str.substringWithRange(removeRange)) |
|||
} |
|||
return false |
|||
}</syntaxhighlight> |
|||
{{works with|Swift|2.0}} |
|||
<syntaxhighlight lang="swift">func isPal(str: String) -> Bool { |
|||
let c = str.characters |
|||
return lazy(c).reverse() |
|||
.startsWith(c[c.startIndex...advance(c.startIndex, c.count / 2)]) |
|||
}</syntaxhighlight> |
|||
=={{header|Tailspin}}== |
|||
<syntaxhighlight lang="tailspin"> |
|||
templates palindrome |
|||
[$...] -> # |
|||
when <=$(last..first:-1)> do '$...;' ! |
|||
end palindrome |
|||
[['rotor', 'racecar', 'level', 'rosetta']... -> palindrome ] -> !OUT::write |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[rotor, racecar, level] |
|||
</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
Line 1,721: | Line 5,991: | ||
'''Non-recursive''' |
'''Non-recursive''' |
||
< |
<syntaxhighlight lang="tcl">package require Tcl 8.5 |
||
proc palindrome {s} { |
proc palindrome {s} { |
||
return [expr {$s eq [string reverse $s]}] |
return [expr {$s eq [string reverse $s]}] |
||
}</ |
}</syntaxhighlight> |
||
'''Recursive''' |
'''Recursive''' |
||
< |
<syntaxhighlight lang="tcl">proc palindrome_r {s} { |
||
if {[string length $s] <= 1} { |
if {[string length $s] <= 1} { |
||
return true |
return true |
||
Line 1,736: | Line 6,006: | ||
return [palindrome_r [string range $s 1 end-1]] |
return [palindrome_r [string range $s 1 end-1]] |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
'''Testing''' |
'''Testing''' |
||
< |
<syntaxhighlight lang="tcl">set p ingirumimusnocteetconsumimurigni |
||
puts "'$p' is palindrome? [palindrome $p]" |
puts "'$p' is palindrome? [palindrome $p]" |
||
puts "'$p' is palindrome? [palindrome_r $p]"</ |
puts "'$p' is palindrome? [palindrome_r $p]"</syntaxhighlight> |
||
=={{header|TUSCRIPT}}== |
|||
<syntaxhighlight lang="tuscript"> |
|||
$$ MODE TUSCRIPT |
|||
pal ="ingirumimusnocteetconsumimurigni" |
|||
pal_r=TURN(pal) |
|||
SELECT pal |
|||
CASE $pal_r |
|||
PRINT "true" |
|||
DEFAULT |
|||
PRINT/ERROR "untrue" |
|||
ENDSELECT |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
true |
|||
</pre> |
|||
=={{header|TypeScript}}== |
|||
<syntaxhighlight lang="javascript">const detectNonLetterRegexp=/[^A-ZÀ-ÞЀ-Я]/g; |
|||
function stripDiacritics(phrase:string){ |
|||
return phrase.normalize('NFD').replace(/[\u0300-\u036f]/g, "") |
|||
} |
|||
function isPalindrome(phrase:string){ |
|||
const TheLetters = stripDiacritics(phrase.toLocaleUpperCase().replace(detectNonLetterRegexp, '')); |
|||
const middlePosition = TheLetters.length/2; |
|||
const leftHalf = TheLetters.substr(0, middlePosition); |
|||
const rightReverseHalf = TheLetters.substr(-middlePosition).split('').reverse().join(''); |
|||
return leftHalf == rightReverseHalf; |
|||
} |
|||
console.log(isPalindrome('Sueño que esto no es un palíndromo')) |
|||
console.log(isPalindrome('Dábale arroz a la zorra el abad!')) |
|||
console.log(isPalindrome('Я иду с мечем судия')) |
|||
</syntaxhighlight> |
|||
=={{header|Uiua}}== |
|||
Does not ignore spaces. |
|||
<syntaxhighlight lang="uiua">≍⇌."tacocat"</syntaxhighlight> |
|||
===Extra Credit=== |
|||
Ignores whitespace, converts A-Z to lowercase, only checks a-z, includes tests. |
|||
<syntaxhighlight lang="uiua">IsPal ← ≍⇌.+×32<@a.▽:⟜∊:/⊂+⊙¤"Aa"⇡26 |
|||
IsPal "A man, a plan, a canal: Panama!" |
|||
</syntaxhighlight> |
|||
=={{header|UNIX Shell}}== |
|||
<syntaxhighlight lang="bash">if [[ "${text}" == "$(rev <<< "${text}")" ]]; then |
|||
echo "Palindrome" |
|||
else |
|||
echo "Not a palindrome" |
|||
fi</syntaxhighlight> |
|||
=={{header|Ursala}}== |
=={{header|Ursala}}== |
||
The algorithm is to convert to lower case, and then compare |
The algorithm is to convert to lower case, and then compare |
||
the intersection of the argument and the set of letters |
|||
of letters (declared in the standard library) with its reversal. This is done using the built in operator |
|||
(declared in the standard library) with its reversal. |
|||
suffixes for intersection (c), identity (i), reversal (x) and equality (E). |
|||
This is done using the built in operator suffixes |
|||
<lang Ursala>#import std |
|||
for intersection (c), identity (i), reversal (x) and equality (E). |
|||
<syntaxhighlight lang="ursala">#import std |
|||
palindrome = ~&cixE\letters+ * -:~& ~=`A-~rlp letters</ |
palindrome = ~&cixE\letters+ * -:~& ~=`A-~rlp letters</syntaxhighlight> |
||
This test programs applies the function to each member of a list of three strings, |
This test programs applies the function to each member of a list of three strings, |
||
of which only the first two are palindromes. |
|||
<lang Ursala>#cast %bL |
|||
<syntaxhighlight lang="ursala">#cast %bL |
|||
examples = palindrome* <'abccba','foo ba rra bo of','notone'></ |
examples = palindrome* <'abccba','foo ba rra bo of','notone'></syntaxhighlight> |
||
{{out}} |
|||
output: |
|||
<pre><true,true,false></pre> |
<pre><true,true,false></pre> |
||
=={{header|Vala}}== |
|||
Checks if a word is a palindrome ignoring the case and spaces. |
|||
<syntaxhighlight lang="vala">bool is_palindrome (string str) { |
|||
var tmp = str.casefold ().replace (" ", ""); |
|||
return tmp == tmp.reverse (); |
|||
} |
|||
int main (string[] args) { |
|||
print (is_palindrome (args[1]).to_string () + "\n"); |
|||
return 0; |
|||
}</syntaxhighlight> |
|||
=={{header|VBA}}== |
|||
This function uses function Reverse() (or Rreverse()) from [[Reverse a string]], |
|||
after first stripping spaces from the string using the built-in function Replace |
|||
and converting it to lower case. It can't handle punctuation (yet). Just like the VBScript |
|||
version it could also work using StrReverse. |
|||
<syntaxhighlight lang="vba"> |
|||
Public Function isPalindrome(aString as string) as Boolean |
|||
dim tempstring as string |
|||
tempstring = Lcase(Replace(aString, " ", "")) |
|||
isPalindrome = (tempstring = Reverse(tempstring)) |
|||
End Function |
|||
</syntaxhighlight> |
|||
{{out|Example}} |
|||
<pre> |
|||
print isPalindrome("In girum imus nocte et consumimur igni") |
|||
True |
|||
</pre> |
|||
=={{header|VBScript}}== |
=={{header|VBScript}}== |
||
====Implementation==== |
====Implementation==== |
||
< |
<syntaxhighlight lang="vb">function Squish( s1 ) |
||
dim sRes |
dim sRes |
||
sRes = vbNullString |
sRes = vbNullString |
||
Line 1,778: | Line 6,136: | ||
squished = Squish( s1 ) |
squished = Squish( s1 ) |
||
isPalindrome = ( squished = StrReverse( squished ) ) |
isPalindrome = ( squished = StrReverse( squished ) ) |
||
end function</ |
end function</syntaxhighlight> |
||
====Invocation==== |
====Invocation==== |
||
< |
<syntaxhighlight lang="vb">wscript.echo isPalindrome( "My dog has fleas") |
||
wscript.echo isPalindrome( "Madam, I'm Adam.") |
wscript.echo isPalindrome( "Madam, I'm Adam.") |
||
wscript.echo isPalindrome( "1 on 1") |
wscript.echo isPalindrome( "1 on 1") |
||
wscript.echo isPalindrome( "In girum imus nocte et consumimur igni")</ |
wscript.echo isPalindrome( "In girum imus nocte et consumimur igni")</syntaxhighlight> |
||
{{out}} |
|||
====Output==== |
|||
< |
<pre>0 |
||
-1 |
-1 |
||
0 |
0 |
||
-1</ |
-1</pre> |
||
=={{header|Vedit macro language}}== |
=={{header|Vedit macro language}}== |
||
This routine checks if current line is a palindrome: |
This routine checks if current line is a palindrome: |
||
< |
<syntaxhighlight lang="vedit">:PALINDROME: |
||
EOL #2 = Cur_Col-2 |
EOL #2 = Cur_Col-2 |
||
BOL |
BOL |
||
Line 1,800: | Line 6,158: | ||
if (CC(#1) != CC(#2-#1)) { Return(0) } |
if (CC(#1) != CC(#2-#1)) { Return(0) } |
||
} |
} |
||
Return(1)</ |
Return(1)</syntaxhighlight> |
||
Testing: |
Testing: |
||
< |
<syntaxhighlight lang="vedit">Call("PALINDROME") |
||
if (Return_Value) { |
if (Return_Value) { |
||
Statline_Message("Yes") |
Statline_Message("Yes") |
||
Line 1,810: | Line 6,168: | ||
Statline_Message("No") |
Statline_Message("No") |
||
} |
} |
||
Return</ |
Return</syntaxhighlight> |
||
=={{header|Visual Basic .NET}}== |
|||
{{trans|VBA}} |
|||
<syntaxhighlight lang="vbnet">Module Module1 |
|||
Function IsPalindrome(p As String) As Boolean |
|||
Dim temp = p.ToLower().Replace(" ", "") |
|||
Return StrReverse(temp) = temp |
|||
End Function |
|||
Sub Main() |
|||
Console.WriteLine(IsPalindrome("In girum imus nocte et consumimur igni")) |
|||
End Sub |
|||
End Module</syntaxhighlight> |
|||
{{out}} |
|||
<pre>True</pre> |
|||
=={{header|V (Vlang)}}== |
|||
<syntaxhighlight lang="javascript"> |
|||
fn is_pal_1(ss string) bool { |
|||
s := ss.runes() |
|||
for i in 0..s.len/2 { |
|||
if s[i] != s[s.len-1-i]{ |
|||
return false |
|||
} |
|||
} |
|||
return true |
|||
} |
|||
fn is_pal_2(word string) bool { |
|||
if word == word.runes().reverse().string() {return true} |
|||
return false |
|||
} |
|||
fn main() { |
|||
words := ["rotor", "rosetta", "step on no pets", "été", "wren", "🦊😀🦊"] |
|||
println('Check from is_pal_1:') |
|||
for word in words { |
|||
println('$word => ${is_pal_1(word)}') |
|||
} |
|||
println('\nCheck from is_pal_2:') |
|||
for word in words { |
|||
println('$word => ${is_pal_2(word)}') |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Are the following palindromes? |
|||
rotor => true |
|||
rosetta => false |
|||
step on no pets => true |
|||
été => true |
|||
wren => false |
|||
🦊😀🦊 => true |
|||
</pre> |
|||
=={{header|Wortel}}== |
|||
<syntaxhighlight lang="wortel">@let { |
|||
; Using a hook |
|||
pal1 @(= @rev) |
|||
; Function with argument |
|||
pal2 &s = s @rev s |
|||
; for inexact palindromes |
|||
pal3 ^(@(= @rev) .toLowerCase. &\@replace[&"\s+"g ""]) |
|||
[[ |
|||
!pal1 "abcba" |
|||
!pal2 "abcbac" |
|||
!pal3 "In girum imus nocte et consumimur igni" |
|||
]] |
|||
}</syntaxhighlight> |
|||
Returns: <pre>[true false true]</pre> |
|||
=={{header|Wren}}== |
|||
<syntaxhighlight lang="wren">var isPal = Fn.new { |word| word == ((word.count > 0) ? word[-1..0] : "") } |
|||
System.print("Are the following palindromes?") |
|||
for (word in ["rotor", "rosetta", "step on no pets", "été", "wren", "🦊😀🦊"]) { |
|||
System.print(" %(word) => %(isPal.call(word))") |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Are the following palindromes? |
|||
rotor => true |
|||
rosetta => false |
|||
step on no pets => true |
|||
été => true |
|||
wren => false |
|||
🦊😀🦊 => true |
|||
</pre> |
|||
=={{header|X86 Assembly}}== |
|||
<syntaxhighlight lang="x86asm"> |
|||
; x86_84 Linux nasm |
|||
section .text |
|||
isPalindrome: |
|||
mov rsi, rax |
|||
mov rdi, rax |
|||
get_end: |
|||
cmp byte [rsi], 0 |
|||
je get_result |
|||
inc rsi |
|||
jmp get_end |
|||
get_result: |
|||
mov rax, 0 |
|||
dec rsi |
|||
compare: |
|||
mov cl, byte [rdi] |
|||
cmp byte [rsi], cl |
|||
jne not_palindrome |
|||
cmp rsi, rdi |
|||
je palindrome |
|||
inc rdi |
|||
cmp rdi, rsi |
|||
je palindrome |
|||
dec rsi |
|||
jmp compare |
|||
not_palindrome: |
|||
mov rax, 0 |
|||
ret |
|||
palindrome: |
|||
mov rax, 1 |
|||
ret |
|||
</syntaxhighlight> |
|||
=={{header|XPL0}}== |
|||
<syntaxhighlight lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations |
|||
string 0; \use zero-terminated strings |
|||
func StrLen(Str); \Return number of characters in an ASCIIZ string |
|||
char Str; |
|||
int I; |
|||
for I:= 0 to -1>>1-1 do |
|||
if Str(I) = 0 then return I; |
|||
func Palindrome(S); \Return 'true' if S is a palindrome |
|||
char S; |
|||
int L, I; |
|||
[L:= StrLen(S); |
|||
for I:= 0 to L/2-1 do |
|||
if S(I) # S(L-1-I) then return false; |
|||
return true; |
|||
]; \Palindrome |
|||
int Word, I; |
|||
[Word:= |
|||
["otto", "mary", "ablewasiereisawelba", "ingirumimusnocteetconsumimurigni"]; |
|||
for I:= 0 to 4-1 do |
|||
[Text(0, if Palindrome(Word(I)) then "yes" else "no"); |
|||
CrLf(0); |
|||
]; |
|||
]</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
yes |
|||
no |
|||
yes |
|||
yes |
|||
</pre> |
|||
=={{header|YAMLScript}}== |
|||
<syntaxhighlight lang="yaml"> |
|||
!yamlscript/v0 |
|||
defn main(n): |
|||
say: "$n is $when( |
|||
(str(n) != str(n).reverse()) |
|||
'not ' |
|||
)a palindrome." |
|||
</syntaxhighlight> |
|||
=={{header|Yorick}}== |
=={{header|Yorick}}== |
||
Function ''is_palindrome'' meets the task description. |
Function ''is_palindrome'' meets the task description. |
||
Function ''prep_palindrome'' demonstrates how to convert |
|||
an English sentence into a form that can be tested with |
|||
is_palindrome (by changing case and stripping non-alphabetical characters). |
|||
< |
<syntaxhighlight lang="yorick">func is_palindrome(str) { |
||
s = strchar(str)(:-1); |
s = strchar(str)(:-1); |
||
return allof(s == s(::-1)); |
return allof(s == s(::-1)); |
||
Line 1,824: | Line 6,364: | ||
w = where(s >= 'a' & s <= 'z'); |
w = where(s >= 'a' & s <= 'z'); |
||
return strchar(s(w)); |
return strchar(s(w)); |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Z80 Assembly}}== |
|||
{{works with|CP/M 3.1|YAZE-AG-2.51.2 Z80 emulator}} |
|||
{{works with|ZSM4 macro assembler|YAZE-AG-2.51.2 Z80 emulator}} |
|||
Use the /S8 switch on the ZSM4 assembler for 8 significant characters for labels and names<br><br> |
|||
''Inexact'' palindrome detection is integrated - blanks are eliminated and all characters converted to uppercase<br> |
|||
Converted string is printed<br> |
|||
<syntaxhighlight lang="z80"> |
|||
; |
|||
; Check if input string is a palindrome using Z80 assembly language |
|||
; |
|||
; Runs under CP/M 3.1 on YAZE-AG-2.51.2 Z80 emulator |
|||
; Assembled with zsm4 on same emulator/OS, uses macro capabilities of said assembler |
|||
; Created with vim under Windows |
|||
; |
|||
; 2023-04-17 Xorph |
|||
; |
|||
; |
|||
; Useful definitions |
|||
; |
|||
bdos equ 05h ; Call to CP/M BDOS function |
|||
strdel equ 6eh ; Set string delimiter |
|||
readstr equ 0ah ; Read string from console |
|||
wrtstr equ 09h ; Write string to console |
|||
nul equ 00h ; ASCII control characters |
|||
esc equ 1bh |
|||
cr equ 0dh |
|||
lf equ 0ah |
|||
buflen equ 30h ; Length of input buffer |
|||
; |
|||
; Macros for BDOS calls |
|||
; |
|||
setdel macro char ; Set string delimiter to char |
|||
ld c,strdel |
|||
ld e,char |
|||
call bdos |
|||
endm |
|||
print macro msg ; Output string to console |
|||
ld c,wrtstr |
|||
ld de,msg |
|||
call bdos |
|||
endm |
|||
newline macro ; Print newline |
|||
ld c,wrtstr |
|||
ld de,crlf |
|||
call bdos |
|||
endm |
|||
readln macro buf ; Read a line from input |
|||
ld c,readstr |
|||
ld de,buf |
|||
call bdos |
|||
endm |
|||
; |
|||
; Other macros |
|||
; |
|||
toupper macro |
|||
local notlow |
|||
cp 'a' |
|||
jr c,notlow |
|||
cp 'z'+1 |
|||
jr nc,notlow |
|||
add a,'A'-'a' |
|||
notlow: |
|||
endm |
|||
; |
|||
; ===================== |
|||
; Start of main program |
|||
; ===================== |
|||
; |
|||
cseg |
|||
setdel nul ; Set string delimiter to 00h |
|||
ld b,buflen ; Clear input buffer |
|||
ld hl,bufcont |
|||
clrloop: |
|||
ld (hl),0 |
|||
inc hl |
|||
djnz clrloop |
|||
readln inputbuf ; Read a line from input |
|||
newline ; Newline is discarded during input, so write one... |
|||
ld b,buflen ; Convert all to uppercase |
|||
ld hl,bufcont |
|||
uprloop: |
|||
ld a,(hl) |
|||
toupper |
|||
ld (hl),a |
|||
inc hl |
|||
djnz uprloop |
|||
ld a,(inputbuf+1) ; Eliminate all spaces |
|||
ld b,a |
|||
ld c,0 ; Counter for non-spaces |
|||
ld ix,bufcont ; String (buffer) address in ix |
|||
ld iy,compress ; Compressed string (without blanks) goes to iy |
|||
spcloop: |
|||
ld a,(ix) |
|||
cp ' ' |
|||
jr z,isblank |
|||
inc c ; If not blank, move to (iy) and increment counter |
|||
ld (iy),a |
|||
inc iy |
|||
isblank: |
|||
inc ix |
|||
djnz spcloop |
|||
ld a,c ; Move back to original buffer |
|||
ld (inputbuf+1),a ; New length of text without spaces for further processing |
|||
ld b,0 ; bc now set correctly to new length |
|||
ld de,bufcont ; Set up and use block move |
|||
ld hl,compress |
|||
ldir |
|||
ex de,hl ; Add nul terminator - target is in de, but memory load only via hl |
|||
ld (hl),nul |
|||
print bufcont ; Print actual text before start of check |
|||
newline |
|||
ld a,(inputbuf+1) ; Get number of characters entered into bc, if 0 quit |
|||
ld b,0 ; bc can be used for adding the text length to iy |
|||
cp b ; b is 0 for setting bc correctly and so can also be used for comparison |
|||
jr z,isnopali |
|||
ld c,a ; bc is now loaded correctly |
|||
ld ix,bufcont ; ix points to start of string |
|||
ld iy,bufcont ; iy points to end of string: Let it point to start... |
|||
add iy,bc ; ...and add the string's length - 1 |
|||
dec iy |
|||
ld b,c ; Use b as counter for comparison (djnz) |
|||
srl b ; Only need to check half the chars - if odd, the middle char need not be checked |
|||
chkloop: |
|||
ld a,(ix) ; Actual comparison: Get (ix) into a and compare with (iy) |
|||
cp (iy) ; Upon mismatch, quit immediately |
|||
jr nz,isnopali |
|||
inc ix |
|||
dec iy |
|||
djnz chkloop |
|||
; All comparisons ok, print success - fall through to ispali |
|||
ispali: |
|||
ld de,messagey |
|||
jr writeres |
|||
isnopali: |
|||
ld de,messagen |
|||
; Fall through to writeres |
|||
writeres: |
|||
ld c,wrtstr ; Echo the text on screen |
|||
call bdos |
|||
newline |
|||
ret ; Return to CP/M |
|||
; |
|||
; =================== |
|||
; End of main program |
|||
; =================== |
|||
; |
|||
; |
|||
; ================ |
|||
; Data definitions |
|||
; ================ |
|||
; |
|||
dseg |
|||
inputbuf: ; Input buffer |
|||
defb buflen ; Maximum possible length |
|||
defb 00h ; Returned length of actual input |
|||
bufcont: |
|||
defs buflen ; Actual input area |
|||
compress: |
|||
defs buflen ; For eliminating spaces |
|||
messagey: |
|||
defz 'Yes' ; Is a Palindrome |
|||
messagen: |
|||
defz 'No' ; Is not a Palindrome |
|||
crlf: defb cr,lf,nul ; Generic newline |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
E>palindrm |
|||
1 2 3 2 1 |
|||
12321 |
|||
Yes |
|||
E>palindrm |
|||
Hello World |
|||
HELLOWORLD |
|||
No |
|||
E>palindrm |
|||
AbC D cBa |
|||
ABCDCBA |
|||
Yes |
|||
E>palindrm |
|||
aaabbbccc |
|||
AAABBBCCC |
|||
No |
|||
</pre> |
|||
=={{header|zkl}}== |
|||
<syntaxhighlight lang="zkl">fcn pali(text){ |
|||
if (text.len()<2) return(False); |
|||
text==text.reverse(); |
|||
} |
|||
fcn pali2(text){ pali((text - " \t\n.,").toLower()) } // or whatever punctuation is</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
pali("red rum sir is murder") //--> False |
|||
pali("red rum sir is murder" - " ") //-->True, remove spaces |
|||
pali2("In girum imus nocte et consumimur igni") //-->True |
|||
</pre> |
|||
=={{header|Zoea}}== |
|||
<syntaxhighlight lang="zoea"> |
|||
program: palindrome |
|||
case: 1 |
|||
input: abcdcba |
|||
output: true |
|||
case: 2 |
|||
input: dog |
|||
output: false |
|||
case: 3 |
|||
input: x |
|||
output: true |
|||
case: 4 |
|||
input: abc |
|||
output: false |
|||
</syntaxhighlight> |
|||
=={{header|Zoea Visual}}== |
|||
[http://zoea.co.uk/examples/zv-rc/Palindrome.png Palindrome] |
Latest revision as of 01:09, 14 July 2024
You are encouraged to solve this task according to the task description, using any language you may know.
A palindrome is a phrase which reads the same backward and forward.
Write a function or program that checks whether a given sequence of characters (or, if you prefer, bytes) is a palindrome.
For extra credit:
- Support Unicode characters.
- Write a second function (possibly as a wrapper to the first) which detects inexact palindromes, i.e. phrases that are palindromes if white-space and punctuation is ignored and case-insensitive comparison is used.
- It might be useful for this task to know how to reverse a string.
- This task's entries might also form the subjects of the task Test a function.
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contains most consonants
- Find words which contains more than 3 vowels
- Find words which first and last three letters are equals
- Find words which odd letters are consonants and even letters are vowels or vice_versa
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 Bottles of Beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
11l
F is_palindrome(s)
R s == reversed(s)
360 Assembly
* Reverse b string 25/06/2018
PALINDRO CSECT
USING PALINDRO,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) prolog
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
LA R8,BB @b[1]
LA R9,AA+L'AA-1 @a[n-1]
LA R6,1 i=1
LOOPI C R6,=A(L'AA) do i=1 to length(a)
BH ELOOPI leave i
MVC 0(1,R8),0(R9) substr(b,i,1)=substr(a,n-i+1,1)
LA R8,1(R8) @b=@b+1
BCTR R9,0 @a=@a-1
LA R6,1(R6) i=i+1
B LOOPI end do
ELOOPI XPRNT AA,L'AA print a
CLC BB,AA if b=a
BNE SKIP
XPRNT MSG,L'MSG then print msg
SKIP L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
AA DC CL32'INGIRUMIMUSNOCTEETCONSUMIMURIGNI' a
BB DS CL(L'AA) b
MSG DC CL23'IT IS A TRUE PALINDROME'
YREGS
END PALINDRO
- Output:
INGIRUMIMUSNOCTEETCONSUMIMURIGNI IT IS A TRUE PALINDROME
8080 Assembly
org 100h
jmp demo
;;; Is the $-terminated string at DE a palindrome?
;;; Returns: zero flag set if palindrome
palin: mov h,d ; Find end of string
mov l,e
mvi a,'$'
cmp m ; The empty string is a palindrome
rz
pend: inx h ; Scan until terminator found
cmp m
jnz pend
dcx h ; Move to last byte of text
ptest: ldax d ; Load char at left pointer
cmp m ; Compare to char at right pointer
rnz ; If not equal, not a palindrome
inx d ; Move pointers
dcx h
mov a,d ; Check if left pointer is before right pointer
cmp h ; High byte
jc ptest
mov a,e ; Low byte
cmp l
jc ptest
xra a ; Made it to the end - set zero flag
ret ; Return
;;; Test the routine on a few examples
demo: lxi h,words ; Word list pointer
loop: mov e,m ; Load word pointer
inx h
mov d,m
inx h
mov a,e ; Stop when zero reached
ora d
rz
push h ; Keep word list pointer
call pstr ; Print word
call palin ; Check if palindrome
lxi d,no
jnz print ; Print "no" if not a palindrome
lxi d,yes ; Print "yes" otherwise
print: call pstr
pop h
jmp loop
;;; Print strint using CP/M keeping DEHL registers
pstr: push d
push h
mvi c,9
call 5
pop h
pop d
ret
yes: db ': yes',13,10,'$'
no: db ': no',13,10,'$'
words: dw w1,w2,w3,w4,0
w1: db 'rotor$'
w2: db 'racecar$'
w3: db 'level$'
w4: db 'rosetta$'
- Output:
rotor: yes racecar: yes level: yes rosetta: no
8086 Assembly
cpu 8086
org 100h
section .text
jmp demo
;;; Check if the $-terminated string in [DS:SI] is a palindrome.
;;; Returns with zero flag set if so.
;;; Destroyed: AL, CX, SI, DI, ES.
palin: push es ; Set ES=DS.
pop ds
mov al,'$' ; Find end of string
mov cx,-1
mov di,si
repne scasb
dec di ; Move back to last actual character
.loop: cmp si,di
ja .ok ; If SI > DI, it is a palindrome
lodsb
dec di ; Compare left character to right character
cmp al,[di]
jne .no ; If not equal, not a palindrome
jmp .loop ; Otherwise, try next pair of characters
.ok: cmp al,al ; Set zero flag
.no: ret ; Return
;;; Try the routine on a couple of strings
demo: mov si,words
.loop: lodsw ; Grab word pointer
test ax,ax ; Zero?
jz .done ; Then we are done
mov dx,ax ; Otherwise, print word
mov ah,9
int 21h
xchg bp,si ; Keep array pointer in BP
xchg si,dx ; Put word pointer in SI
call palin ; Check if it is a palindrome
mov dx,yes ; Print 'yes'...
jz .print ; ...if it is a palindrome
mov dx,no ; Otherwise, print 'no'
.print: int 21h
xchg si,bp ; Restore array pointer
jmp .loop ; Get next word.
.done: ret
yes: db ': yes',13,10,'$' ; Yes and no
no: db ': no',13,10,'$'
words: dw .w1,.w2,.w3,.w4,.w5,0
.w1: db 'rotor$' ; Words to check
.w2: db 'racecar$'
.w3: db 'level$'
.w4: db 'redder$'
.w5: db 'rosetta$'
- Output:
rotor: yes racecar: yes level: yes redder: yes rosetta: no
ACL2
(defun reverse-split-at-r (xs i ys)
(if (zp i)
(mv xs ys)
(reverse-split-at-r (rest xs) (1- i)
(cons (first xs) ys))))
(defun reverse-split-at (xs i)
(reverse-split-at-r xs i nil))
(defun is-palindrome (str)
(let* ((lngth (length str))
(idx (floor lngth 2)))
(mv-let (xs ys)
(reverse-split-at (coerce str 'list) idx)
(if (= (mod lngth 2) 1)
(equal (rest xs) ys)
(equal xs ys)))))
Acornsoft Lisp
This is a small Lisp that doesn't have strings; symbols are used instead. Explode
takes a symbol and returns a list of single-character symbols, one for each character in the symbol's name. Implode
does the reverse.
Since the exact palindrome tests compares two symbols, it can use eq
, and equal
isn't needed.
The character set is ASCII. Given a symbol, ordinal
returns the numeric ASCII code of the the first character in the symbol's name. Character
goes in the other direction and returns a single-character symbol.
The peculiar definition of digit-p
is because it's not possible to type a symbol that has a digit character as its name, and so the between comparison has to be defined using the character before '0' and the one after '9'.
(defun palindrome-type (text)
(cond ((exact-palindrom-p text) 'exact)
((inexact-palindrome-p text) 'inexact)
(t 'not-a-palindrome)))
(defun exact-palindrom-p (text)
(eq text (implode (reverse (explode text)))))
(defun inexact-palindrome-p (text)
(exact-palindrom-p (implode (normalise (explode text)))))
(defun reverse (list (result . ()))
(map '(lambda (e) (setq result (cons e result)))
list)
result)
(defun normalise (chars)
(cond ((null chars)
nil)
((not (alphanumeric-p (car chars)))
(normalise (cdr chars)))
((upper-case-p (car chars))
(cons (to-lower-case (car chars))
(normalise (cdr chars))))
(t
(cons (car chars) (normalise (cdr chars))))))
(defun between-p (lowest-value n highest-value)
(not (or (lessp n lowest-value)
(greaterp n highest-value))))
(defun alphanumeric-p (ch)
(or (lower-case-p ch) (upper-case-p ch) (digit-p ch)))
(defun digit-p (ch)
(between-p (add1 (ordinal '/))
(ordinal ch)
(sub1 (ordinal ':))))
(defun upper-case-p (ch)
(between-p (ordinal 'A) (ordinal ch) (ordinal 'Z)))
(defun lower-case-p (ch)
(between-p (ordinal 'a) (ordinal ch) (ordinal 'z)))
(defun to-lower-case (ch)
(character (plus (ordinal ch)
(difference (ordinal 'a) (ordinal 'A)))))
(defun examples ()
(map '(lambda (text)
(printc '!" text '!"
'! is! (palindrome-type text)))
'(a
abba Abba
abcba
baba
Able! was! I! ere! I! saw! Elba!!
In! girum! imus! nocte,! et! consumimur! igni)))
- Output:
Calling (examples)
will output:
"a" is exact "abba" is exact "Abba" is inexact "abcba" is exact "baba" is not-a-palindrome "Able was I ere I saw Elba!" is inexact "In girum imus nocte, et consumimur igni" is inexact
Action!
BYTE FUNC Palindrome(CHAR ARRAY s)
BYTE l,r
l=1 r=s(0)
WHILE l<r
DO
IF s(l)#s(r) THEN RETURN (0) FI
l==+1 r==-1
OD
RETURN (1)
BYTE FUNC IsIgnored(BYTE c)
IF (c>=' AND c<='/) OR
(c>=': AND c<='@) OR
(c>='[ AND c<='_) THEN
RETURN (1)
FI
RETURN (0)
BYTE FUNC ToUpper(BYTE c)
IF c>='a AND c<='z THEN
RETURN (c-'a+'A)
FI
RETURN (c)
BYTE FUNC InexactPalindrome(CHAR ARRAY s)
BYTE l,r,lc,rc
l=1 r=s(0)
WHILE l<r
DO
WHILE IsIgnored(s(l))
DO
l==+1
IF l>=r THEN RETURN (1) FI
OD
WHILE IsIgnored(s(r))
DO
r==-1
IF l>=r THEN RETURN (1) FI
OD
lc=ToUpper(s(l))
rc=ToUpper(s(r))
IF lc#rc THEN RETURN (0) FI
l==+1 r==-1
OD
RETURN (1)
PROC Test(CHAR ARRAY s)
IF Palindrome(s) THEN
PrintF("'%S' is a palindrome%E%E",s)
ELSEIF InexactPalindrome(s) THEN
PrintF("'%S' is an inexact palindrome%E%E",s)
ELSE
PrintF("'%S' is not a palindrome%E%E",s)
FI
RETURN
PROC Main()
Test("rotavator")
Test("13231+464+989=989+464+13231")
Test("Was it a car or a cat I saw?")
Test("Did Hannah see bees? Hannah did.")
Test("This sentence is not a palindrome.")
Test("123 456 789 897 654 321")
RETURN
- Output:
Screenshot from Atari 8-bit computer
'rotavator' is a palindrome '13231+464+989=989+464+13231' is a palindrome 'Was it a car or a cat I saw?' is an inexact palindrome 'Did Hannah see bees? Hannah did.' is an inexact palindrome 'This sentence is not a palindrome.' is not a palindrome '123 456 789 897 654 321' is not a palindrome
ActionScript
The following function handles non-ASCII characters properly, since charAt() returns a single Unicode character.
function isPalindrome(str:String):Boolean
{
for(var first:uint = 0, second:uint = str.length - 1; first < second; first++, second--)
if(str.charAt(first) != str.charAt(second)) return false;
return true;
}
Ada
function Palindrome (Text : String) return Boolean is
begin
for Offset in 0..Text'Length / 2 - 1 loop
if Text (Text'First + Offset) /= Text (Text'Last - Offset) then
return False;
end if;
end loop;
return True;
end Palindrome;
Ada 2012 version:
function Palindrome (Text : String) return Boolean is
(for all i in Text'Range => Text(i)= Text(Text'Last-i+Text'First));
ALGOL 68
# Iterative #
PROC palindrome = (STRING s)BOOL:(
FOR i TO UPB s OVER 2 DO
IF s[i] /= s[UPB s-i+1] THEN GO TO return false FI
OD;Power
else: TRUE EXIT
return false: FALSE
);
# Recursive #
PROC palindrome r = (STRING s)BOOL:
IF LWB s >= UPB s THEN TRUE
ELIF s[LWB s] /= s[UPB s] THEN FALSE
ELSE palindrome r(s[LWB s+1:UPB s-1])
FI
;
# Test #
main:
(
STRING t = "ingirumimusnocteetconsumimurigni";
FORMAT template = $"sequence """g""" "b("is","isnt")" a palindrome"l$;
printf((template, t, palindrome(t)));
printf((template, t, palindrome r(t)))
)
- Output:
sequence "ingirumimusnocteetconsumimurigni" is a palindrome sequence "ingirumimusnocteetconsumimurigni" is a palindrome
APL
NARS2000 APL, dynamic function "if the argument matches the reverse of the argument", with Unicode character support:
{⍵≡⌽⍵} 'abc'
0
{⍵≡⌽⍵} '⍋racecar⍋'
1
Or in tacit function form, a combination of three functions, right tack (echo), reverse, then the result of each compared with the middle one, match (equals):
(⊢≡⌽) 'abc'
0
(⊢≡⌽) 'nun'
1
An inexact version is harder, because uppercase and lowercase with Unicode awareness depends on APL interpreter; NARS2000 has no support for it. Classic case conversion means lookup up the letters in an alphabet of UppercaseLowercase, then mapping those positions into an UppercaseUppercase or LowercaseLowercase array. Remove non-A-Za-z first to get rid of punctuation, and get an inexact dynamic function with just English letter support:
inexact←{Aa←(⎕A,⎕a) ⋄ (⊢≡⌽)(⎕a,⎕a)[Aa⍳⍵/⍨⍵∊Aa]}
inexact 'abc,-cbA2z'
0
inexact 'abc,-cbA2'
1
Dyalog APL has a Unicode-aware uppercase/lowercase function (819 I-beam), AFAIK no support for looking up Unicode character classes.
AppleScript
Using post-Yosemite AppleScript (to pull in lowercaseStringWithLocale from Foundation classes)
use framework "Foundation"
------ CASE-INSENSITIVE PALINDROME, IGNORING SPACES ? ----
-- isPalindrome :: String -> Bool
on isPalindrome(s)
s = intercalate("", reverse of characters of s)
end isPalindrome
-- toSpaceFreeLower :: String -> String
on spaceFreeToLower(s)
script notSpace
on |λ|(s)
s is not space
end |λ|
end script
intercalate("", filter(notSpace, characters of toLower(s)))
end spaceFreeToLower
--------------------------- TEST -------------------------
on run
isPalindrome(spaceFreeToLower("In girum imus nocte et consumimur igni"))
--> true
end run
-------------------- GENERIC FUNCTIONS -------------------
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if |λ|(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- toLower :: String -> String
on toLower(str)
set ca to current application
((ca's NSString's stringWithString:(str))'s ¬
lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toLower
- Output:
true
Core language only
It's not clear if "sequence of characters" means an array thereof or a single piece of text. But the basic method in AppleScript would be:
on isPalindrome(txt)
set txt to join(txt, "") -- In case the input's a list (array).
return (txt = join(reverse of txt's characters, ""))
end isPalindrome
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
return isPalindrome("Radar")
Text comparisons in AppleScript are case-insensitive by default, so:
- Output:
true
If case is to be taken into account, the call to the handler can be enclosed in a 'considering case' control statement.
considering case
return isPalindrome("Radar")
end considering
- Output:
false
It's also possible to "ignore" white space, hyphens, and punctuation, which are considered by default. And of course case can be ignored explicitly, if desired, to ensure that this condition's in force during the call to the handler. The attributes can be combined in one statement. So to check for inexact palindromicity (if that's a word):
ignoring case, white space, hyphens and punctuation
return isPalindrome("Was it a 😀car, or a c😀at-I-saw?")
end ignoring
- Output:
true
Applesoft BASIC
100 DATA"MY DOG HAS FLEAS"
110 DATA"MADAM, I'M ADAM."
120 DATA"1 ON 1"
130 DATA"IN GIRUM IMUS NOCTE ET CONSUMIMUR IGNI"
140 DATA"A man, a plan, a canal: Panama!"
150 DATA"KAYAK"
160 DATA"REDDER"
170 DATA"H"
180 DATA""
200 FOR L1 = 1 TO 9
210 READ W$ : GOSUB 300" IS PALINDROME?
220 PRINT CHR$(34); W$; CHR$(34); " IS ";
230 IF NOT PALINDROME THEN PRINT "NOT ";
240 PRINT "A PALINDROME"
250 NEXT
260 END
300 REMIS PALINDROME?
310 PA = 1
320 L = LEN(W$)
330 IF L = 0 THEN RETURN
340 FOR L0 = 1 TO L / 2 + .5
350 PA = MID$(W$, L0, 1) = MID$(W$, L - L0 + 1, 1)
360 IF PALINDROME THEN NEXT L0
370 RETURN
ARM Assembly
@ Check whether the ASCII string in [r0] is a palindrome
@ Returns with zero flag set if palindrome.
palin: mov r1,r0 @ Find end of string
1: ldrb r2,[r1],#1 @ Grab character and increment pointer
tst r2,r2 @ Zero yet?
bne 1b @ If not try next byte
sub r1,r1,#2 @ Move R1 to last actual character.
2: cmp r0,r1 @ When R0 >= R1,
cmpgt r2,r2 @ make sure zero is set,
bxeq lr @ and stop (the string is a palindrome).
ldrb r2,[r1],#-1 @ Grab [R1] (end) and decrement.
ldrb r3,[r0],#1 @ Grab [R0] (begin) and increment
cmp r2,r3 @ Are they equal?
bxne lr @ If not, it's not a palindrome.
b 2b @ Otherwise, try next pair.
@ Try the function on a couple of strings
.global _start
_start: ldr r8,=words @ Word pointer
1: ldr r9,[r8],#4 @ Grab word and move pointer
tst r9,r9 @ Null?
moveq r7,#1 @ Then we're done; syscall 1 = exit
swieq #0
mov r1,r9 @ Print the word
bl print
mov r0,r9 @ Test if the word is a palindrome
bl palin
ldreq r1,=yes @ "Yes" if it is a palindrome
ldrne r1,=no @ "No" if it's not a palindrome
bl print
b 1b @ Next word
@ Print zero-terminated string [r1] using Linux syscall
print: push {r7,lr} @ Keep R7 and link register
mov r2,r1 @ Find end of string
1: ldrb r0,[r2],#1 @ Grab character and increment pointer
tst r0,r0 @ Zero yet?
bne 1b @ If not, keep going
sub r2,r2,r1 @ Calculate length of string (bytes to write)
mov r0,#1 @ Stdout = 1
mov r7,#4 @ Syscall 4 = write
swi #0 @ Make the syscall
pop {r7,lr} @ Restore R7 and link register
bx lr
@ Strings
yes: .asciz ": yes\n" @ Output yes or no
no: .asciz ": no\n"
w1: .asciz "rotor" @ Words to test
w2: .asciz "racecar"
w3: .asciz "level"
w4: .asciz "redder"
w5: .asciz "rosetta"
words: .word w1,w2,w3,w4,w5,0
- Output:
rotor: yes racecar: yes level: yes redder: yes rosetta: no
Arturo
palindrome?: $[seq] -> seq = reverse seq
loop ["abba" "boom" "radar" "civic" "great"] 'wrd [
print [wrd ": palindrome?" palindrome? wrd]
]
- Output:
abba : palindrome? true boom : palindrome? false radar : palindrome? true civic : palindrome? true great : palindrome? false
AutoHotkey
Reversing the string:
IsPalindrome(Str){
Loop, Parse, Str
ReversedStr := A_LoopField . ReversedStr
return, (ReversedStr == Str)?"Exact":(RegExReplace(ReversedStr,"\W")=RegExReplace(Str,"\W"))?"Inexact":"False"
}
AutoIt
;== AutoIt Version: 3.3.8.1
Global $aString[7] = [ _
"In girum imus nocte, et consumimur igni", _ ; inexact palindrome
"Madam, I'm Adam.", _ ; inexact palindrome
"salàlas", _ ; exact palindrome
"radar", _ ; exact palindrome
"Lagerregal", _ ; exact palindrome
"Ein Neger mit Gazelle zagt im Regen nie.", _ ; inexact palindrome
"something wrong"] ; no palindrome
Global $sSpace42 = " "
For $i = 0 To 6
If _IsPalindrome($aString[$i]) Then
ConsoleWrite('"' & $aString[$i] & '"' & StringLeft($sSpace42, 42-StringLen($aString[$i])) & 'is an exact palindrome.' & @LF)
Else
If _IsPalindrome( StringRegExpReplace($aString[$i], '\W', '') ) Then
ConsoleWrite('"' & $aString[$i] & '"' & StringLeft($sSpace42, 42-StringLen($aString[$i])) & 'is an inexact palindrome.' & @LF)
Else
ConsoleWrite('"' & $aString[$i] & '"' & StringLeft($sSpace42, 42-StringLen($aString[$i])) & 'is not a palindrome.' & @LF)
EndIf
EndIf
Next
Func _IsPalindrome($_string)
Local $iLen = StringLen($_string)
For $i = 1 To Int($iLen/2)
If StringMid($_string, $i, 1) <> StringMid($_string, $iLen-($i-1), 1) Then Return False
Next
Return True
EndFunc
- Output:
"In girum imus nocte, et consumimur igni" is an inexact palindrome.
"Madam, I'm Adam." is an inexact palindrome.
"salàlas" is an exact palindrome.
"radar" is an exact palindrome.
"Lagerregal" is an exact palindrome.
"Ein Neger mit Gazelle zagt im Regen nie." is an inexact palindrome.
"something wrong" is not a palindrome.
--BugFix (talk) 14:26, 13 November 2013 (UTC)
AWK
Non-recursive
See Reversing a string.
function is_palindro(s)
{
if ( s == reverse(s) ) return 1
return 0
}
Recursive
function is_palindro_r(s)
{
if ( length(s) < 2 ) return 1
if ( substr(s, 1, 1) != substr(s, length(s), 1) ) return 0
return is_palindro_r(substr(s, 2, length(s)-2))
}
Testing
BEGIN {
pal = "ingirumimusnocteetconsumimurigni"
print is_palindro(pal)
print is_palindro_r(pal)
}
BaCon
OPTION COMPARE TRUE
INPUT "Enter your line... ", word$
IF word$ = REVERSE$(word$) THEN
PRINT "This is an exact palindrome!"
ELIF EXTRACT$(word$, "[[:punct:]]|[[:blank:]]", TRUE) = REVERSE$(EXTRACT$(word$, "[[:punct:]]|[[:blank:]]", TRUE)) THEN
PRINT "This is an inexact palindrome!"
ELSE
PRINT "Not a palindrome."
ENDIF
- Output:
Enter your line... In girum imus nocte, et consumimur igni This is an inexact palindrome! Enter your line... Madam, I'm Adam. This is an inexact palindrome! Enter your line... radar This is an exact palindrome! Enter your line... Something else Not a palindrome.
Bash
#! /bin/bash
# very simple way to detect a palindrome in Bash
# output of bash --version -> GNU bash, version 4.4.7(1)-release x86_64 ...
echo "enter a string"
read input
size=${#input}
count=0
while (($count < $size))
do
array[$count]=${input:$count:1}
(( count+=1 ))
done
count=0
for ((i=0 ; i < $size; i+=1))
do
if [ "${array[$i]}" == "${array[$size - $i - 1]}" ]
then
(( count += 1 ))
fi
done
if (( $count == $size ))
then
echo "$input is a palindrome"
fi
BASIC
' OPTION _EXPLICIT ' For QB64. In VB-DOS remove the underscore.
DIM txt$
' Palindrome
CLS
PRINT "This is a palindrome detector program."
PRINT
INPUT "Please, type a word or phrase: ", txt$
IF IsPalindrome(txt$) THEN
PRINT "Is a palindrome."
ELSE
PRINT "Is Not a palindrome."
END IF
END
FUNCTION IsPalindrome (AText$)
' Var
DIM CleanTXT$, RvrsTXT$
CleanTXT$ = CleanText$(AText$)
RvrsTXT$ = RvrsText$(CleanTXT$)
IsPalindrome = (CleanTXT$ = RvrsTXT$)
END FUNCTION
FUNCTION CleanText$ (WhichText$)
' Var
DIM i%, j%, c$, NewText$, CpyTxt$, AddIt%, SubsTXT$
CONST False = 0, True = NOT False
SubsTXT$ = "AIOUE"
CpyTxt$ = UCASE$(WhichText$)
j% = LEN(CpyTxt$)
FOR i% = 1 TO j%
c$ = MID$(CpyTxt$, i%, 1)
' See if it is a letter. Includes Spanish letters.
SELECT CASE c$
CASE "A" TO "Z"
AddIt% = True
CASE " ", "¡", "¢", "£"
c$ = MID$(SubsTXT$, ASC(c$) - 159, 1)
AddIt% = True
CASE "‚"
c$ = "E"
AddIt% = True
CASE "¤"
c$ = "¥"
AddIt% = True
CASE ELSE
AddIt% = False
END SELECT
IF AddIt% THEN
NewText$ = NewText$ + c$
END IF
NEXT i%
CleanText$ = NewText$
END FUNCTION
FUNCTION RvrsText$ (WhichText$)
' Var
DIM i%, c$, NewText$, j%
j% = LEN(WhichText$)
FOR i% = 1 TO j%
NewText$ = MID$(WhichText$, i%, 1) + NewText$
NEXT i%
RvrsText$ = NewText$
END FUNCTION
- Output:
This is a palindrome detector program.
Please, type a word or phrase: Madam, I'm Adam. Is a palindrome.
This is a palindrome detector program.
Please, type a word or phrase: This is just a test. Is not a palindrome.
IS-BASIC
100 PROGRAM "Palindr.bas"
110 LINE INPUT PROMPT "Text: ":TX$
120 PRINT """";TX$;""" is ";
130 IF PALIND(TX$) THEN
140 PRINT "a palindrome."
150 ELSE
160 PRINT "not a palindrome."
170 END IF
180 DEF TRIM$(TX$)
190 LET T$=""
200 FOR I=1 TO LEN(TX$)
210 IF TX$(I)>="A" AND TX$(I)<="Z" THEN LET T$=T$&TX$(I)
220 NEXT
230 LET TRIM$=T$
240 END DEF
250 DEF PALIND(TX$)
260 LET PALIND=-1:LET TX$=TRIM$(UCASE$(TX$))
270 FOR I=1 TO LEN(TX$)/2
280 IF TX$(I)<>TX$(LEN(TX$)-I+1) THEN LET PALIND=0:EXIT FOR
290 NEXT
300 END DEF
Sinclair ZX81 BASIC
Exact palindrome
The specification suggests, but does not insist, that we reverse the input string and then test for equality; this algorithm is more efficient.
10 INPUT S$
20 FOR I=1 TO LEN S$/2
30 IF S$(I)<>S$(LEN S$-I+1) THEN GOTO 60
40 NEXT I
50 GOTO 70
60 PRINT "NOT A ";
70 PRINT "PALINDROME"
Inexact palindrome
Add the following lines to convert the program into an inexact-palindrome checker (i.e. one that ignores non-alphabetic characters). The resulting program still works with only 1k of RAM. The ZX81 only supports its own character set, which does not include lower case, so that case-insensitive comparison and a fortiori Unicode are not possible.
15 GOSUB 90
80 STOP
90 LET T$=""
100 FOR I=1 TO LEN S$
110 IF S$(I)>="A" AND S$(I)<="Z" THEN LET T$=T$+S$(I)
120 NEXT I
130 LET S$=T$
140 RETURN
BBC BASIC
test$ = "A man, a plan, a canal: Panama!"
PRINT """" test$ """" ;
IF FNpalindrome(FNletters(test$)) THEN
PRINT " is a palindrome"
ELSE
PRINT " is not a palindrome"
ENDIF
END
DEF FNpalindrome(A$) = (A$ = FNreverse(A$))
DEF FNreverse(A$)
LOCAL B$, P%
FOR P% = LEN(A$) TO 1 STEP -1
B$ += MID$(A$,P%,1)
NEXT
= B$
DEF FNletters(A$)
LOCAL B$, C%, P%
FOR P% = 1 TO LEN(A$)
C% = ASC(MID$(A$,P%))
IF C% > 64 AND C% < 91 OR C% > 96 AND C% < 123 THEN
B$ += CHR$(C% AND &5F)
ENDIF
NEXT
= B$
- Output:
"A man, a plan, a canal: Panama!" is a palindrome
Batch File
@echo off
setlocal enabledelayedexpansion
set /p string=Your string :
set count=0
:loop
if "!%string%:~%count%,1!" neq "" (
set reverse=!%string%:~%count%,1!!reverse!
set /a count+=1
goto loop
)
set palindrome=isn't
if "%string%"=="%reverse%" set palindrome=is
echo %string% %palindrome% a palindrome.
pause
exit
Or, recursive (and without setlocal enabledelayedexpansion) (compatible with ReactOS cmd.exe)
@echo off
set /p testString=Your string (all same case please) :
call :isPalindrome result %testString: =%
if %result%==1 echo %testString% is a palindrome
if %result%==0 echo %testString% isn't a palindrome
pause
goto :eof
:isPalindrome
set %1=0
set string=%2
if "%string:~2,1%"=="" (
set %1=1
goto :eof
)
if "%string:~0,1%"=="%string:~-1%" (
call :isPalindrome %1 %string:~1,-1%
)
goto :eof
BCPL
get "libhdr"
let palindrome(s) = valof
$( let l = s%0
for i = 1 to l/2
unless s%i = s%(l+1-i)
resultis false
resultis true
$)
let inexact(s) = valof
$( let temp = vec 1+256/BYTESPERWORD
temp%0 := 0
for i = 1 to s%0 do
$( let ch = s%i | 32
if '0'<=ch & ch<='9' | 'a'<=ch & ch<='z' then
$( temp%0 := temp%0 + 1
temp%(temp%0) := ch
$)
$)
resultis palindrome(temp)
$)
let check(s) =
palindrome(s) -> "exact palindrome",
inexact(s) -> "inexact palindrome",
"not a palindrome"
let start() be
$( let tests = vec 8
tests!0 := "rotor"
tests!1 := "racecar"
tests!2 := "RACEcar"
tests!3 := "level"
tests!4 := "redder"
tests!5 := "rosetta"
tests!6 := "A man, a plan, a canal: Panama"
tests!7 := "Egad, a base tone denotes a bad age"
tests!8 := "This is not a palindrome"
for i = 0 to 8 do
writef("'%S': %S*N", tests!i, check(tests!i))
$)
- Output:
'rotor': exact palindrome 'racecar': exact palindrome 'RACEcar': inexact palindrome 'level': exact palindrome 'redder': exact palindrome 'rosetta': not a palindrome 'A man, a plan, a canal: Panama': inexact palindrome 'Egad, a base tone denotes a bad age': inexact palindrome 'This is not a palindrome': not a palindrome
Befunge
The following code reads a line from stdin and prints "True" if it is a palindrome, or False" otherwise.
v_$0:8p>:#v_:18p08g1-08p >:08g`!v
~->p5p ^ 0v1p80-1g80vj!-g5g80g5_0'ev
:a^80+1:g8<>8g1+:18pv>0"eslaF">:#,_@
[[relet]]-2010------>003-x -^"Tru"<
To check a string, replace "dennis sinned" with your own string.
Note that this has some limits.:
- There must be a quotation mark immediately after the string, and then nothing but spaces for the rest of that line.
- The v at the end of that same line must remain immediately above the 2. (Very important.) The closing quotation mark can be against the v, but can't replace it.
- The potential palindrome can be no longer than 76 characters (which beats the previous version's 11), and everything (spaces, punctuation, capitalization, etc.) is considered part of the palindrome. (Best to just use lower case letters and nothing else.)
v> "emordnilap a toN",,,,,,,,,,,,,,,,@,,,,,,,,,,,,,,,"Is a palindrome" <
2^ < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <
4 ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v
8 ^_v # ^_v # ^_v # ^_v # ^_v # ^_v # ^_v # ^_v # ^_v # ^_v # ^_v # ^_v # ^_v
*^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v ^_v
+ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
>"dennis sinned" v
" 2
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" 0
> ^- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 9
_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ p
v_^ # v_^ # v_^ # v_^ # v_^ # v_^ # v_^ # v_^ # v_^ # v_^ # v_^ # v_^ # v_^
v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^ v_^
^< < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <
>09g8p09g1+09pv
|: < <
^<
BQN
3 functions in three different styles to check if a string is a palindrome. All three forms return 1 for palindrome, and 0 for non-palindrome.
BQN considers characters as single units, and hence the functions support unicode by default.
Pal ← ≡⊸⌽
Pal1 ← ⊢≡⌽
Pal2 ← {𝕩≡⌽𝕩}
Bracmat
( ( palindrome
= a
. @(!arg:(%?a&utf$!a) ?arg !a)
& palindrome$!arg
| utf$!arg
)
& ( desep
= x
. @(!arg:?x (" "|"-"|",") ?arg)
& !x desep$!arg
| !arg
)
& "In girum imus nocte et consumimur igni"
"Я иду с мечем, судия"
"The quick brown fox"
"tregða, gón, reiði - er nóg að gert"
"人人為我,我為人人"
"가련하시다 사장집 아들딸들아 집장사 다시 하련가"
: ?candidates
& whl
' ( !candidates:%?candidate ?candidates
& out
$ ( !candidate
is
( palindrome$(low$(str$(desep$!candidate)))
& indeed
| not
)
a
palindrome
)
)
&
);
Output:
In girum imus nocte et consumimur igni is indeed a palindrome Я иду с мечем, судия is indeed a palindrome The quick brown fox is not a palindrome tregða, gón, reiði - er nóg að gert is indeed a palindrome 人人為我,我為人人 is indeed a palindrome 가련하시다 사장집 아들딸들아 집장사 다시 하련가 is indeed a palindrome
Bruijn
:import std/String .
main [<~>0 =? 0]
:test (main "tacocat") ([[1]])
:test (main "bruijn") ([[0]])
Burlesque
zz{ri}f[^^<-==
C
Non-recursive
This function compares the first char with the last, the second with the one previous the last, and so on. The first different pair it finds, return 0 (false); if all the pairs were equal, then return 1 (true). You only need to go up to (the length) / 2 because the second half just re-checks the same stuff as the first half; and if the length is odd, the middle doesn't need to be checked (so it's okay to do integer division by 2, which rounds down).
#include <string.h>
int palindrome(const char *s)
{
int i,l;
l = strlen(s);
for(i=0; i<l/2; i++)
{
if ( s[i] != s[l-i-1] ) return 0;
}
return 1;
}
More idiomatic version:
int palindrome(const char *s)
{
const char *t; /* t is a pointer that traverses backwards from the end */
for (t = s; *t != '\0'; t++) ; t--; /* set t to point to last character */
while (s < t)
{
if ( *s++ != *t-- ) return 0;
}
return 1;
}
Recursive
A single char is surely a palindrome; a string is a palindrome if first and last char are the same and the remaining string (the string starting from the second char and ending to the char preceding the last one) is itself a palindrome.
int palindrome_r(const char *s, int b, int e)
{
if ( (e - 1) <= b ) return 1;
if ( s[b] != s[e-1] ) return 0;
return palindrome_r(s, b+1, e-1);
}
Testing
#include <stdio.h>
#include <string.h>
/* testing */
int main()
{
const char *t = "ingirumimusnocteetconsumimurigni";
const char *template = "sequence \"%s\" is%s palindrome\n";
int l = strlen(t);
printf(template,
t, palindrome(t) ? "" : "n't");
printf(template,
t, palindrome_r(t, 0, l) ? "" : "n't");
return 0;
}
C#
Non-recursive
using System;
class Program
{
static string Reverse(string value)
{
char[] chars = value.ToCharArray();
Array.Reverse(chars);
return new string(chars);
}
static bool IsPalindrome(string value)
{
return value == Reverse(value);
}
static void Main(string[] args)
{
Console.WriteLine(IsPalindrome("ingirumimusnocteetconsumimurigni"));
}
}
Using LINQ operators
using System;
using System.Linq;
class Program
{
static bool IsPalindrome(string text)
{
return text == new String(text.Reverse().ToArray());
}
static void Main(string[] args)
{
Console.WriteLine(IsPalindrome("ingirumimusnocteetconsumimurigni"));
}
}
No string reversal
Reversing a string is very slow. A much faster way is to simply compare characters.
using System;
static class Program
{
//As an extension method (must be declared in a static class)
static bool IsPalindrome(this string sentence)
{
for (int l = 0, r = sentence.Length - 1; l < r; l++, r--)
if (sentence[l] != sentence[r]) return false;
return true;
}
static void Main(string[] args)
{
Console.WriteLine("ingirumimusnocteetconsumimurigni".IsPalindrome());
}
}
C++
The C solutions also work in C++, but C++ allows a simpler one:
#include <string>
#include <algorithm>
bool is_palindrome(std::string const& s)
{
return std::equal(s.begin(), s.end(), s.rbegin());
}
Or, checking half is sufficient (on odd-length strings, this will ignore the middle element):
#include <string>
#include <algorithm>
bool is_palindrome(std::string const& s)
{
return std::equal(s.begin(), s.begin()+s.length()/2, s.rbegin());
}
Clojure
(defn palindrome? [s]
(= s (clojure.string/reverse s)))
lower-level, but somewhat faster
(defn palindrome? [^String s]
(loop [front 0 back (dec (.length s))]
(or (>= front back)
(and (= (.charAt s front) (.charAt s back))
(recur (inc front) (dec back)))))
Test
user=> (palindrome? "amanaplanacanalpanama") true user=> (palindrome? "Test 1, 2, 3") false
CLU
% Reverse a string
str_reverse = proc (s: string) returns (string)
chs: array[char] := array[char]$predict(0, string$size(s))
for c: char in string$chars(s) do
array[char]$addl(chs, c)
end
return (string$ac2s(chs))
end str_reverse
% 'Normalize' a string (remove everything but letters and make uppercase)
normalize = proc (s: string) returns (string)
chs: array[char] := array[char]$predict(0, string$size(s))
for c: char in string$chars(s) do
if c>='a' cand c<='z' then
c := char$i2c(char$c2i(c) - 32)
end
if c>='A' cand c<='Z' then
array[char]$addh(chs, c)
end
end
return (string$ac2s(chs))
end normalize
% Check if a string is an exact palindrome
palindrome = proc (s: string) returns (bool)
return (s = str_reverse(s))
end palindrome
% Check if a string is an inexact palindrome
inexact_palindrome = proc (s: string) returns (bool)
return (palindrome(normalize(s)))
end inexact_palindrome
% Test cases
start_up = proc ()
po: stream := stream$primary_output()
tests: array[string] := array[string]$[
"rotor", "racecar", "RACEcar", "level", "rosetta",
"A man, a plan, a canal: Panama",
"Egad, a base tone denotes a bad age",
"This is not a palindrome"
]
for test: string in array[string]$elements(tests) do
stream$puts(po, "\"" || test || "\": ")
if palindrome(test) then
stream$putl(po, "exact palindrome")
elseif inexact_palindrome(test) then
stream$putl(po, "inexact palindrome")
else
stream$putl(po, "not a palindrome")
end
end
end start_up
- Output:
"rotor": exact palindrome "racecar": exact palindrome "RACEcar": inexact palindrome "level": exact palindrome "rosetta": not a palindrome "A man, a plan, a canal: Panama": inexact palindrome "Egad, a base tone denotes a bad age": inexact palindrome "This is not a palindrome": not a palindrome
COBOL
identification division.
function-id. palindromic-test.
data division.
linkage section.
01 test-text pic x any length.
01 result pic x.
88 palindromic value high-value
when set to false low-value.
procedure division using test-text returning result.
set palindromic to false
if test-text equal function reverse(test-text) then
set palindromic to true
end-if
goback.
end function palindromic-test.
CoffeeScript
String::isPalindrome = ->
for i in [0...@length / 2] when @[i] isnt @[@length - (i + 1)]
return no
yes
String::stripped = -> @toLowerCase().replace /\W/gi, ''
console.log "'#{ str }' : #{ str.stripped().isPalindrome() }" for str in [
'In girum imus nocte et consumimur igni'
'A man, a plan, a canal: Panama!'
'There is no spoon.'
]
- Output:
'In girum imus nocte et consumimur igni' : true 'A man, a plan, a canal: Panama!' : true 'There is no spoon.' : false
Common Lisp
(defun palindrome-p (s)
(string= s (reverse s)))
Alternate solution
I use Allegro CL 10.1
;; Project : Palindrome detection
(defun palindrome(x)
(if (string= x (reverse x))
(format t "~d" ": palindrome" (format t x))
(format t "~d" ": not palindrome" (format t x))))
(terpri)
(setq x "radar")
(palindrome x)
(terpri)
(setq x "books")
(palindrome x)
(terpri)
Output:
radar: palindrome books: not palindrome
Component Pascal
BlackBox Component Builder
MODULE BbtPalindrome;
IMPORT StdLog;
PROCEDURE ReverseStr(str: ARRAY OF CHAR): POINTER TO ARRAY OF CHAR;
VAR
top,middle,i: INTEGER;
c: CHAR;
rStr: POINTER TO ARRAY OF CHAR;
BEGIN
NEW(rStr,LEN(str$) + 1);
top := LEN(str$) - 1; middle := (top - 1) DIV 2;
FOR i := 0 TO middle DO
rStr[i] := str[top - i];
rStr[top - i] := str[i];
END;
IF ODD(LEN(str$)) THEN rStr[middle + 1] := str[middle + 1] END;
RETURN rStr;
END ReverseStr;
PROCEDURE IsPalindrome(str: ARRAY OF CHAR): BOOLEAN;
BEGIN
RETURN str = ReverseStr(str)$;
END IsPalindrome;
PROCEDURE Do*;
VAR
x: CHAR;
BEGIN
StdLog.String("'salalas' is palindrome?:> ");
StdLog.Bool(IsPalindrome("salalas"));StdLog.Ln;
StdLog.String("'madamimadam' is palindrome?:> ");
StdLog.Bool(IsPalindrome("madamimadam"));StdLog.Ln;
StdLog.String("'abcbda' is palindrome?:> ");
StdLog.Bool(IsPalindrome("abcbda"));StdLog.Ln;
END Do;
END BbtPalindrome.
Execute: ^Q BbtPalindrome.Do
- Output:
'salalas' is palindrome?:> $TRUE 'madamimadam' is palindrome?:> $TRUE 'abcbda' is palindrome?:> $FALSE
Cowgol
include "cowgol.coh";
# Check if a string is a palindrome
sub palindrome(word: [uint8]): (r: uint8) is
r := 1;
# empty string is a palindrome
if [word] == 0 then
return;
end if;
# find the end of the word
var end_ := word;
while [@next end_] != 0 loop
end_ := @next end_;
end loop;
# check if bytes match in both directions
while word < end_ loop
if [word] != [end_] then
r := 0;
return;
end if;
word := @next word;
end_ := @prev end_;
end loop;
end sub;
# Check if a string is an inexact palindrome
sub inexact(word: [uint8]): (r: uint8) is
var buf: uint8[256];
var ptr := &buf[0];
# filter non-letters and non-numbers
while [word] != 0 loop
var c := [word];
if (c >= 'a' and c <= 'z') or (c >= '0' and c <= '9') then
# copy lowercase letters and numbers over verbatim
[ptr] := c;
ptr := @next ptr;
elseif c >= 'A' and c <= 'Z' then
# make uppercase letters lowercase
[ptr] := c | 32;
ptr := @next ptr;
end if;
word := @next word;
end loop;
[ptr] := 0;
r := palindrome(&buf[0]);
end sub;
var tests: [uint8][] := {
"civic", "level", "racecar",
"A man, a plan, a canal: Panama",
"Egad, a base tone denotes a bad age",
"There is no spoon."
};
var i: @indexof tests := 0;
while i < @sizeof tests loop
print(tests[i]);
print(": ");
if palindrome(tests[i]) == 1 then
print("exact palindrome\n");
elseif inexact(tests[i]) == 1 then
print("inexact palindrome\n");
else
print("not a palindrome\n");
end if;
i := i + 1;
end loop;
- Output:
civic: exact palindrome level: exact palindrome racecar: exact palindrome A man, a plan, a canal: Panama: inexact palindrome Egad, a base tone denotes a bad age: inexact palindrome There is no spoon.: not a palindrome
Crystal
Declarative
def palindrome(s)
s == s.reverse
end
Imperative
def palindrome_imperative(s) : Bool
mid = s.size // 2
last = s.size - 1
(0...mid).each do |i|
if s[i] != s[last - i]
return false
end
end
true
end
Also
def palindrome_2(s)
mid = s.size // 2
mid.times { |j| return false if s[j] != s[-1 - j] }
true
end
Performance comparison
require "benchmark"
Benchmark.ips do |x|
x.report("declarative") { palindrome("hannah") }
x.report("imperative1") { palindrome_imperative("hannah")}
x.report("imperative2") { palindrome_2("hannah")}
end
declarative 45.45M ( 22.00ns) (±11.16%) 32.0B/op fastest imperative1 35.49M ( 28.18ns) (± 2.82%) 0.0B/op 1.28× slower imperative2 40.73M ( 24.55ns) (± 3.82%) 0.0B/op 1.12× slower
D
High-level 32-bit Unicode Version
import std.traits, std.algorithm;
bool isPalindrome1(C)(in C[] s) pure /*nothrow*/
if (isSomeChar!C) {
auto s2 = s.dup;
s2.reverse(); // works on Unicode too, not nothrow.
return s == s2;
}
void main() {
alias pali = isPalindrome1;
assert(pali(""));
assert(pali("z"));
assert(pali("aha"));
assert(pali("sees"));
assert(!pali("oofoe"));
assert(pali("deified"));
assert(!pali("Deified"));
assert(pali("amanaplanacanalpanama"));
assert(pali("ingirumimusnocteetconsumimurigni"));
assert(pali("salà las"));
}
Mid-level 32-bit Unicode Version
import std.traits;
bool isPalindrome2(C)(in C[] s) pure if (isSomeChar!C) {
dchar[] dstr;
foreach (dchar c; s) // not nothrow
dstr ~= c;
for (int i; i < dstr.length / 2; i++)
if (dstr[i] != dstr[$ - i - 1])
return false;
return true;
}
void main() {
alias isPalindrome2 pali;
assert(pali(""));
assert(pali("z"));
assert(pali("aha"));
assert(pali("sees"));
assert(!pali("oofoe"));
assert(pali("deified"));
assert(!pali("Deified"));
assert(pali("amanaplanacanalpanama"));
assert(pali("ingirumimusnocteetconsumimurigni"));
assert(pali("salà las"));
}
Low-level 32-bit Unicode Version
import std.stdio, core.exception, std.traits;
// assume alloca() to be pure for this program
extern(C) pure nothrow void* alloca(in size_t size);
bool isPalindrome3(C)(in C[] s) pure if (isSomeChar!C) {
auto p = cast(dchar*)alloca(s.length * 4);
if (p == null)
// no fallback heap allocation used
throw new OutOfMemoryError();
dchar[] dstr = p[0 .. s.length];
// use std.utf.stride for an even lower level version
int i = 0;
foreach (dchar c; s) { // not nothrow
dstr[i] = c;
i++;
}
dstr = dstr[0 .. i];
foreach (j; 0 .. dstr.length / 2)
if (dstr[j] != dstr[$ - j - 1])
return false;
return true;
}
void main() {
alias isPalindrome3 pali;
assert(pali(""));
assert(pali("z"));
assert(pali("aha"));
assert(pali("sees"));
assert(!pali("oofoe"));
assert(pali("deified"));
assert(!pali("Deified"));
assert(pali("amanaplanacanalpanama"));
assert(pali("ingirumimusnocteetconsumimurigni"));
assert(pali("salà las"));
}
Low-level ASCII Version
bool isPalindrome4(in string str) pure nothrow {
if (str.length == 0) return true;
immutable(char)* s = str.ptr;
immutable(char)* t = &(str[$ - 1]);
while (s < t)
if (*s++ != *t--) // ugly
return false;
return true;
}
void main() {
alias isPalindrome4 pali;
assert(pali(""));
assert(pali("z"));
assert(pali("aha"));
assert(pali("sees"));
assert(!pali("oofoe"));
assert(pali("deified"));
assert(!pali("Deified"));
assert(pali("amanaplanacanalpanama"));
assert(pali("ingirumimusnocteetconsumimurigni"));
//assert(pali("salà las"));
}
Dart
bool isPalindrome(String s){
for(int i = 0; i < s.length/2;i++){
if(s[i] != s[(s.length-1) -i])
return false;
}
return true;
}
Delphi
uses
SysUtils, StrUtils;
function IsPalindrome(const aSrcString: string): Boolean;
begin
Result := SameText(aSrcString, ReverseString(aSrcString));
end;
Dyalect
func isPalindrom(str) {
str == str.Reverse()
}
print(isPalindrom("ingirumimusnocteetconsumimurigni"))
Déjà Vu
palindrome?:
local :seq chars
local :len-seq -- len seq
for i range 0 / len-seq 2:
if /= seq! i seq! - len-seq i:
return false
true
!. palindrome? "ingirumimusnocteetconsumimurigni"
!. palindrome? "nope"
- Output:
true false
E
It is only necessarily to scan the first half of the string, upper(0, upper.size() // 2)
, and compare each character to the corresponding character from the other end, upper[last - i]
.
The for loop syntax is for key pattern => value pattern in collection { ... }
, ?
imposes an additional boolean condition on a pattern (it may be read “such that”), and if the pattern does not match in a for loop then the iteration is skipped, so false is returned only if upper[last - i] != c
.
def isPalindrome(string :String) {
def upper := string.toUpperCase()
def last := upper.size() - 1
for i => c ? (upper[last - i] != c) in upper(0, upper.size() // 2) {
return false
}
return true
}
EasyLang
func$ reverse s$ .
a$[] = strchars s$
for i = 1 to len a$[] div 2
swap a$[i] a$[len a$[] - i + 1]
.
return strjoin a$[]
.
func palin s$ .
if s$ = reverse s$
return 1
.
return 0
.
for s$ in [ "rotor" "rosetta" "step on no pets" "été" "🦊😀🦊" ]
if palin s$ = 1
print s$ & " is a palindrome"
else
print s$ & " is not a palindrome"
.
.
EchoLisp
;; returns #t or #f
(define (palindrome? string)
(equal? (string->list string) (reverse (string->list string))))
;; to strip spaces, use the following
;;(define (palindrome? string)
;;(let ((string (string-replace string "/\ /" "" "g")))
;;(equal? (string->list string) (reverse (string->list string)))))
ed
A limitation: due to ed having no built-in loops, the part with palindrome beginning/end matching has to be repeated as many times as there are palindrome levels. As a sane default, 15 is used here.
# by Artyom Bologov
H
,p
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
g/^(.)(.*)\1$/s//\2/
v/^(.)(.+)\1$|^.?$/s/.*/Not a palindrome!/
g/^.?$/s//Palindrome!/
,p
Q
- Output:
$ cat palindrome.ed | ed -lEGs palindrome.input Newline appended rotor racecar level rosetta oppo Palindrome! Palindrome! Palindrome! Not a palindrome! Palindrome!
Eiffel
is_palindrome (a_string: STRING): BOOLEAN
-- Is `a_string' a palindrome?
require
string_attached: a_string /= Void
local
l_index, l_count: INTEGER
do
from
Result := True
l_index := 1
l_count := a_string.count
until
l_index >= l_count - l_index + 1 or not Result
loop
Result := (Result and a_string [l_index] = a_string [l_count - l_index + 1])
l_index := l_index + 1
end
end
Ela
open list string
isPalindrome xs = xs == reverse xs
isPalindrome <| toList "ingirumimusnocteetconsumimurigni"
Function reverse
is taken from list module and is defined as:
reverse = foldl (flip (::)) (nil xs)
foldl f z (x::xs) = foldl f (f z x) xs
foldl _ z [] = z
Elixir
defmodule PalindromeDetection do
def is_palindrome(str), do: str == String.reverse(str)
end
Note: Because of Elixir's strong Unicode support, this even supports graphemes:
iex(1)> PalindromeDetection.is_palindrome("salàlas") true iex(2)> PalindromeDetection.is_palindrome("as⃝df̅") false iex(3)> PalindromeDetection.is_palindrome("as⃝df̅f̅ds⃝a") true
Elm
import String exposing (reverse, length)
import Html exposing (Html, Attribute, text, div, input)
import Html.Attributes exposing (placeholder, value, style)
import Html.Events exposing (on, targetValue)
import Html.App exposing (beginnerProgram)
-- The following function (copied from Haskell) satisfies the
-- rosettacode task description.
is_palindrome x = x == reverse x
-- The remainder of the code demonstrates the use of the function
-- in a complete Elm program.
main = beginnerProgram { model = "" , view = view , update = update }
update newStr oldStr = newStr
view : String -> Html String
view candidate =
div []
([ input
[ placeholder "Enter a string to check."
, value candidate
, on "input" targetValue
, myStyle
]
[]
] ++
[ let testResult =
is_palindrome candidate
statement =
if testResult then "PALINDROME!" else "not a palindrome"
in div [ myStyle] [text statement]
])
myStyle : Attribute msg
myStyle =
style
[ ("width", "100%")
, ("height", "20px")
, ("padding", "5px 0 0 5px")
, ("font-size", "1em")
, ("text-align", "left")
]
Link to live demo: http://dc25.github.io/palindromeDetectionElm/
Emacs Lisp
(defun palindrome (s)
(string= s (reverse s)))
The version below will work correctly with inexact palindromes, as defined in this exercise:
(defun test-if-palindrome (text)
(setq text (replace-regexp-in-string "[[:space:][:punct:]]" "" text)) ; remove spaces and punctuation, by replacing them with nothing
(string-equal-ignore-case text (reverse text))) ; ignore case when looking at reversed text
- Output:
(test-if-palindrome "A man, a plan, a canal, Panama") t
Erlang
-module( palindrome ).
-export( [is_palindrome/1, task/0] ).
is_palindrome( String ) -> String =:= lists:reverse(String).
task() ->
display( "abcba" ),
display( "abcdef" ),
Latin = "In girum imus nocte et consumimur igni",
No_spaces_same_case = lists:append( string:tokens(string:to_lower(Latin), " ") ),
display( Latin, No_spaces_same_case ).
display( String ) -> io:fwrite( "Is ~p a palindrom? ~p~n", [String, is_palindrome(String)] ).
display( String1, String2 ) -> io:fwrite( "Is ~p a palindrom? ~p~n", [String1, is_palindrome(String2)] ).
- Output:
22> palindrome:task(). Is "abcba" a palindrom? true Is "abcdef" a palindrom? false Is "In girum imus nocte et consumimur igni" a Latin palindrom? true
Euphoria
function isPalindrome(sequence s)
for i = 1 to length(s)/2 do
if s[i] != s[$-i+1] then
return 0
end if
end for
return 1
end function
include std/sequence.e -- reverse
include std/console.e -- display
include std/text.e -- upper
include std/utils.e -- iif
IsPalindrome("abcba")
IsPalindrome("abcdef")
IsPalindrome("In girum imus nocte et consumimur igni")
procedure IsPalindrome(object s)
display("Is '[]' a palindrome? ",{s},0)
s = remove_all(' ',upper(s))
display(iif(equal(s,reverse(s)),"true","false"))
end procedure
- Output:
Is 'abcba' a palindrome? true Is 'abcdef' a palindrome? false Is 'In girum imus nocte et consumimur igni' a palindrome? true
Excel
LAMBDA
Binding the following lambda expression to the name ISPALINDROME in the Name Manager for the Excel WorkBook:
(See LAMBDA: The ultimate Excel worksheet function)
ISPALINDROME
=LAMBDA(s,
LET(
lcs, FILTERP(
LAMBDA(c, " " <> c)
)(
CHARS(LOWER(s))
),
CONCAT(lcs) = CONCAT(REVERSE(lcs))
)
)
and assuming that the following generic lambdas are also bound to the names CHARS, FILTERP, and REVERSE in the Name Manager for the active WorkBook:
CHARS
=LAMBDA(s,
MID(s, ROW(INDIRECT("1:" & LEN(s))), 1)
)
FILTERP
=LAMBDA(p,
LAMBDA(xs,
FILTER(xs, p(xs))
)
)
REVERSE
=LAMBDA(xs,
LET(
n, ROWS(xs),
SORTBY(
xs,
SEQUENCE(n, 1, n, -1)
)
)
)
- Output:
fx | =ISPALINDROME(A2) | ||
---|---|---|---|
A | B | ||
1 | Test string | Is palindrome ? | |
2 | In girum imus nocte et consumimur igni | TRUE | |
3 | abban | FALSE | |
4 | abba | TRUE | |
5 | aba | TRUE | |
6 | ab | FALSE | |
7 | a | TRUE |
F#
let isPalindrome (s: string) =
let arr = s.ToCharArray()
arr = Array.rev arr
Examples:
isPalindrome "abcba"
val it : bool = true
isPalindrome ("In girum imus nocte et consumimur igni".Replace(" ", "").ToLower());;
val it : bool = true
isPalindrome "abcdef"
val it : bool = false
Factor
USING: kernel sequences ;
: palindrome? ( str -- ? ) dup reverse = ;
Falcon
VBA/Python programmer's approach not sure if it's the most falconic way
/* created by Aykayayciti Earl Lamont Montgomery
April 9th, 2018 */
function is_palindrome(a)
a = strUpper(a).replace(" ", "")
b = a[-1:0]
return b == a
end
a = "mom"
> is_palindrome(a)
- Output:
true [Finished in 1.7s]
more falconic
/* created by Aykayayciti Earl Lamont Montgomery
April 9th, 2018 */
b = "mom"
> strUpper(b).replace(" ", "") == strUpper(b[-1:0]) ? "Is a palindrome" : "Is not a palindrome"
- Output:
Is a palindrome [Finished in 1.5s]
Fantom
class Palindrome
{
// Function to test if given string is a palindrome
public static Bool isPalindrome (Str str)
{
str == str.reverse
}
// Give it a test run
public static Void main ()
{
echo (isPalindrome(""))
echo (isPalindrome("a"))
echo (isPalindrome("aa"))
echo (isPalindrome("aba"))
echo (isPalindrome("abb"))
echo (isPalindrome("salàlas"))
echo (isPalindrome("In girum imus nocte et consumimur igni".lower.replace(" ","")))
}
}
FBSL
#APPTYPE CONSOLE
FUNCTION stripNonAlpha(BYVAL s AS STRING) AS STRING
DIM sTemp AS STRING = ""
DIM c AS STRING
FOR DIM i = 1 TO LEN(s)
c = MID(s, i, 1)
IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", c, 0, 1) THEN
sTemp = stemp & c
END IF
NEXT
RETURN sTemp
END FUNCTION
FUNCTION IsPalindrome(BYVAL s AS STRING) AS INTEGER
FOR DIM i = 1 TO STRLEN(s) \ 2 ' only check half of the string, as scanning from both ends
IF s{i} <> s{STRLEN - (i - 1)} THEN RETURN FALSE 'comparison is not case sensitive
NEXT
RETURN TRUE
END FUNCTION
PRINT IsPalindrome(stripNonAlpha("A Toyota"))
PRINT IsPalindrome(stripNonAlpha("Madam, I'm Adam"))
PRINT IsPalindrome(stripNonAlpha("the rain in Spain falls mainly on the rooftops"))
PAUSE
- Output:
1 1 0
Forth
: first over c@ ;
: last >r 2dup + 1- c@ r> swap ;
: palindrome? ( c-addr u -- f )
begin
dup 1 <= if 2drop true exit then
first last <> if 2drop false exit then
1 /string 1-
again ;
FIRST and LAST are once-off words that could be beheaded immediately afterwards. The version taking advantage of Tail Call Optimization or a properly tail-recursive variant of RECURSE (easily added to any Forth) is very similar. The horizontal formatting highlights the parallel code - and potential factor; a library of many string tests like this could have ?SUCCESS and ?FAIL .
Below is a separate Forth program that detects palindrome phrases as well as single word palindromes. It was programmed using gforth.
variable temp-addr
: valid-char? ( addr1 u -- f ) ( check for valid character )
+ dup C@ 48 58 within
over C@ 65 91 within or
swap C@ 97 123 within or ;
: >upper ( c1 -- c2 )
dup 97 123 within if 32 - then ;
: strip-input ( addr1 u -- addr2 u ) ( Strip characters, then copy stripped string to temp-addr )
pad temp-addr !
temp-addr @ rot rot 0 do dup I 2dup valid-char? if
+ C@ >upper temp-addr @ C! 1 temp-addr +!
else 2drop
then loop drop temp-addr @ pad - ;
: get-phrase ( -- addr1 u )
." Type a phrase: " here 1024 accept here swap -trailing cr ;
: position-phrase ( addr1 u -- addr1 u addr2 u addr1 addr2 u )
temp-addr @ over 2over 2over drop swap ;
: reverse-copy ( addr1 addr2 u -- addr1 addr2 )
0 do over I' 1- I - + over I + 1 cmove loop 2drop ;
: palindrome? ( -- )
get-phrase strip-input position-phrase reverse-copy compare 0= if
." << Valid >> Palindrome."
else ." << Not >> a Palindrome."
then cr ;
Example:
palindrome?
Type a phrase: A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal-Panama!
<< Valid >> Palindrome.
Fortran
program palindro
implicit none
character(len=*), parameter :: p = "ingirumimusnocteetconsumimurigni"
print *, is_palindro_r(p)
print *, is_palindro_r("anothertest")
print *, is_palindro2(p)
print *, is_palindro2("test")
print *, is_palindro(p)
print *, is_palindro("last test")
contains
Non-recursive
! non-recursive
function is_palindro(t)
logical :: is_palindro
character(len=*), intent(in) :: t
integer :: i, l
l = len(t)
is_palindro = .false.
do i=1, l/2
if ( t(i:i) /= t(l-i+1:l-i+1) ) return
end do
is_palindro = .true.
end function is_palindro
! non-recursive 2
function is_palindro2(t) result(isp)
logical :: isp
character(len=*), intent(in) :: t
character(len=len(t)) :: s
integer :: i
forall(i=1:len(t)) s(len(t)-i+1:len(t)-i+1) = t(i:i)
isp = ( s == t )
end function is_palindro2
Recursive
recursive function is_palindro_r (t) result (isp)
implicit none
character (*), intent (in) :: t
logical :: isp
isp = len (t) == 0 .or. t (: 1) == t (len (t) :) .and. is_palindro_r (t (2 : len (t) - 1))
end function is_palindro_r
end program palindro
FreeBASIC
' version 20-06-2015
' compile with: fbc -s console "filename".bas
#Ifndef TRUE ' define true and false for older freebasic versions
#Define FALSE 0
#Define TRUE Not FALSE
#EndIf
Function reverse(norm As String) As Integer
Dim As String rev
Dim As Integer i, l = Len(norm) -1
rev = norm
For i = 0 To l
rev[l-i] = norm[i]
Next
If norm = rev Then
Return TRUE
Else
Return FALSE
End If
End Function
Function cleanup(in As String, action As String = "") As String
' action = "" do nothing, [l|L] = convert to lowercase,
' [s|S] = strip spaces, [p|P] = strip punctuation.
If action = "" Then Return in
Dim As Integer i, p_, s_
Dim As String ch
action = LCase(action)
For i = 1 To Len(action)
ch = Mid(action, i, 1)
If ch = "l" Then in = LCase(in)
If ch = "p" Then
p_ = 1
ElseIf ch = "s" Then
s_ = 1
End If
Next
If p_ = 0 And s_ = 0 Then Return in
Dim As String unwanted, clean
If s_ = 1 Then unwanted = " "
If p_ = 1 Then unwanted = unwanted + "`~!@#$%^&*()-=_+[]{}\|;:',.<>/?"
For i = 1 To Len(in)
ch = Mid(in, i, 1)
If InStr(unwanted, ch) = 0 Then clean = clean + ch
Next
Return clean
End Function
' ------=< MAIN >=------
Dim As String test = "In girum imus nocte et consumimur igni"
'IIf ( cond, true, false ), true and false must be of the same type (num, string, UDT)
Print
Print " reverse(test) = "; IIf(reverse(test) = FALSE, "FALSE", "TRUE")
Print " reverse(cleanup(test,""l"")) = "; IIf(reverse(cleanup(test,"l")) = FALSE, "FALSE", "TRUE")
Print " reverse(cleanup(test,""ls"")) = "; IIf(reverse(cleanup(test,"ls")) = FALSE, "FALSE", "TRUE")
Print "reverse(cleanup(test,""PLS"")) = "; IIf(reverse(cleanup(test,"PLS")) = FALSE, "FALSE", "TRUE")
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print : Print "Hit any key to end program"
Sleep
End
- Output:
reverse(test) = FALSE reverse(cleanup(test,"l")) = FALSE reverse(cleanup(test,"ls")) = TRUE reverse(cleanup(test,"PLS")) = TRUE
Frink
This version will even work with upper-plane Unicode characters. Many languages will not work correctly with upper-plane Unicode characters because they are represented as Unicode "surrogate pairs" which are represented as two characters in a UTF-16 stream. In addition, Frink uses a grapheme-based reverse, which allows the algorithm below to operate on combined sequences of Unicode characters.
For example, the string "og\u0308o" represents an o, a g with combining diaeresis, followed by the letter o. Or, in other words, "og̈o". Note that while there are four Unicode codepoints, only three "graphemes" are displayed. Using Frink's smart "reverse" function preserves these combined graphemes and detects them correctly as palindromes.
isPalindrome[x] := x == reverse[x]
Test in Frink with upper-plane Unicode:
isPalindrome["x\u{1f638}x"]
true
FutureBasic
include "NSLog.incl"
local fn IsCleanStringPalindrome( testStr as CFStringRef ) as BOOL
NSUInteger i
BOOL result = NO
NSUInteger strLen = len(testStr)
for i = 0 to strLen / 2
if ( fn StringCharacterAtIndex( testStr, i ) != fn StringCharacterAtIndex( testStr, strLen -i -1 ) )
result = NO
exit fn
end if
next
result = YES
end fn = result
local fn IsDirtyStringPalindrome( dirtyStr as CFStringRef )
BOOL result = NO
CFStringRef tempStr
CFStringRef lowerCaseStr = fn StringLowercaseString( dirtyStr )
CFStringRef removeStr = @"!\"#$%&'()*+,-./:;<=>?@[]^_ {|}~"
NSUInteger i, count = len(removeStr)
tempStr = lowerCaseStr
for i = 0 to count -1
CFStringRef chrStr = fn StringWithFormat( @"%c", fn StringCharacterAtIndex( removeStr, i ) )
tempStr = fn StringByReplacingOccurrencesOfString( tempStr, chrStr, @"" )
next
result = fn IsCleanStringPalindrome( tempStr )
end fn = result
local fn PalindromeTest( testStr as CFStringRef )
BOOL result = NO
result = fn IsCleanStringPalindrome( testStr )
if ( result == YES )
NSLog( @"%17s : %@", fn StringUTF8String( @"Clean palindrome" ), testStr ) : exit fn
else
result = fn IsDirtyStringPalindrome( testStr )
if ( result == YES )
NSLog( @"%17s : %@", fn StringUTF8String( @"Dirty palindrome" ), testStr ) : exit fn
else
NSLog( @"%17s : %@", fn StringUTF8String( @"Not a palindrome" ), testStr )
end if
end if
end fn
fn PalindromeTest( @"racecar" )
fn PalindromeTest( @"level" )
fn PalindromeTest( @"rosetta" )
fn PalindromeTest( @"rotavator" )
fn PalindromeTest( @"13231+464+989=989+464+13231" )
fn PalindromeTest( @"Was it a car or a cat I saw?" )
fn PalindromeTest( @"Did Hannah see bees? Hannah did." )
fn PalindromeTest( @"This sentence is not a palindrome." )
fn PalindromeTest( @"123 456 789 897 654 321" )
fn PalindromeTest( @"123 456 789 987 654 321" )
fn PalindromeTest( @"Radar" )
fn PalindromeTest( @"abba" )
fn PalindromeTest( @"boom " )
fn PalindromeTest( @"radar" )
fn PalindromeTest( @"civic" )
fn PalindromeTest( @"great" )
fn PalindromeTest( @"Madam, I'm Adam." )
fn PalindromeTest( @"salàla" )
fn PalindromeTest( @"A man, a plan, a canal: Panama" )
fn PalindromeTest( @"a man a plan a canal panama" )
fn PalindromeTest( @"Egad, a base tone denotes a bad age" )
fn PalindromeTest( @"In girum imus nocte et consumimur igni" )
fn PalindromeTest( @"sees" )
fn PalindromeTest( @"solo" )
fn PalindromeTest( @"solos" )
HandleEvents
- Output:
Clean palindrome : racecar Clean palindrome : level Not a palindrome : rosetta Clean palindrome : rotavator Clean palindrome : 13231+464+989=989+464+13231 Dirty palindrome : Was it a car or a cat I saw? Dirty palindrome : Did Hannah see bees? Hannah did. Not a palindrome : This sentence is not a palindrome. Not a palindrome : 123 456 789 897 654 321 Clean palindrome : 123 456 789 987 654 321 Dirty palindrome : Radar Clean palindrome : abba Not a palindrome : boom Clean palindrome : radar Clean palindrome : civic Not a palindrome : great Dirty palindrome : Madam, I'm Adam. Not a palindrome : salàla Dirty palindrome : A man, a plan, a canal: Panama Dirty palindrome : a man a plan a canal panama Dirty palindrome : Egad, a base tone denotes a bad age Dirty palindrome : In girum imus nocte et consumimur igni Clean palindrome : sees Not a palindrome : solo Clean palindrome : solos
Fōrmulæ
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.
Programs in Fōrmulæ are created/edited online in its website.
In this page you can see and run the program(s) related to this task and their results. You can also change either the programs or the parameters they are called with, for experimentation, but remember that these programs were created with the main purpose of showing a clear solution of the task, and they generally lack any kind of validation.
Solution
Test cases
GAP
ZapGremlins := function(s)
local upper, lower, c, i, n, t;
upper := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
lower := "abcdefghijklmnopqrstuvwxyz";
t := [ ];
i := 1;
for c in s do
n := Position(upper, c);
if n <> fail then
t[i] := lower[n];
i := i + 1;
else
n := Position(lower, c);
if n <> fail then
t[i] := c;
i := i + 1;
fi;
fi;
od;
return t;
end;
IsPalindrome := function(s)
local t;
t := ZapGremlins(s);
return t = Reversed(t);
end;
GML
//Setting a var from an argument passed to the script
var str;
str = argument0
//Takes out all spaces/anything that is not a letter or a number and turns uppercase letters to lowercase
str = string_lettersdigits(string_lower(string_replace(str,' ','')));
var inv;
inv = '';
//for loop that reverses the sequence
var i;
for (i = 0; i < string_length(str); i += 1;)
{
inv += string_copy(str,string_length(str)-i,1);
}
//returns true if the sequence is a palindrome else returns false
return (str == inv);
Palindrome detection using a Downward For-Loop
//Remove everything except for letters and digits and convert the string to lowercase. source is what will be compared to str.
var str = string_lower(string_lettersdigits(string_replace(argument0," ",""))), source = "";
//Loop through and store each character of str in source.
for (var i = string_length(str); i > 0; i--) {
source += string_char_at(str,i);
}
//Return if it is a palindrome.
return source == str;
Go
package pal
func IsPal(s string) bool {
mid := len(s) / 2
last := len(s) - 1
for i := 0; i < mid; i++ {
if s[i] != s[last-i] {
return false
}
}
return true
}
This version works with Unicode,
func isPalindrome(s string) bool {
runes := []rune(s)
numRunes := len(runes) - 1
for i := 0; i < len(runes)/2; i++ {
if runes[i] != runes[numRunes-i] {
return false
}
}
return true
}
Or using more slicing,
func isPalindrome(s string) bool {
runes := []rune(s)
for len(runes) > 1 {
if runes[0] != runes[len(runes)-1] {
return false
}
runes = runes[1 : len(runes)-1]
}
return true
}
GolfScript
Recursive
{.,1>{(\)@={pal}0if}1if\;}:pal;
Test program:
"ABBA" pal
"a" pal
"13231+464+989=989+464+13231" pal
"123 456 789 897 654 321" pal
- Output:
1 1 1 0
Groovy
Trivial
Solution:
def isPalindrome = { String s ->
s == s?.reverse()
}
Test program:
println isPalindrome("")
println isPalindrome("a")
println isPalindrome("abcdefgfedcba")
println isPalindrome("abcdeffedcba")
println isPalindrome("abcedfgfedcb")
- Output:
true true true true false
This solution assumes nulls are palindromes.
Non-recursive
Solution:
def isPalindrome = { String s ->
def n = s.size()
n < 2 || s[0..<n/2] == s[-1..(-n/2)]
}
Test program and output are the same. This solution does not handle nulls.
Recursive
Solution follows the C palindrome_r recursive solution:
def isPalindrome
isPalindrome = { String s ->
def n = s.size()
n < 2 || (s[0] == s[n-1] && isPalindrome(s[1..<(n-1)]))
}
Test program and output are the same. This solution does not handle nulls.
Haskell
Non-recursive
A string is a palindrome if reversing it we obtain the same string.
is_palindrome x = x == reverse x
Or, applicative and point-free, with some pre-processing of data (shedding white space and upper case):
import Data.Bifunctor (second)
import Data.Char (toLower)
------------------- PALINDROME DETECTION -----------------
isPalindrome :: Eq a => [a] -> Bool
isPalindrome = (==) <*> reverse
-- Or, comparing just the leftward characters with
-- with a reflection of just the rightward characters.
isPal :: String -> Bool
isPal s =
let (q, r) = quotRem (length s) 2
in uncurry (==) $
second (reverse . drop r) $ splitAt q s
--------------------------- TEST -------------------------
main :: IO ()
main =
mapM_ putStrLn $
(showResult <$> [isPalindrome, isPal])
<*> fmap
prepared
[ "",
"a",
"ab",
"aba",
"abba",
"In girum imus nocte et consumimur igni"
]
prepared :: String -> String
prepared cs = [toLower c | c <- cs, ' ' /= c]
showResult f s = (show s) <> " -> " <> show (f s)
- Output:
"" -> True "a" -> True "ab" -> False "aba" -> True "abba" -> True "ingirumimusnocteetconsumimurigni" -> True "" -> True "a" -> True "ab" -> False "aba" -> True "abba" -> True "ingirumimusnocteetconsumimurigni" -> True
Recursive
See the C palindrome_r code for an explanation of the concept used in this solution, though it may be better suited to indexed arrays than to linked lists.
(last is expensive, and entails multiplied recursions over the right hand side of the remaining list here).
is_palindrome_r x | length x <= 1 = True
| head x == last x = is_palindrome_r . tail. init $ x
| otherwise = False
HicEst
result = Palindrome( "In girum imus nocte et consumimur igni" ) ! returns 1
END
FUNCTION Palindrome(string)
CHARACTER string, CopyOfString
L = LEN(string)
ALLOCATE(CopyOfString, L)
CopyOfString = string
EDIT(Text=CopyOfString, UpperCase=L)
L = L - EDIT(Text=CopyOfString, End, Left=' ', Delete, DO=L) ! EDIT returns number of deleted spaces
DO i = 1, L/2
Palindrome = CopyOfString(i) == CopyOfString(L - i + 1)
IF( Palindrome == 0 ) RETURN
ENDDO
END
Icon and Unicon
The following simple procedure uses the built-in reverse. Reverse creates a transient string which will get garbage collected.
Note: The IPL procedure strings contains a palindrome tester called ispal that uses reverse and is equivalent to the version of palindrome above.
This version uses positive and negative sub-scripting and works not only on strings but lists of strings, such as ["ab","ab"] or ["ab","x"] the first list would pass the test but the second wouldn't.
Insitux
This function works also for vectors.
(var palindrome? (= (reverse %)))
(palindrome? "deified") ;returns true
Space and punctuation insensitive version:
(var palindrome? (comp (filter letter?) lower-case (= (reverse %))))
(palindrome? "In girum imus nocte et consumimur igni.") ;returns true
Ioke
Text isPalindrome? = method(self chars == self chars reverse)
J
Non-recursive
Reverse and match method
isPalin0=: -: |.
Example usage
isPalin0 'ABBA'
1
isPalin0 -.&' ' tolower 'In girum imus nocte et consumimur igni'
1
Recursive
Tacit and explicit verbs:
isPalin1=: 0:`($:@(}.@}:))@.({.={:)`1:@.(1>:#)
isPalin2=: monad define
if. 1>:#y do. 1 return. end.
if. ({.={:)y do. isPalin2 }.}:y else. 0 end.
)
Note that while these recursive verbs are bulkier and more complicated, they are also several thousand times more inefficient than isPalin0.
foo=: foo,|.foo=:2000$a.
ts=:6!:2,7!:2 NB. time and space required to execute sentence
ts 'isPalin0 foo'
2.73778e_5 5184
ts 'isPalin1 foo'
0.0306667 6.0368e6
ts 'isPalin2 foo'
0.104391 1.37965e7
'isPalin1 foo' %&ts 'isPalin0 foo'
1599.09 1164.23
'isPalin2 foo' %&ts 'isPalin0 foo'
3967.53 2627.04
Jakt
fn is_palindrome(anon string: String) throws -> bool {
mut points: [u32] = []
for point in string.code_points() {
points.push(point)
}
mut i: usize = 0
while i < points.size() / 2 {
if points[i] != points[points.size() - 1 - i] {
return false
}
i++
}
return true
}
fn main() {
println("{}", is_palindrome("amanaplanacanalpanama"))
println("{}", is_palindrome("madamimadam"))
println("{}", is_palindrome("madamimddam"))
println("{}", is_palindrome("私は私"))
}
Java
Non-Recursive
public static boolean pali(String testMe){
StringBuilder sb = new StringBuilder(testMe);
return testMe.equals(sb.reverse().toString());
}
Non-Recursive using indexes (supports upper-plane Unicode)
public static boolean isPalindrome(String input) {
for (int i = 0, j = input.length() - 1; i < j; i++, j--) {
char startChar = input.charAt(i);
char endChar = input.charAt(j);
// Handle surrogate pairs in UTF-16
if (Character.isLowSurrogate(endChar)) {
if (startChar != input.charAt(--j)) {
return false;
}
if (input.charAt(++i) != endChar) {
return false;
}
} else if (startChar != endChar) {
return false;
}
}
return true;
}
Recursive (this version does not work correctly with upper-plane Unicode)
public static boolean rPali(String testMe){
if(testMe.length()<=1){
return true;
}
if(!(testMe.charAt(0)+"").equals(testMe.charAt(testMe.length()-1)+"")){
return false;
}
return rPali(testMe.substring(1, testMe.length()-1));
}
Recursive using indexes (this version does not work correctly with upper-plane Unicode)
public static boolean rPali(String testMe){
int strLen = testMe.length();
return rPaliHelp(testMe, strLen-1, strLen/2, 0);
}
public static boolean rPaliHelp(String testMe, int strLen, int testLen, int index){
if(index > testLen){
return true;
}
if(testMe.charAt(index) != testMe.charAt(strLen-index)){
return false;
}
return rPaliHelp(testMe, strLen, testLen, index + 1);
}
Regular Expression (source)
public static boolean pali(String testMe){
return testMe.matches("|(?:(.)(?<=(?=^.*?(\\1\\2?)$).*))+(?<=(?=^\\2$).*)");
}
JavaScript
function isPalindrome(str) {
return str === str.split("").reverse().join("");
}
console.log(isPalindrome("ingirumimusnocteetconsumimurigni"));
ES6 implementation
var isPal = str => str === str.split("").reverse().join("");
Or, ignoring spaces and variations in case:
(() => {
// isPalindrome :: String -> Bool
const isPalindrome = s => {
const cs = filter(c => ' ' !== c, s.toLocaleLowerCase());
return cs.join('') === reverse(cs).join('');
};
// TEST -----------------------------------------------
const main = () =>
isPalindrome(
'In girum imus nocte et consumimur igni'
)
// GENERIC FUNCTIONS ----------------------------------
// filter :: (a -> Bool) -> [a] -> [a]
const filter = (f, xs) => (
'string' !== typeof xs ? (
xs
) : xs.split('')
).filter(f);
// reverse :: [a] -> [a]
const reverse = xs =>
'string' !== typeof xs ? (
xs.slice(0).reverse()
) : xs.split('').reverse().join('');
// MAIN ---
return main();
})();
- Output:
true
jq
The definitional implementation would probably be fine except for very long strings:
def palindrome: explode | reverse == .;
So here is an implementation with a view to efficiency:
def isPalindrome:
length as $n
| explode as $in
| first(range(0; $n/2)
| select($in[.] != $in[$n - 1 - .]) )
// false
| not;
Example:
"salàlas" | palindrome
- Output:
true
Jsish
/* Palindrome detection, in Jsish */
function isPalindrome(str:string, exact:boolean=true) {
if (!exact) {
str = str.toLowerCase();
str = str.replace(/[ \t,;:!?.]/g, '');
}
return str === str.match(/./g).reverse().join('');
}
;isPalindrome('BUB');
;isPalindrome('CUB');
;isPalindrome('Bub');
;isPalindrome('Bub', false);
;isPalindrome('In girum imus nocte et consumimur igni', false);
;isPalindrome('A man, a plan, a canal; Panama!', false);
;isPalindrome('Never odd or even', false);
/*
=!EXPECTSTART!=
isPalindrome('BUB') ==> true
isPalindrome('CUB') ==> false
isPalindrome('Bub') ==> false
isPalindrome('Bub', false) ==> true
isPalindrome('In girum imus nocte et consumimur igni', false) ==> true
isPalindrome('A man, a plan, a canal; Panama!', false) ==> true
isPalindrome('Never odd or even', false) ==> true
=!EXPECTEND!=
*/
Most of that code is for testing, using echo mode lines (semicolon in column 1)
- Output:
prompt$ jsish --U palindrome.jsi isPalindrome('BUB') ==> true isPalindrome('CUB') ==> false isPalindrome('Bub') ==> false isPalindrome('Bub', false) ==> true isPalindrome('In girum imus nocte et consumimur igni', false) ==> true isPalindrome('A man, a plan, a canal; Panama!', false) ==> true isPalindrome('Never odd or even', false) ==> true prompt$ jsish -u palindrome.jsi [PASS] palindrome.jsi
Julia
palindrome(s) = s == reverse(s)
Non-Recursive
function palindrome(s)
len = length(s)
for i = 1:(len/2)
if(s[len-i+1]!=s[i])
return false
end
end
return true
end
Recursive
function palindrome(s)
len = length(s)
if(len==0 || len==1)
return true
end
if(s[1] == s[len])
return palindrome(SubString(s,2,len-1))
end
return false
end
k
is_palindrome:{x~|x}
Kotlin
// version 1.1.2
/* These functions deal automatically with Unicode as all strings are UTF-16 encoded in Kotlin */
fun isExactPalindrome(s: String) = (s == s.reversed())
fun isInexactPalindrome(s: String): Boolean {
var t = ""
for (c in s) if (c.isLetterOrDigit()) t += c
t = t.toLowerCase()
return t == t.reversed()
}
fun main(args: Array<String>) {
val candidates = arrayOf("rotor", "rosetta", "step on no pets", "été")
for (candidate in candidates) {
println("'$candidate' is ${if (isExactPalindrome(candidate)) "an" else "not an"} exact palindrome")
}
println()
val candidates2 = arrayOf(
"In girum imus nocte et consumimur igni",
"Rise to vote, sir",
"A man, a plan, a canal - Panama!",
"Ce repère, Perec" // note: 'è' considered a distinct character from 'e'
)
for (candidate in candidates2) {
println("'$candidate' is ${if (isInexactPalindrome(candidate)) "an" else "not an"} inexact palindrome")
}
}
- Output:
'rotor' is an exact palindrome 'rosetta' is not an exact palindrome 'step on no pets' is an exact palindrome 'été' is an exact palindrome 'In girum imus nocte et consumimur igni' is an inexact palindrome 'Rise to vote, sir' is an inexact palindrome 'A man, a plan, a canal - Panama!' is an inexact palindrome 'Ce repère, Perec' is not an inexact palindrome
LabVIEW
This image is a VI Snippet, an executable image of LabVIEW code. The LabVIEW version is shown on the top-right hand corner. You can download it, then drag-and-drop it onto the LabVIEW block diagram from a file browser, and it will appear as runnable, editable code.
langur
val ispal = fn s:len(s) > 0 and s == reverse(s)
val tests = {
"": false,
"z": true,
"aha": true,
"αηα": true,
"αννα": true,
"αννασ": false,
"sees": true,
"seas": false,
"deified": true,
"solo": false,
"solos": true,
"amanaplanacanalpanama": true,
"a man a plan a canal panama": false, # true if we remove spaces
"ingirumimusnocteetconsumimurigni": true,
}
for word in sort(keys(tests)) {
val foundpal = ispal(word)
writeln word, ": ", foundpal, if(foundpal == tests[word]: ""; " (FAILED TEST)")
}
- Output:
: false a man a plan a canal panama: false aha: true amanaplanacanalpanama: true deified: true ingirumimusnocteetconsumimurigni: true seas: false sees: true solo: false solos: true z: true αηα: true αννα: true αννασ: false
Lasso
define ispalindrome(text::string) => {
local(_text = string(#text)) // need to make copy to get rid of reference issues
#_text -> replace(regexp(`(?:$|\W)+`), -ignorecase)
local(reversed = string(#_text))
#reversed -> reverse
return #_text == #reversed
}
ispalindrome('Tätatät') // works with high ascii
ispalindrome('Hello World')
ispalindrome('A man, a plan, a canoe, pasta, heros, rajahs, a coloratura, maps, snipe, percale, macaroni, a gag, a banana bag, a tan, a tag, a banana bag again (or a camel), a crepe, pins, Spam, a rut, a Rolo, cash, a jar, sore hats, a peon, a canal – Panama!')
- Output:
true false true
Liberty BASIC
print isPalindrome("In girum imus nocte et consumimur igni")
print isPalindrome(removePunctuation$("In girum imus nocte et consumimur igni", "S"))
print isPalindrome(removePunctuation$("In girum imus nocte et consumimur igni", "SC"))
function isPalindrome(string$)
isPalindrome = 1
for i = 1 to int(len(string$)/2)
if mid$(string$, i, 1) <> mid$(string$, len(string$)-i+1, 1) then isPalindrome = 0 : exit function
next i
end function
function removePunctuation$(string$, remove$)
'P = remove puctuation. S = remove spaces C = remove case
If instr(upper$(remove$), "C") then string$ = lower$(string$)
If instr(upper$(remove$), "P") then removeCharacters$ = ",.!'()-&*?<>:;~[]{}"
If instr(upper$(remove$), "S") then removeCharacters$ = removeCharacters$;" "
for i = 1 to len(string$)
if instr(removeCharacters$, mid$(string$, i, 1)) then string$ = left$(string$, i-1);right$(string$, len(string$)-i) : i = i - 1
next i
removePunctuation$ = string$
end function
- Output:
0 0 1
LiveCode
This implementation defaults to exact match, but has an optional parameter to do inexact.
function palindrome txt exact
if exact is empty or exact is not false then
set caseSensitive to true --default is false
else
replace space with empty in txt
put lower(txt) into txt
end if
return txt is reverse(txt)
end palindrome
function reverse str
repeat with i = the length of str down to 1
put byte i of str after revstr
end repeat
return revstr
end reverse
Logo
to palindrome? :w
output equal? :w reverse :w
end
Lua
function ispalindrome(s) return s == string.reverse(s) end
M4
Non-recursive
This uses the invert
from Reversing a string.
define(`palindrorev',`ifelse(`$1',invert(`$1'),`yes',`no')')dnl
palindrorev(`ingirumimusnocteetconsumimurigni')
palindrorev(`this is not palindrome')
Recursive
define(`striptwo',`substr(`$1',1,eval(len(`$1')-2))')dnl
define(`cmplast',`ifelse(`striptwo(`$1')',,`yes',dnl
substr(`$1',0,1),substr(`$1',eval(len(`$1')-1),1),`yes',`no')')dnl
define(`palindro',`dnl
ifelse(eval(len(`$1')<1),1,`yes',cmplast(`$1'),`yes',`palindro(striptwo(`$1'))',`no')')dnl
palindro(`ingirumimusnocteetconsumimurigni')
palindro(`this is not palindrome')
MACRO-11
.TITLE PALIN
.MCALL .GTLIN,.PRINT,.EXIT
PALIN:: .GTLIN #INBUF ; READ INPUT
MOV #INBUF,R0
TSTB (R0) ; END OF INPUT?
BEQ 3$
JSR PC,EPALIN ; CHECK (EXACT) PALINDROME
BNE 1$
.PRINT #4$
BR PALIN
1$: MOV #INBUF,R0 ; CHECK INEXACT PALINDROME
JSR PC,IPALIN
BNE 2$
.PRINT #5$
BR PALIN
2$: .PRINT #6$ ; NOT A PALINDROME AT ALL
BR PALIN
3$: .EXIT
4$: .ASCIZ /EXACT PALINDROME/
5$: .ASCIZ /INEXACT PALINDROME/
6$: .ASCIZ /NOT A PALINDROME/
.EVEN
; IS STRING AT R0 AN EXACT PALINDROME?
; ZERO FLAG SET IF TRUE
EPALIN: MOV R0,R1
1$: TSTB (R1)+ ; FIND END OF STRING
BNE 1$
DEC R1
2$: CMPB (R0)+,-(R1) ; SCAN BACKWARDS AND FORWARDS
BNE 4$ ; NOT PALINDROME?
CMP R0,R1 ; DONE YET?
BLT 2$
3$: CLR R1
4$: RTS PC
; IS STRING AT R0 AN INEXACT PALINDROME?
IPALIN: MOV #3$,R1 ; COPY TO BUFFER
BR 2$
1$: BICB #40,R2 ; MAKE UPPERCASE IF LETTER
CMPB R2,#101 ; < A = DISREGARD
BLT 2$
CMPB R2,#132 ; > Z = DISREGARD
BGT 2$
MOVB R2,(R1)+ ; STORE IN BUFFER
2$: MOVB (R0)+,R2 ; GET CHARACTER
BNE 1$ ; END?
CLRB (R1) ; ZERO TERMINATE BUFFER
MOV #3$,R0 ; NOW SEE IF RESULT IS EXACT PALINDROME
BR EPALIN
3$: .BLKB 200 ; BUFFER
INBUF: .BLKB 200
.END PALIN
- Output:
.palin racecar EXACT PALINDROME .palin raceCAR INEXACT PALINDROME .palin rosetta NOT A PALINDROME
Maple
This uses functions from Maple's built-in StringTools
package.
with(StringTools):
IsPalindrome("ingirumimusnocteetconsumimurigni");
IsPalindrome("In girum imus nocte et consumimur igni");
IsPalindrome(LowerCase(DeleteSpace("In girum imus nocte et consumimur igni")));
- Output:
true false true
Mathematica/Wolfram Language
Built-in function handling lists, numbers, and strings:
PalindromeQ
- Examples:
PalindromeQ["TNT"] PalindromeQ["test"] PalindromeQ["deified"] PalindromeQ["salálas"] PalindromeQ["ingirumimusnocteetconsumimurigni"]
- Output:
True False True True True
MATLAB
function trueFalse = isPalindrome(string)
trueFalse = all(string == fliplr(string)); %See if flipping the string produces the original string
if not(trueFalse) %If not a palindrome
string = lower(string); %Lower case everything
trueFalse = all(string == fliplr(string)); %Test again
end
if not(trueFalse) %If still not a palindrome
string(isspace(string)) = []; %Strip all space characters out
trueFalse = all(string == fliplr(string)); %Test one last time
end
end
- Sample Usage:
>> isPalindrome('In girum imus nocte et consumimur igni')
ans =
1
Maxima
palindromep(s) := block([t], t: sremove(" ", sdowncase(s)), sequal(t, sreverse(t)))$
palindromep("Sator arepo tenet opera rotas"); /* true */
MAXScript
Non-recursive
fn isPalindrome s =
(
local reversed = ""
for i in s.count to 1 by -1 do reversed += s[i]
return reversed == s
)
Recursive
fn isPalindrome_r s =
(
if s.count <= 1 then
(
true
)
else
(
if s[1] != s[s.count] then
(
return false
)
isPalindrome_r (substring s 2 (s.count-2))
)
)
Testing
local p = "ingirumimusnocteetconsumimurigni"
format ("'%' is a palindrome? %\n") p (isPalindrome p)
format ("'%' is a palindrome? %\n") p (isPalindrome_r p)
min
(dup reverse ==) :palindrome?
(dup "" split reverse "" join ==) :str-palindrome?
"apple" str-palindrome? puts
"racecar" str-palindrome? puts
(a b c) palindrome? puts
(a b b a) palindrome? puts
- Output:
false true false true
MiniScript
isPalindrome = function(s)
// convert to lowercase, and strip non-letters
stripped = ""
for c in s.lower
if c >= "a" and c <= "z" then stripped = stripped + c
end for
// check palindromity
mid = floor(stripped.len/2)
for i in range(0, mid)
if stripped[i] != stripped[-i - 1] then return false
end for
return true
end function
testStr = "Madam, I'm Adam"
answer = [testStr, "is"]
if not isPalindrome(testStr) then answer.push "NOT"
answer.push "a palindrome"
print answer.join
- Output:
Madam, I'm Adam is a palindrome
Mirah
def reverse(s:string)
StringBuilder.new(s).reverse.toString()
end
def palindrome?(s:string)
s.equals(reverse(s))
end
puts palindrome?("anna") # ==> true
puts palindrome?("Erik") # ==> false
puts palindrome?("palindroom-moordnilap") # ==> true
puts nil # ==> null
ML
mLite
fun to_locase s = implode ` map (c_downcase) ` explode s
fun only_alpha s = implode ` filter (fn x = c_alphabetic x) ` explode s
fun is_palin
( h1 :: t1, h2 :: t2, n = 0 ) = true
| ( h1 :: t1, h2 :: t2, n ) where ( h1 eql h2 ) = is_palin( t1, t2, n - 1)
| ( h1 :: t1, h2 :: t2, n ) = false
| (str s) =
let
val es = explode ` to_locase ` only_alpha s;
val res = rev es;
val k = (len es) div 2
in
is_palin (es, res, k)
end
fun test_is_palin s =
(print "\""; print s; print "\" is a palindrome: "; print ` is_palin s; println "")
fun test (f, arg, res, ok, notok) = if (f arg eql res) then ("'" @ arg @ "' " @ ok) else ("'" @ arg @ "' " @ notok)
;
println ` test (is_palin, "In girum imus nocte, et consumimur igni", true, "is a palindrome", "is NOT a palindrome");
println ` test (is_palin, "Madam, I'm Adam.", true, "is a palindrome", "is NOT a palindrome");
println ` test (is_palin, "salàlas", true, "is a palindrome", "is NOT a palindrome");
println ` test (is_palin, "radar", true, "is a palindrome", "is NOT a palindrome");
println ` test (is_palin, "Lagerregal", true, "is a palindrome", "is NOT a palindrome");
println ` test (is_palin, "Ein Neger mit Gazelle zagt im Regen nie.", true, "is a palindrome", "is NOT a palindrome");
println ` test (is_palin, "something wrong", true, "is a palindrome", "is NOT a palindrome");
Output:
'In girum imus nocte, et consumimur igni' is a palindrome 'Madam, I'm Adam.' is a palindrome 'salàlas' is a palindrome 'radar' is a palindrome 'Lagerregal' is a palindrome 'Ein Neger mit Gazelle zagt im Regen nie.' is a palindrome 'something wrong' is NOT a palindrome
Standard ML
fun palindrome s =
let val cs = explode s in
cs = rev cs
end
MMIX
argc IS $0
argv IS $1
LOC Data_Segment
DataSeg GREG @
LOC @+1000
ItsPalStr IS @-Data_Segment
BYTE "It's palindrome",10,0
LOC @+(8-@)&7
NoPalStr IS @-Data_Segment
BYTE "It is not palindrome",10,0
LOC #100
GREG @
% input: $255 points to where the string to be checked is
% returns $255 0 if not palindrome, not zero otherwise
% trashs: $0,$1,$2,$3
% return address $4
DetectPalindrome LOC @
ADDU $1,$255,0 % $1 = $255
2H LDB $0,$1,0 % get byte at $1
BZ $0,1F % if zero, end (length)
INCL $1,1 % $1++
JMP 2B % loop
1H SUBU $1,$1,1 % ptr last char of string
ADDU $0,DataSeg,0 % $0 to data seg.
3H CMP $3,$1,$255 % is $0 == $255?
BZ $3,4F % then jump
LDB $3,$1,0 % otherwise get the byte
STB $3,$0,0 % and copy it
INCL $0,1 % $0++
SUB $1,$1,1 % $1--
JMP 3B
4H LDB $3,$1,0
STB $3,$0,0 % copy the last byte
% now let us compare reversed string and straight string
XOR $0,$0,$0 % index
ADDU $1,DataSeg,0
6H LDB $2,$1,$0 % pick char from rev str
LDB $3,$255,$0 % pick char from straight str
BZ $3,PaliOk % finished as palindrome
CMP $2,$2,$3 % == ?
BNZ $2,5F % if not, exit
INCL $0,1 % $0++
JMP 6B
5H XOR $255,$255,$255
GO $4,$4,0 % return false
PaliOk NEG $255,0,1
GO $4,$4,0 % return true
% The Main for testing the function
% run from the command line
% $ mmix ./palindrome.mmo ingirumimusnocteetconsumimurigni
Main CMP argc,argc,2 % argc > 2?
BN argc,3F % no -> not enough arg
ADDU $1,$1,8 % argv+1
LDOU $255,$1,0 % argv[1]
GO $4,DetectPalindrome
BZ $255,2F % if not palindrome, jmp
SETL $0,ItsPalStr % pal string
ADDU $255,DataSeg,$0
JMP 1F
2H SETL $0,NoPalStr % no pal string
ADDU $255,DataSeg,$0
1H TRAP 0,Fputs,StdOut % print
3H XOR $255,$255,$255
TRAP 0,Halt,0 % exit(0)
Modula-2
MODULE Palindrome;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,ReadChar;
PROCEDURE IsPalindrome(str : ARRAY OF CHAR) : BOOLEAN;
VAR i,m : INTEGER;
VAR buf : ARRAY[0..63] OF CHAR;
BEGIN
i := 0;
m := HIGH(str) - 1;
WHILE i<m DO
IF str[i] # str[m-i] THEN
RETURN FALSE
END;
INC(i)
END;
RETURN TRUE
END IsPalindrome;
PROCEDURE Print(str : ARRAY OF CHAR);
VAR buf : ARRAY[0..63] OF CHAR;
BEGIN
FormatString("%s: %b\n", buf, str, IsPalindrome(str));
WriteString(buf)
END Print;
BEGIN
Print("");
Print("z");
Print("aha");
Print("sees");
Print("oofoe");
Print("deified");
Print("Deified");
Print("amanaplanacanalpanama");
Print("ingirumimusnocteetconsumimurigni");
ReadChar
END Palindrome.
Modula-3
MODULE Palindrome;
IMPORT Text;
PROCEDURE isPalindrome(string: TEXT): BOOLEAN =
VAR len := Text.Length(string);
BEGIN
FOR i := 0 TO len DIV 2 - 1 DO
IF Text.GetChar(string, i) # Text.GetChar(string, (len - i - 1)) THEN
RETURN FALSE;
END;
END;
RETURN TRUE;
END isPalindrome;
END Palindrome.
Nanoquery
def is_palindrome(s)
temp = ""
for char in s
if "abcdefghikjklmnopqrstuvwxyz" .contains. lower(char)
temp += lower(char)
end
end
return list(temp) = list(temp).reverse()
end
Nemerle
using System;
using System.Console;
using Nemerle.Utility.NString; //contains methods Explode() and Implode() which convert string -> list[char] and back
module Palindrome
{
IsPalindrome( text : string) : bool
{
Implode(Explode(text).Reverse()) == text;
}
Main() : void
{
WriteLine("radar is a palindrome: {0}", IsPalindrome("radar"));
}
}
And a function to remove spaces and punctuation and convert to lowercase
Clean( text : string ) : string
{
def sepchars = Explode(",.;:-?!()' ");
Concat( "", Split(text, sepchars)).ToLower()
}
NetRexx
y='In girum imus nocte et consumimur igni'
-- translation: We walk around in the night and
-- we are burnt by the fire (of love)
say
say 'string = 'y
say
pal=isPal(y)
if pal==0 then say "The string isn't palindromic."
else say 'The string is palindromic.'
method isPal(x) static
x=x.upper().space(0) /* removes all blanks (spaces) */
/* and translate to uppercase. */
return x==x.reverse() /* returns 1 if exactly equal */
NewLISP
Works likewise for strings and for lists
(define (palindrome? s)
(setq r s)
(reverse r) ; Reverse is destructive.
(= s r))
;; Make ‘reverse’ non-destructive and avoid a global variable
(define (palindrome? s)
(= s (reverse (copy s))))
Nim
The following program detects if UTF-8 strings are exact palindromes. If "exact" is set to "false", it ignores the white spaces and the differences of letter case to detect inexact palindromes. Differences in punctuation are still relevant.
import unicode
func isPalindrome(rseq: seq[Rune]): bool =
## Return true if a sequence of runes is a palindrome.
for i in 1..(rseq.len shr 1):
if rseq[i - 1] != rseq[^i]:
return false
result = true
func isPalindrome(str: string; exact = true): bool {.inline.} =
## Return true if a UTF-8 string is a palindrome.
## If "exact" is false, ignore white spaces and ignore case.
if exact:
result = str.toRunes.isPalindrome()
else:
var rseq: seq[Rune]
for rune in str.runes:
if not rune.isWhiteSpace:
rseq.add rune.toLower
result = rseq.isPalindrome()
when isMainModule:
proc check(s: string) =
var exact, inexact: bool
exact = s.isPalindrome()
if not exact:
inexact = s.isPalindrome(exact = false)
let txt = if exact: " is an exact palindrome."
elif inexact: " is an inexact palindrome."
else: " is not a palindrome."
echo '"', s, '"', txt
check "rotor"
check "été"
check "αννα"
check "salà las"
check "In girum imus nocte et consumimur igni"
check "Esope reste ici et se repose"
check "This is a palindrom"
- Output:
"rotor" is an exact palindrome. "été" is an exact palindrome. "αννα" is an exact palindrome. "salà las" is an inexact palindrome. "In girum imus nocte et consumimur igni" is an inexact palindrome. "Esope reste ici et se repose" is an inexact palindrome. "This is a palindrom" is not a palindrome.
Objeck
bundle Default {
class Test {
function : Main(args : String[]) ~ Nil {
IsPalindrome("aasa")->PrintLine();
IsPalindrome("acbca")->PrintLine();
IsPalindrome("xx")->PrintLine();
}
function : native : IsPalindrome(s : String) ~ Bool {
l := s->Size();
for(i := 0; i < l / 2; i += 1;) {
if(s->Get(i) <> s->Get(l - i - 1)) {
return false;
};
};
return true;
}
}
}
OCaml
let is_palindrome s =
let l = String.length s in
let rec comp n =
n = 0 || (s.[l-n] = s.[n-1] && comp (n-1)) in
comp (l / 2)
and here a function to remove the white spaces in the string:
let rem_space str =
let len = String.length str in
let res = Bytes.create len in
let rec aux i j =
if i >= len
then (Bytes.sub_string res 0 j)
else match str.[i] with
| ' ' | '\n' | '\t' | '\r' ->
aux (i+1) (j)
| _ ->
Bytes.set res j str.[i];
aux (i+1) (j+1)
in
aux 0 0
and to make the test case insensitive, just use the function String.lowercase_ascii.
Octave
Recursive
function v = palindro_r(s)
if ( length(s) == 1 )
v = true;
return;
elseif ( length(s) == 2 )
v = s(1) == s(2);
return;
endif
if ( s(1) == s(length(s)) )
v = palindro_r(s(2:length(s)-1));
else
v = false;
endif
endfunction
Non-recursive
function v = palindro(s)
v = all( (s == s(length(s):-1:1)) == 1);
endfunction
Testing
palindro_r("ingirumimusnocteetconsumimurigni")
palindro("satorarepotenetoperarotas")
Oforth
String method: isPalindrome self reverse self == ;
Ol
; simple case - only lowercase letters
(define (palindrome? str)
(let ((l (string->runes str)))
(equal? l (reverse l))))
(print (palindrome? "ingirumimusnocteetconsumimurigni"))
; ==> #true
(print (palindrome? "thisisnotapalindrome"))
; ==> #false
; complex case - with ignoring letter case and punctuation
(define (alpha? x)
(<= #\a x #\z))
(define (lowercase x)
(if (<= #\A x #\Z)
(- x (- #\A #\a))
x))
(define (palindrome? str)
(let ((l (filter alpha? (map lowercase (string->runes str)))))
(equal? l (reverse l))))
(print (palindrome? "A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal-Panama!"))
; ==> #true
(print (palindrome? "This is not a palindrome"))
; ==> #false
Oz
fun {IsPalindrome S}
{Reverse S} == S
end
PARI/GP
ispal(s)={
s=Vec(s);
for(i=1,#v\2,
if(v[i]!=v[#v-i+1],return(0))
);
1
};
A version for numbers:
ispal(s)={
my(d=digits(n));
for(i=1,#d\2,
if(d[i]!=d[n+1=i],return(0))
);
1
};
Pascal
program Palindro;
{ RECURSIVE }
function is_palindro_r(s : String) : Boolean;
begin
if length(s) <= 1 then
is_palindro_r := true
else begin
if s[1] = s[length(s)] then
is_palindro_r := is_palindro_r(copy(s, 2, length(s)-2))
else
is_palindro_r := false
end
end; { is_palindro_r }
{ NON RECURSIVE; see [[Reversing a string]] for "reverse" }
function is_palindro(s : String) : Boolean;
begin
if s = reverse(s) then
is_palindro := true
else
is_palindro := false
end;
procedure test_r(s : String; r : Boolean);
begin
write('"', s, '" is ');
if ( not r ) then
write('not ');
writeln('palindrome')
end;
var
s1, s2 : String;
begin
s1 := 'ingirumimusnocteetconsumimurigni';
s2 := 'in girum imus nocte';
test_r(s1, is_palindro_r(s1));
test_r(s2, is_palindro_r(s2));
test_r(s1, is_palindro(s1));
test_r(s2, is_palindro(s2))
end.
program PalindromeDetection;
var
input, output: string;
s: char; i: integer;
begin
writeln('write down your input:');
readln(input);
output:='';
for i:=1 to length(input) do
begin
s:=input[i];
output:=s+output;
end;
writeln('');
if(input=output)then
writeln('input was palindrome')
else
writeln('input was not palindrome');
end.
PascalABC.NET
function IsPalindrome(s: string) := s = s[::-1];
begin
Println(IsPalindrome('arozaupalanalapuazora'));
Println(IsPalindrome('abcd'));
end.
- Output:
True False
Perl
There is more than one way to do this.
- palindrome uses the built-in function reverse().
- palindrome_c uses iteration; it is a translation of the C solution.
- palindrome_r uses recursion.
- palindrome_e uses a recursive regular expression.
All of these functions take a parameter, or default to $_ if there is no parameter. None of these functions ignore case or strip characters; if you want do that, you can use ($s = lc $s) =~ s/[\W_]//g before you call these functions.
# Palindrome.pm
package Palindrome;
use strict;
use warnings;
use Exporter 'import';
our @EXPORT = qw(palindrome palindrome_c palindrome_r palindrome_e);
sub palindrome
{
my $s = (@_ ? shift : $_);
return $s eq reverse $s;
}
sub palindrome_c
{
my $s = (@_ ? shift : $_);
for my $i (0 .. length($s) >> 1)
{
return 0 unless substr($s, $i, 1) eq substr($s, -1 - $i, 1);
}
return 1;
}
sub palindrome_r
{
my $s = (@_ ? shift : $_);
if (length $s <= 1) { return 1; }
elsif (substr($s, 0, 1) ne substr($s, -1, 1)) { return 0; }
else { return palindrome_r(substr($s, 1, -1)); }
}
sub palindrome_e
{
(@_ ? shift : $_) =~ /^(.?|(.)(?1)\2)$/ + 0
}
This example shows how to use the functions:
# pbench.pl
use strict;
use warnings;
use Benchmark qw(cmpthese);
use Palindrome;
printf("%d, %d, %d, %d: %s\n",
palindrome, palindrome_c, palindrome_r, palindrome_e, $_)
for
qw/a aa ab abba aBbA abca abba1 1abba
ingirumimusnocteetconsumimurigni/,
'ab cc ba', 'ab ccb a';
printf "\n";
my $latin = "ingirumimusnocteetconsumimurigni";
cmpthese(100_000, {
palindrome => sub { palindrome $latin },
palindrome_c => sub { palindrome_c $latin },
palindrome_r => sub { palindrome_r $latin },
palindrome_e => sub { palindrome_e $latin },
});
- Output:
on a machine running Perl 5.10.1 on amd64-openbsd
$ perl pbench.pl 1, 1, 1, 1: a 1, 1, 1, 1: aa 0, 0, 0, 0: ab 1, 1, 1, 1: abba 0, 0, 0, 0: aBbA 0, 0, 0, 0: abca 0, 0, 0, 0: abba1 0, 0, 0, 0: 1abba 1, 1, 1, 1: ingirumimusnocteetconsumimurigni 1, 1, 1, 1: ab cc ba 0, 0, 0, 0: ab ccb a (warning: too few iterations for a reliable count) Rate palindrome_r palindrome_e palindrome_c palindrome palindrome_r 51020/s -- -50% -70% -97% palindrome_e 102041/s 100% -- -41% -94% palindrome_c 172414/s 238% 69% -- -90% palindrome 1666667/s 3167% 1533% 867% --
With this machine, palindrome() ran far faster than the alternatives (and too fast for a reliable count). The Perl regular expression engine recursed twice as fast as the Perl interpreter.
Phix
function is_palindrome(sequence s) return s==reverse(s) end function ?is_palindrome("rotator") -- prints 1 ?is_palindrome("tractor") -- prints 0 constant punctuation = " `~!@#$%^&*()-=_+[]{}\\|;:',.<>/?", nulls = repeat("",length(punctuation)) function extra_credit(sequence s) s = utf8_to_utf32(lower(substitute_all(s,punctuation,nulls))) return s==reverse(s) end function -- these all print 1 (true) ?extra_credit("Madam, I'm Adam.") ?extra_credit("A man, a plan, a canal: Panama!") ?extra_credit("In girum imus nocte et consumimur igni") ?extra_credit("人人為我,我為人人") ?extra_credit("Я иду с мечем, судия") ?extra_credit("아들딸들아") ?extra_credit("가련하시다 사장집 아들딸들아 집장사 다시 하련가") ?extra_credit("tregða, gón, reiði - er nóg að gert")
Phixmonti
include ..\Utilitys.pmt
def palindrome? dup reverse == enddef
( "abba" "boom" "radar" "civic" "great" )
len for get
dup print " : palindrome? " print palindrome?
if "true" else "false" endif ?
endfor
def letter? dup 'z' <= swap 'a' >= and enddef
"" >ps
"In girum imus nocte, et consumimur igni" dup ? lower
len for get
dup letter?
if
ps> swap chain >ps
else
drop
endif
endfor
ps> palindrome? if "This is an inexact palindrome!" else "Not a palindrome." endif ?
- Output:
abba : palindrome? true boom : palindrome? false radar : palindrome? true civic : palindrome? true great : palindrome? false In girum imus nocte, et consumimur igni This is an inexact palindrome! === Press any key to exit ===
PHP
<?php
function is_palindrome($string) {
return $string == strrev($string);
}
?>
Regular expression-based solution (source)
<?php
function is_palindrome($string) {
return preg_match('/^(?:(.)(?=.*(\1(?(2)\2|))$))*.?\2?$/', $string);
}
?>
Picat
go =>
Tests = ["In girum imus nocte et consumimur igni",
"this is a non palindrome string",
"anna ABcdcBA anna",
"anna ABcdcBA annax",
"A man, a plan, a canoe, pasta, heros, rajahs" ++
"a coloratura, maps, snipe, percale, macaroni, " ++
"a gag, a banana bag, a tan, a tag, " ++
"a banana bag again (or a camel), a crepe, pins, " ++
"Spam, a rut, a Rolo, cash, a jar, sore hats, " ++
"a peon, a canal - Panama!",
10,
111111,
12221,
9384212,
10.01
],
foreach(Test in Tests)
if is_palindrome(Test) then
println([Test, "exact palindrome"])
elseif is_palindrome_inexact(Test) then
println([Test, "inexact palindrome"])
else
println([Test, "no"])
end
end,
nl.
% Detect palindromes for strings (and numbers).
is_palindrome(N), number(N) => is_palindrome(N.to_string()).
is_palindrome(S) => S == S.reverse().
% Detect inexact palindromes.
is_palindrome_inexact(N), number(N) => is_palindrome_inexact(N.to_string()).
is_palindrome_inexact(S) =>
is_palindrome(strip(S)).
% convert to lowercase and
% skips punctuation and white space.
strip(S) = [C : C in S.to_lowercase(),
not C.membchk("!?,.;-_ \t\n()[]{}")].
- Output:
[In girum imus nocte et consumimur igni,inexact palindrome] [this is a non palindrome string,no] [anna ABcdcBA anna,exact palindrome] [anna ABcdcBA annax,no] [A man, a plan, a canoe, pasta, heros, rajahsa coloratura, maps, snipe, percale, macaroni, a gag, a banana bag, a tan, a tag, a banana bag again (or a camel), a crepe, pins, Spam, a rut, a Rolo, cash, a jar, sore hats, a peon, a canal - Panama!,inexact palindrome] [10,no] [11,exact palindrome] [111111,exact palindrome] [12221,exact palindrome] [9384212,no] [10.01,exact palindrome]
PicoLisp
(de palindrome? (S)
(= (setq S (chop S)) (reverse S)) )
- Output:
: (palindrome? "ingirumimusnocteetconsumimurigni") -> T
Pike
int main(){
if(pal("rotator")){
write("palindrome!\n");
}
if(!pal("asdf")){
write("asdf isn't a palindrome.\n");
}
}
int pal(string input){
if( reverse(input) == input ){
return 1;
} else {
return 0;
}
}
PL/I
To satisfy the revised specification (which contradicts the preceding explanation) the following trivially solves the problem in PL/I:
is_palindrome = (text = reverse(text));
The following solution strips spaces:
is_palindrome: procedure (text) returns (bit(1));
declare text character (*) varying;
text = remove_blanks(text);
text = lowercase(text);
return (text = reverse(text));
remove_blanks: procedure (text);
declare text character (*) varying;
declare (i, j) fixed binary (31);
j = 0;
do i = 1 to length(text);
if substr(text, i, 1) = ' ' then
do; j = j + 1; substr(text, j, 1) = substr(text, i, 1); end;
end;
return (substr(text, 1, j));
end remove_blanks;
end is_palindrome;
PL/M
100H:
/* CHECK EXACT PALINDROME ASSUMING $-TERMINATED STRING */
PALINDROME: PROCEDURE(PTR) BYTE;
DECLARE (PTR, FRONT, BACK) ADDRESS, STR BASED PTR BYTE;
/* FIND END */
FRONT, BACK = 0;
DO WHILE STR(BACK) <> '$';
BACK = BACK + 1;
END;
BACK = BACK - 1;
/* CHECK MATCH */
DO WHILE (FRONT < BACK) AND (STR(FRONT) = STR(BACK));
FRONT = FRONT + 1;
BACK = BACK - 1;
END;
RETURN FRONT >= BACK;
END PALINDROME;
/* CHECK INEXACT PALINDROME: FILTER OUT NON-LETTERS AND NUMBERS */
INEXACT$PALINDROME: PROCEDURE(PTR) BYTE;
/* 256 BYTES OUGHT TO BE ENOUGH FOR EVERYONE */
DECLARE (PTR, OPTR) ADDRESS;
DECLARE FILTER (256) BYTE;
DECLARE (IN BASED PTR, OUT BASED OPTR) BYTE;
OPTR = .FILTER;
DO WHILE IN <> '$';
OUT = IN OR 32;
/* LOWERCASE CHARACTERS ARE NOT IN THE PL/M CHARSET,
BUT WE CAN JUST WRITE THE ASCII VALUES AS NUMBERS */
IF (OUT >= '0' AND OUT <= '9')
OR (OUT >= 97 AND OUT <= 122) THEN
OPTR = OPTR + 1;
PTR = PTR + 1;
END;
OUT = '$';
RETURN PALINDROME(.FILTER);
END INEXACT$PALINDROME;
/* CP/M BDOS CALLS */
BDOS: PROCEDURE(FUNC, ARG);
DECLARE FUNC BYTE, ARG ADDRESS;
GO TO 5;
END BDOS;
PRINT: PROCEDURE(STRING);
DECLARE STRING ADDRESS;
CALL BDOS(9, STRING);
END PRINT;
/* TEST SOME STRINGS */
DECLARE STRINGS (8) ADDRESS;
STRINGS(0) = .'ROTOR$';
STRINGS(1) = .'RACECAR$';
STRINGS(2) = .'LEVEL$';
STRINGS(3) = .'REDDER$';
STRINGS(4) = .'RACECAR$';
STRINGS(5) = .'A MAN, A PLAN, A CANAL: PANAMA$';
STRINGS(6) = .'EGAD, A BASE TONE DENOTES A BAD AGE.$';
STRINGS(7) = .'ROSETTA$';
DECLARE N BYTE;
DO N = 0 TO LAST(STRINGS);
CALL PRINT(STRINGS(N));
CALL PRINT(.': $');
IF PALINDROME(STRINGS(N)) THEN
CALL PRINT(.'EXACT$');
ELSE IF INEXACT$PALINDROME(STRINGS(N)) THEN
CALL PRINT(.'INEXACT$');
ELSE
CALL PRINT(.'NOT A PALINDROME$');
CALL PRINT(.(13,10,'$'));
END;
CALL BDOS(0,0);
EOF
- Output:
ROTOR: EXACT RACECAR: EXACT LEVEL: EXACT REDDER: EXACT RACECAR: EXACT A MAN, A PLAN, A CANAL: PANAMA: INEXACT EGAD, A BASE TONE DENOTES A BAD AGE.: INEXACT ROSETTA: NOT A PALINDROME
Plain English
Strings and substrings all come with two byte pointers by default:
first
, which points to the first byte in the string.last
, which points to the last byte in the string.
first
is an address, while first's target
is the byte at that address.
No need to actually reverse the string; just compare the first's target with the last's target until they meet in the middle.
To decide if a string is palindromic:
Slap a substring on the string.
Loop.
If the substring's first is greater than the substring's last, say yes.
If the substring's first's target is not the substring's last's target, say no.
Add 1 to the substring's first.
Subtract 1 from the substring's last.
Repeat.
Pointless
Basic Function
isPalindrome(chars) =
chars == reverse(chars)
With Pre-processing
output =
"A man, a plan, a canal -- Panama"
|> toList
|> filter(inFunc(alNums))
|> map(toLower)
|> isPalindrome
|> println
- Output:
true
Potion
# The readable recursive version
palindrome_i = (s, b, e):
if (e <= b): true.
elsif (s ord(b) != s ord(e)): false.
else: palindrome_i(s, b+1, e-1).
.
palindrome = (s):
palindrome_i(s, 0, s length - 1).
palindrome(argv(1))
PowerBASIC
The output is identical to the QBasic version, above.
FUNCTION isPalindrome (what AS STRING) AS LONG
DIM whatcopy AS STRING, chk AS STRING, tmp AS STRING * 1, L0 AS LONG
FOR L0 = 1 TO LEN(what)
tmp = UCASE$(MID$(what, L0, 1))
SELECT CASE tmp
CASE "A" TO "Z"
whatcopy = whatcopy & tmp
chk = tmp & chk
CASE "0" TO "9"
MSGBOX "Numbers are cheating! (""" & what & """)"
FUNCTION = 0
EXIT FUNCTION
END SELECT
NEXT
FUNCTION = ISTRUE((whatcopy) = chk)
END FUNCTION
FUNCTION PBMAIN () AS LONG
DATA "My dog has fleas", "Madam, I'm Adam.", "1 on 1", "In girum imus nocte et consumimur igni"
DIM L1 AS LONG, w AS STRING
FOR L1 = 1 TO DATACOUNT
w = READ$(L1)
IF ISTRUE(isPalindrome(w)) THEN
MSGBOX $DQ & w & """ is a palindrome"
ELSE
MSGBOX $DQ & w & """ is not a palindrome"
END IF
NEXT
END FUNCTION
PowerShell
An exact version based on reversing the string:
Function Test-Palindrome( [String] $Text ){
$CharArray = $Text.ToCharArray()
[Array]::Reverse($CharArray)
$Text -eq [string]::join('', $CharArray)
}
PowerShell (Regex Version)
This version is much faster because it does not manipulate arrays. [This is not clear; the above version was slowed down by using -join instead of [string]::join, and -like instead of -eq. After changing those it is similar, if not faster, than this version].
function Test-Palindrome
{
<#
.SYNOPSIS
Tests if a string is a palindrome.
.DESCRIPTION
Tests if a string is a true palindrome or, optionally, an inexact palindrome.
.EXAMPLE
Test-Palindrome -Text "racecar"
.EXAMPLE
Test-Palindrome -Text '"Deliver desserts," demanded Nemesis, "emended, named, stressed, reviled."' -Inexact
#>
[CmdletBinding()]
[OutputType([bool])]
Param
(
# The string to test for palindrominity.
[Parameter(Mandatory=$true)]
[string]
$Text,
# When specified, detects an inexact palindrome.
[switch]
$Inexact
)
if ($Inexact)
{
# Strip all punctuation and spaces
$Text = [Regex]::Replace("$Text($7&","[^1-9a-zA-Z]","")
}
$Text -match "^(?'char'[a-z])+[a-z]?(?:\k'char'(?'-char'))+(?(char)(?!))$"
}
Test-Palindrome -Text 'radar'
- Output:
True
Test-Palindrome -Text "In girum imus nocte et consumimur igni."
- Output:
False
Test-Palindrome -Text "In girum imus nocte et consumimur igni." -Inexact
- Output:
True
PowerShell (Unicode category aware, no string reverse)
An inexact version can remove punctuation by looking at Unicode categories for each character, either using .Net methods or a regex.
Function Test-Palindrome {
[CmdletBinding()]
Param(
[Parameter(ValueFromPipeline)]
[string[]]$Text
)
process {
:stringLoop foreach ($T in $Text)
{
# Normalize Unicode combining characters,
# so character á compares the same as (a+combining accent)
$T = $T.Normalize([Text.NormalizationForm]::FormC)
# Remove anything from outside the Unicode category
# "Letter from any language"
$T = $T -replace '\P{L}', ''
# Walk from each end of the string inwards,
# comparing a char at a time.
# Avoids string copy / reverse overheads.
$Left, $Right = 0, [math]::Max(0, ($T.Length - 1))
while ($Left -lt $Right)
{
if ($T[$Left] -ne $T[$Right])
{
# return early if string is not a palindrome
[PSCustomObject]@{
Text = $T
IsPalindrome = $False
}
continue stringLoop
}
else
{
$Left++
$Right--
}
}
# made it to here, then string is a palindrome
[PSCustomObject]@{
Text = $T
IsPalindrome = $True
}
}
}
}
'ánu-ná', 'nowt' | Test-Palindrome
- Output:
PS C:\> 'ánu-ná', 'nowt' | Test-Palindrome Text IsPalindrome ---- ------------ ánuná True now False
Processing
void setup(){
println(isPalindrome(InsertPalindromeHere));
}
boolean isPalindrome(string check){
char[] letters = new char[check.length];
string invert = " ";
string modCheck = " " + check;
for(int i = 0; i < letters.length; i++){
letters[i] = check.charAt(i);
}
for(int i = letters.length-1; i >= 0; i--){
invert = invert + letters[i];
}
if(invert == modCheck){
return true;
} else {
return false;
}
}
- Output:
"true" or "false" depending
Alternative Implementation: using StringBuilder, implementing exact and inexact check
void setup(){
println("PalindromeDetection");
String[] tests = {
"abcba",
"aa",
"a",
"",
" ",
"ab",
"abcdba",
"A man, a plan, a canal: Panama!",
"Dammit, I’m Mad!",
"Never odd or even",
"ingirumimusnocteetconsumimurigni"
};
for (int i = 0; i < tests.length; i++){
println((i + 1) + ". '" + tests[i] + "' isExactPalindrome: " + isExactPalindrome(tests[i]) + " isInexactPalindrome: " + isInexactPalindrome(tests[i]));
}
}
/*
* Check for exact palindrome using StringBuilder and String since String in Java does not provide any reverse functionality because Strings are immutable.
*/
boolean isExactPalindrome(String s){
StringBuilder sb = new StringBuilder(s);
return s.equals(sb.reverse().toString());
}
/*
* Check for inexact palindrome using the check for exact palindromeabove.
*/
boolean isInexactPalindrome(String s){
// removes all whitespaces and non-visible characters,
// remove anything besides alphabet characters
// ignore case
return isExactPalindrome(s.replaceAll("\\s+","").replaceAll("[^A-Za-z]+", "").toLowerCase());
}
- Output:
PalindromeDetection 1. 'abcba' isExactPalindrome: true isInexactPalindrome: true 2. 'aa' isExactPalindrome: true isInexactPalindrome: true 3. 'a' isExactPalindrome: true isInexactPalindrome: true 4. '' isExactPalindrome: true isInexactPalindrome: true 5. ' ' isExactPalindrome: true isInexactPalindrome: true 6. 'ab' isExactPalindrome: false isInexactPalindrome: false 7. 'abcdba' isExactPalindrome: false isInexactPalindrome: false 8. 'A man, a plan, a canal: Panama!' isExactPalindrome: false isInexactPalindrome: true 9. 'Dammit, I’m Mad!' isExactPalindrome: false isInexactPalindrome: true 10. 'Never odd or even' isExactPalindrome: false isInexactPalindrome: true 11. 'ingirumimusnocteetconsumimurigni' isExactPalindrome: true isInexactPalindrome: true
Prolog
Non-recursive
From this tutorial.
palindrome(Word) :- name(Word,List), reverse(List,List).
Recursive
pali(Str) :- sub_string(Str, 0, 1, _, X), string_concat(Str2, X, Str), string_concat(X, Mid, Str2), pali(Mid).
pali(Str) :- string_length(Str, Len), Len < 2.
Changing string into atom makes the program run also on GNU Prolog. I.e.
pali(Str) :- sub_atom(Str, 0, 1, _, X), atom_concat(Str2, X, Str), atom_concat(X, Mid, Str2), pali(Mid).
pali(Str) :- atom_length(Str, Len), Len < 2.
PureBasic
Procedure IsPalindrome(StringToTest.s)
If StringToTest=ReverseString(StringToTest)
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Python
Now that Python 2.7 and Python 3.4 are quite different, We should include the version IMHO.
Non-recursive
This one uses the reversing the string technique (to reverse a string Python can use the odd but right syntax string[::-1])
def is_palindrome(s):
return s == s[::-1]
Non-recursive, Ignoring Punctuation/Case/Spaces
A word is a palindrome if the letters are the same forwards as backwards, but the other methods given here will return False for, e.g., an input of "Go hang a salami, I'm a lasagna hog" or "A man, a plan, a canal: Panama." An implementation that traverses the string and ignores case differences, spaces, and non-alpha characters is pretty trivial.
def is_palindrome(s):
low = 0
high = len(s) - 1
while low < high:
if not s[low].isalpha():
low += 1
elif not s[high].isalpha():
high -= 1
else:
if s[low].lower() != s[high].lower():
return False
else:
low += 1
high -= 1
return True
Recursive
def is_palindrome_r(s):
if len(s) <= 1:
return True
elif s[0] != s[-1]:
return False
else:
return is_palindrome_r(s[1:-1])
Python has short-circuit evaluation of Boolean operations so a shorter and still easy to understand recursive function is
def is_palindrome_r2(s):
return not s or s[0] == s[-1] and is_palindrome_r2(s[1:-1])
Testing
def test(f, good, bad):
assert all(f(x) for x in good)
assert not any(f(x) for x in bad)
print '%s passed all %d tests' % (f.__name__, len(good)+len(bad))
pals = ('', 'a', 'aa', 'aba', 'abba')
notpals = ('aA', 'abA', 'abxBa', 'abxxBa')
for ispal in is_palindrome, is_palindrome_r, is_palindrome_r2:
test(ispal, pals, notpals)
Palindrome Using Regular Expressions Python 2.7
def p_loop():
import re, string
re1="" # Beginning of Regex
re2="" # End of Regex
pal=raw_input("Please Enter a word or phrase: ")
pd = pal.replace(' ','')
for c in string.punctuation:
pd = pd.replace(c,"")
if pal == "" :
return -1
c=len(pd) # Count of chars.
loops = (c+1)/2
for x in range(loops):
re1 = re1 + "(\w)"
if (c%2 == 1 and x == 0):
continue
p = loops - x
re2 = re2 + "\\" + str(p)
regex= re1+re2+"$" # regex is like "(\w)(\w)(\w)\2\1$"
#print(regex) # To test regex before re.search
m = re.search(r'^'+regex,pd,re.IGNORECASE)
if (m):
print("\n "+'"'+pal+'"')
print(" is a Palindrome\n")
return 1
else:
print("Nope!")
return 0
Checking the left half against a reflection of the right half
'''Palindrome detection'''
# isPalindrome :: String -> Bool
def isPalindrome(s):
'''True if the string is unchanged under reversal.
(The left half is a reflection of the right half)
'''
d, m = divmod(len(s), 2)
return s[0:d] == s[d + m:][::-1]
# ------------------------- TEST -------------------------
# main :: IO ()
def main():
'''Test'''
print('\n'.join(
f'{repr(s)} -> {isPalindrome(cleaned(s))}' for s in [
"",
"a",
"ab",
"aba",
"abba",
"In girum imus nocte et consumimur igni"
]
))
# cleaned :: String -> String
def cleaned(s):
'''A lower-case copy of s, with spaces pruned.'''
return [c.lower() for c in s if ' ' != c]
# MAIN ---
if __name__ == '__main__':
main()
- Output:
'' -> True 'a' -> True 'ab' -> False 'aba' -> True 'abba' -> True 'In girum imus nocte et consumimur igni' -> True
Twiddle Indexing
I have no idea what this technique is called, so I'm going with "Twiddle Indexing".
Twiddle Indexing v. Negative Indexing 0 1 2 3 4 <-- index [ a, b, c, d, e ] ~4 ~3 ~2 ~1 ~0 <-- twiddle index 0 1 2 3 4 <-- index [ a, b, c, d, e ] -5 -4 -3 -2 -1 <-- negative index
def palindromic(str):
for i in range(len(str)//2):
if str[i] != str[~i]:
return(False)
return(True)
Quackery
[ dup reverse = ] is palindromic ( [ --> b )
[ [] swap witheach
[ upper dup
dup lower = iff
drop else join ]
palindromic ] is inexactpalindrome ( $ --> b )
Twiddle Indexing
[ true swap
dup size 2 / times
[ dup i peek
over i ~ peek != if
[ dip not conclude ] ]
drop ] is palindromic ( [ --> b )
R
Recursive
Note that the recursive method will fail if the string length is too long. R will assume an infinite recursion if a recursion nests deeper than 5,000. Options may be set in the environment to increase this to 500,000.
palindro <- function(p) {
if ( nchar(p) == 1 ) {
return(TRUE)
} else if ( nchar(p) == 2 ) {
return(substr(p,1,1) == substr(p,2,2))
} else {
if ( substr(p,1,1) == substr(p, nchar(p), nchar(p)) ) {
return(palindro(substr(p, 2, nchar(p)-1)))
} else {
return(FALSE)
}
}
}
Iterative
palindroi <- function(p) {
for(i in 1:floor(nchar(p)/2) ) {
r <- nchar(p) - i + 1
if ( substr(p, i, i) != substr(p, r, r) ) return(FALSE)
}
TRUE
}
Comparative
This method is somewhat faster than the other two.
Note that this method incorrectly regards an empty string as not a palindrome. Please leave this bug in the code, and take a look a the Testing_a_Function page.
revstring <- function(stringtorev) {
return(
paste(
strsplit(stringtorev,"")[[1]][nchar(stringtorev):1]
,collapse="")
)
}
palindroc <- function(p) {return(revstring(p)==p)}
Rev
R has a built-in function for reversing vectors, so we only have to coerce our input in to the proper form.
Unicode is supported, but this ignores the "inexact palindromes" extra credit requirement because, without some sort of regex, supporting Unicode while stripping punctuation and white space is hard in R.
is.Palindrome <- function(string)
{
characters <- unlist(strsplit(string, ""))
all(characters == rev(characters))
}
- Output:
The rev solution is not benchmarked.
test <- "ingirumimusnocteetconsumimurigni" tester <- paste(rep(test,38),collapse="") > test <- "ingirumimusnocteetconsumimurigni" > tester <- paste(rep(test,38),collapse="") > system.time(palindro(tester)) user system elapsed 0.04 0.00 0.04 > system.time(palindroi(tester)) user system elapsed 0.01 0.00 0.02 > system.time(palindroc(tester)) user system elapsed 0 0 0
Racket
(define (palindromb str)
(let* ([lst (string->list (string-downcase str))]
[slst (remove* '(#\space) lst)])
(string=? (list->string (reverse slst)) (list->string slst))))
;;example output
> (palindromb "able was i ere i saw elba")
#t
> (palindromb "waht the hey")
#f
> (palindromb "In girum imus nocte et consumimur igni")
#t
>
Raku
(formerly Perl 6)
subset Palindrom of Str where {
.flip eq $_ given .comb(/\w+/).join.lc
}
my @tests = q:to/END/.lines;
A man, a plan, a canal: Panama.
My dog has fleas
Madam, I'm Adam.
1 on 1
In girum imus nocte et consumimur igni
END
for @tests { say $_ ~~ Palindrom, "\t", $_ }
- Output:
True A man, a plan, a canal: Panama. False My dog has fleas True Madam, I'm Adam. False 1 on 1 True In girum imus nocte et consumimur igni
Rascal
The most simple solution:
import String;
public bool palindrome(str text) = toLowerCase(text) == reverse(text);
A solution that handles sentences with spaces and capitals:
import String;
public bool palindrome(str text){
text = replaceAll(toLowerCase(text), " ", "");
return text == reverse(text);
}
Example:
rascal>palindrome("In girum imus nocte et consumimur igni")
bool: true
REBOL
REBOL [
Title: "Palindrome Recognizer"
URL: http://rosettacode.org/wiki/Palindrome
]
; In order to compete with all the one-liners, the operation is
; compressed: parens force left hand side to evaluate first, where I
; copy the phrase, then uppercase it and assign it to 'p'. Now the
; right hand side is evaluated: p is copied, then reversed in place;
; the comparison is made and implicitely returned.
palindrome?: func [
phrase [string!] "Potentially palindromatic prose."
/local p
][(p: uppercase copy phrase) = reverse copy p]
; Teeny Tiny Test Suite
assert: func [code][print [either do code [" ok"]["FAIL"] mold code]]
print "Simple palindromes, with an exception for variety:"
repeat phrase ["z" "aha" "sees" "oofoe" "Deified"][
assert compose [palindrome? (phrase)]]
print [crlf "According to the problem statement, these should fail:"]
assert [palindrome? "A man, a plan, a canal, Panama."] ; Punctuation not ignored.
assert [palindrome? "In girum imus nocte et consumimur igni"] ; Spaces not removed.
; I know we're doing palindromes, not alliteration, but who could resist...?
- Output:
Simple palindromes, with an exception for variety: ok [palindrome? "z"] ok [palindrome? "aha"] ok [palindrome? "sees"] FAIL [palindrome? "oofoe"] ok [palindrome? "Deified"] According to the problem statement, these should fail: FAIL [palindrome? "A man, a plan, a canal, Panama."] FAIL [palindrome? "In girum imus nocte et consumimur igni"]
Retro
:palindrome? (s-f) dup s:hash [ s:reverse s:hash ] dip eq? ;
'ingirumimusnocteetconsumimurigni palindrome? n:put
Refal
$ENTRY Go {
= <Test 'rotor'>
<Test 'racecar'>
<Test 'RACEcar'>
<Test 'level'>
<Test 'rosetta'>
<Test 'A man, a plan, a canal: Panama'>
<Test 'Egad, a base tone denotes a bad age'>
<Test 'This is not a palindrome'>;
};
Test {
e.W, <Palindrome e.W> <InexactPalindrome e.W>: {
True s.1 = <Prout e.W ': exact palindrome'>;
s.1 True = <Prout e.W ': inexact palindrome'>;
False False = <Prout e.W ': not a palindrome'>;
};
};
InexactPalindrome {
e.W = <Palindrome <Filter ('ABCDEFGHIJKLMNOPQRSTUVWXYZ') <Upper e.W>>>;
};
Filter {
(e.Keep) = ;
(e.Keep) s.C e.W, e.Keep: {
e.1 s.C e.2 = s.C <Filter (e.Keep) e.W>;
e.1 = <Filter (e.Keep) e.W>;
};
};
Palindrome {
= True;
s.C = True;
s.C e.W s.C = <Palindrome e.W>;
e.X = False;
};
- Output:
rotor: exact palindrome marinus@frankenstein:~/refal$ refc palin && refgo palin Refal-5 Compiler. Version PZ Jan 25 2024 Copyright: Refal Systems Inc. rotor: exact palindrome racecar: exact palindrome RACEcar: inexact palindrome level: exact palindrome rosetta: not a palindrome A man, a plan, a canal: Panama: inexact palindrome Egad, a base tone denotes a bad age: inexact palindrome This is not a palindrome: not a palindrome
REXX
version 1
/*REXX pgm checks if phrase is palindromic; ignores the case of the letters. */
parse arg y /*get (optional) phrase from the C.L. */
if y='' then y='In girum imus nocte et consumimur igni' /*[↓] translation.*/
/*We walk around in the night and we are burnt by the fire (of love).*/
say 'string = ' y
if isTpal(y) then say 'The string is a true palindrome.'
else if isPal(y) then say 'The string is an inexact palindrome.'
else say "The string isn't palindromic."
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
isTpal: return reverse(arg(1))==arg(1)
isPal: return isTpal(translate(space(x,0)))
- output :
string = In girum imus nocte et consumimur igni The string is an inexact palindrome.
version 2
(Works with Regina 3.8 and later, with options: AREXX_BIFS and AREXX_SEMANTICS)
It should be noted that the COMPRESS function is not a Classic REXX BIF and isn't present in many REXXes.
The SPACE(string,0) BIF can be used instead.
It should also be noted that UPPER BIF is not present in some REXXes.
Use the PARSE UPPER statement or TRANSLATE() BIF instead.
/* REXX */
/*Check whether a string is a palindrome */
parse pull string
select
when palindrome(string) then say string 'is an exact palindrome.'
when palindrome(compress(upper(string))) then say string 'is an inexact palindrome.'
otherwise say string 'is not palindromic.'
end
exit 0
palindrome: procedure
parse arg string
return string==reverse(string)
- Output:
ABBA is an exact palindrome. In girum imus nocte et consumimur igni is an inexact palindrome. djdjdj is not palindromic.
Ring
aString = "radar"
bString = ""
for i=len(aString) to 1 step -1
bString = bString + aString[i]
next
see aString
if aString = bString see " is a palindrome." + nl
else see " is not a palindrome" + nl ok
RPL
≪ ""
OVER SIZE 1 FOR j
OVER j DUP SUB + -1 STEP
==
≫ ‘XPAL?’ STO
Stretch
RPL does not support Unicode. To detect inexact palindromes, we just need a clean-up word:
≪ "" 1 3 PICK SIZE FOR j OVER j DUP SUB IF DUP "a" ≥ OVER "z" ≤ AND THEN NUM 32 - CHR END IF DUP "A" ≥ OVER "Z" ≤ AND THEN + ELSE DROP END NEXT SWAP DROP ≫ ‘AZONLY’ STO ≪ AZONLY "" OVER SIZE 1 FOR j OVER j DUP SUB + -1 STEP == ≫ ‘IPAL?’ STO
"rotor" XPAL? "In girum imus nocte et consumimur igni." IPAL?
- Output:
2: 1 1: 1
Ruby
Non-recursive
def palindrome?(s)
s == s.reverse
end
Recursive
def r_palindrome?(s)
if s.length <= 1
true
elsif s[0] != s[-1]
false
else
r_palindrome?(s[1..-2])
end
end
Testing Note that the recursive method is much slower -- using the 2151 character palindrome by Dan Hoey here, we have:
str = "A man, a plan, a caret, [...2110 chars deleted...] a canal--Panama.".downcase.delete('^a-z')
puts palindrome?(str) # => true
puts r_palindrome?(str) # => true
require 'benchmark'
Benchmark.bm do |b|
b.report('iterative') {10000.times {palindrome?(str)}}
b.report('recursive') {10000.times {r_palindrome?(str)}}
end
- Output:
true true user system total real iterative 0.062000 0.000000 0.062000 ( 0.055000) recursive 16.516000 0.000000 16.516000 ( 16.562000)
Rhovas
Simplest solution using String.reverse
:
func isPalindromeReverse(string: String): Boolean {
return string == string.reverse();
}
Alternate character-based solution using pattern matching. Unlike String.reverse
, this has limited unicode support due to surrogates (code points split into multiple characters).
func isPalindromeChars(chars: List<String>): Boolean {
match (chars) {
[]: return true;
[elem]: return true;
[first, middle*, last]: return first == last && isPalindromeChars(middle);
}
}
Overall result and test cases:
func isPalindrome(string: String): Boolean {
return isPalindromeReverse(string) && isPalindromeChars(string.chars);
}
assert isPalindrome("");
assert isPalindrome("f");
assert isPalindrome("noon");
assert isPalindrome("kayak");
assert isPalindrome("step on no pets");
assert !isPalindrome("palindrome");
assert !isPalindrome("A man, a plan, a canal - Panama!"); //inexact
assert isPalindrome("§★♖★§"); //single utf16 code points
assert isPalindromeReverse("🗲"); //string reverse handles surrogates
assert !isPalindromeChars("🗲".chars); //.chars splits surrogates into two chars
Run BASIC
data "My dog has fleas", "Madam, I'm Adam.", "1 on 1", "In girum imus nocte et consumimur igni"
for i = 1 to 4
read w$
print w$;" is ";isPalindrome$(w$);" Palindrome"
next
function isPalindrome$(str$)
for i = 1 to len(str$)
a$ = upper$(mid$(str$,i,1))
if (a$ >= "A" and a$ <= "Z") or (a$ >= "0" and a$ <= "9") then b$ = b$ + a$: c$ = a$ + c$
next i
if b$ <> c$ then isPalindrome$ = "not"
end function
- Output:
My dog has fleas is not Palindrome Madam, I'm Adam. is Palindrome 1 on 1 is not Palindrome In girum imus nocte et consumimur igni is Palindrome
Rust
fn is_palindrome(string: &str) -> bool {
let half_len = string.len() / 2;
string
.chars()
.take(half_len)
.eq(string.chars().rev().take(half_len))
}
macro_rules! test {
( $( $x:tt ),* ) => { $( println!("'{}': {}", $x, is_palindrome($x)); )* };
}
fn main() {
test!(
"",
"a",
"ada",
"adad",
"ingirumimusnocteetconsumimurigni",
"人人為我,我為人人",
"Я иду с мечем, судия",
"아들딸들아",
"The quick brown fox"
);
}
- Output:
'': true 'a': true 'ada': true 'adad': false 'ingirumimusnocteetconsumimurigni': true '人人為我,我為人人': true 'Я иду с мечем, судия': false '아들딸들아': true 'The quick brown fox': false
The above soluion checks if the codepoints form a pallindrome, but it is perhaps more correct to consider if the graphemes form a pallindrome. This can be accomplished with an external library and a slight modification to is_palindrome
.
extern crate unicode_segmentation;
use unicode_segmentation::UnicodeSegmentation;
fn is_palindrome(string: &str) -> bool {
string.graphemes(true).eq(string.graphemes(true).rev())
}
SAS
Description
The macro "palindro" has two parameters: string and ignorewhitespace.
string is the expression to be checked.
ignorewhitespace, (Y/N), determines whether or not to ignore blanks and punctuation.
This macro was written in SAS 9.2. If you use a version before SAS 9.1.3,
the compress function options will not work.
Code
%MACRO palindro(string, ignorewhitespace);
DATA _NULL_;
%IF %UPCASE(&ignorewhitespace)=Y %THEN %DO;
/* The arguments of COMPRESS (sp) ignore blanks and puncutation */
/* We take the string and record it in reverse order using the REVERSE function. */
%LET rev=%SYSFUNC(REVERSE(%SYSFUNC(COMPRESS(&string,,sp))));
%LET string=%SYSFUNC(COMPRESS(&string.,,sp));
%END;
%ELSE %DO;
%LET rev=%SYSFUNC(REVERSE(&string));
%END;
/*%PUT rev=&rev.;*/
/*%PUT string=&string.;*/
/* Here we determine if the string and its reverse are the same. */
%IF %UPCASE(&string)=%UPCASE(&rev.) %THEN %DO;
%PUT TRUE;
%END;
%ELSE %DO;
%PUT FALSE;
%END;
RUN;
%MEND;
Example macro call and output
%palindro("a man, a plan, a canal: panama",y);
TRUE
NOTE: DATA statement used (Total process time):
real time 0.00 seconds
cpu time 0.00 seconds
%palindro("a man, a plan, a canal: panama",n);
FALSE
NOTE: DATA statement used (Total process time):
real time 0.00 seconds
cpu time 0.00 seconds
Scala
Non-recursive, robustified
def isPalindrome(s: String): Boolean = (s.size >= 2) && s == s.reverse
Bonus: Detect and account for odd space and punctuation
def isPalindromeSentence(s: String): Boolean =
(s.size >= 2) && {
val p = s.replaceAll("[^\\p{L}]", "").toLowerCase
p == p.reverse
}
Recursive
import scala.annotation.tailrec
def isPalindromeRec(s: String) = {
@tailrec
def inner(s: String): Boolean =
(s.length <= 1) || (s.head == s.last) && inner(s.tail.init)
(s.size >= 2) && inner(s)
}
Testing
// Testing
assert(!isPalindrome(""))
assert(!isPalindrome("z"))
assert(isPalindrome("amanaplanacanalpanama"))
assert(!isPalindrome("Test 1,2,3"))
assert(isPalindrome("1 2 1"))
assert(!isPalindrome("A man a plan a canal Panama."))
assert(!isPalindromeSentence(""))
assert(!isPalindromeSentence("z"))
assert(isPalindromeSentence("amanaplanacanalpanama"))
assert(!isPalindromeSentence("Test 1,2,3"))
assert(isPalindromeSentence("1 2 1"))
assert(isPalindromeSentence("A man a plan a canal Panama."))
assert(!isPalindromeRec(""))
assert(!isPalindromeRec("z"))
assert(isPalindromeRec("amanaplanacanalpanama"))
assert(!isPalindromeRec("Test 1,2,3"))
assert(isPalindromeRec("1 2 1"))
assert(!isPalindromeRec("A man a plan a canal Panama."))
println("Successfully completed without errors.")
Scheme
Non-recursive
(define (palindrome? s)
(let ((chars (string->list s)))
(equal? chars (reverse chars))))
Recursive
(define (palindrome? s)
(let loop ((i 0)
(j (- (string-length s) 1)))
(or (>= i j)
(and (char=? (string-ref s i) (string-ref s j))
(loop (+ i 1) (- j 1))))))
;; Or:
(define (palindrome? s)
(let loop ((s (string->list s))
(r (reverse (string->list s))))
(or (null? s)
(and (char=? (car s) (car r))
(loop (cdr s) (cdr r))))))
> (palindrome? "ingirumimusnocteetconsumimurigni")
#t
> (palindrome? "This is not a palindrome")
#f
>
sed
h
:l
s/^\(.\)\(.*\)\1$/\2/
tl
/../d
x
$ printf '%s\n' a zz az bag gag none madamimadam otto | sed -f palindrome.sed a zz gag madamimadam otto
Seed7
const func boolean: palindrome (in string: stri) is func
result
var boolean: isPalindrome is TRUE;
local
var integer: index is 0;
var integer: length is 0;
begin
length := length(stri);
for index range 1 to length div 2 do
if stri[index] <> stri[length - index + 1] then
isPalindrome := FALSE;
end if;
end for;
end func;
For palindromes where spaces shuld be ignore use:
palindrome(replace("in girum imus nocte et consumimur igni", " ", ""))
SequenceL
Using the Reverse Library Function
import <Utilities/Sequence.sl>;
isPalindrome(string(1)) := equalList(string, reverse(string));
Version Using an Indexed Function
isPalindrome(string(1)) :=
let
compares[i] := string[i] = string[size(string) - (i - 1)] foreach i within 1 ... (size(string) / 2);
in
all(compares);
Sidef
Built-in
say "noon".is_palindrome # true
Non-recursive
func palindrome(s) {
s == s.reverse
}
Recursive
func palindrome(s) {
if (s.len <= 1) {
true
}
elsif (s.first != s.last) {
false
}
else {
__FUNC__(s.first(-1).last(-1))
}
}
Simula
BEGIN
BOOLEAN PROCEDURE ISPALINDROME(T); TEXT T;
BEGIN
BOOLEAN RESULT;
INTEGER I, J;
I := 1;
J := T.LENGTH;
RESULT := TRUE;
WHILE RESULT AND I < J DO
BEGIN
CHARACTER L, R;
T.SETPOS(I); L := T.GETCHAR; I := I + 1;
T.SETPOS(J); R := T.GETCHAR; J := J - 1;
RESULT := L = R;
END;
ISPALINDROME := RESULT;
END ISPALINDROME;
TEXT T;
FOR T :- "", "A", "AA", "ABA", "SALALAS", "MADAMIMADAM",
"AB", "AAB", "ABCBDA"
DO
BEGIN
OUTTEXT(IF ISPALINDROME(T) THEN "IS " ELSE "ISN'T");
OUTTEXT(" PALINDROME: ");
OUTCHAR('"');
OUTTEXT(T);
OUTCHAR('"');
OUTIMAGE;
END;
END.
- Output:
IS PALINDROME: "" IS PALINDROME: "A" IS PALINDROME: "AA" IS PALINDROME: "ABA" IS PALINDROME: "SALALAS" IS PALINDROME: "MADAMIMADAM" ISN'T PALINDROME: "AB" ISN'T PALINDROME: "AAB" ISN'T PALINDROME: "ABCBDA"
Slate
Non-Recursive
s@(String traits) isPalindrome
[
(s lexicographicallyCompare: s reversed) isZero
].
Recursive Defined on Sequence since we are not using String-specific methods:
s@(Sequence traits) isPalindrome
[
s isEmpty
ifTrue: [True]
ifFalse: [(s first = s last) /\ [(s sliceFrom: 1 to: s indexLast - 1) isPalindrome]]
].
Testing
define: #p -> 'ingirumimusnocteetconsumimurigni'.
inform: 'sequence ' ; p ; ' is ' ; (p isPalindrome ifTrue: [''] ifFalse: ['not ']) ; 'a palindrome.'.
Smalltalk
isPalindrome := [:aString |
str := (aString select: [:chr| chr isAlphaNumeric]) collect: [:chr | chr asLowercase].
str = str reversed.
].
String extend [
palindro [ "Non-recursive"
^ self = (self reverse)
]
palindroR [ "Recursive"
(self size) <= 1 ifTrue: [ ^true ]
ifFalse: [ |o i f| o := self asOrderedCollection.
i := o removeFirst.
f := o removeLast.
i = f ifTrue: [ ^ (o asString) palindroR ]
ifFalse: [ ^false ]
]
]
].
Testing
('hello' palindro) printNl.
('hello' palindroR) printNl.
('ingirumimusnocteetconsumimurigni' palindro) printNl.
('ingirumimusnocteetconsumimurigni' palindroR) printNl.
SequenceableCollection>>isPalindrome
^self reverse = self
SNOBOL4
define('pal(str)') :(pal_end)
pal str notany(&ucase &lcase) = :s(pal)
str = replace(str,&ucase,&lcase)
leq(str,reverse(str)) :s(return)f(freturn)
pal_end
define('palchk(str)tf') :(palchk_end)
palchk output = str;
tf = 'False'; tf = pal(str) 'True'
output = 'Palindrome: ' tf :(return)
palchk_end
* # Test and display
palchk('Able was I ere I saw Elba')
palchk('In girum imus nocte et consumimur igni')
palchk('The quick brown fox jumped over the lazy dogs')
end
- Output:
Able was I ere I saw Elba Palindrome: True In girum imus nocte et consumimur igni Palindrome: True The quick brown fox jumped over the lazy dogs Palindrome: False
SparForte
As a structured script.
#!/usr/local/bin/spar
pragma annotate( summary, "palindrome" );
pragma annotate( description, "Write at least one function/method (or whatever it is" );
pragma annotate( description, "called in your preferred language) to check if a" );
pragma annotate( description, "sequence of characters (or bytes) is a palindrome or" );
pragma annotate( description, "not. The function must return a boolean value (or" );
pragma annotate( description, "something that can be used as boolean value, like an" );
pragma annotate( description, "integer)." );
pragma annotate( see_also, "http://rosettacode.org/wiki/Palindrome_detection" );
pragma annotate( author, "Ken O. Burtch" );
pragma license( unrestricted );
pragma restriction( no_external_commands );
procedure palindrome is
function is_palindrome( text : string ) return boolean is
begin
for offset in 0..strings.length( text ) / 2 -1 loop
if strings.element( text, offset+1) /= strings.element( text, positive( strings.length( text ) - offset ) ) then
return false;
end if;
end loop;
return true;
end is_palindrome;
sentence : string;
result : boolean;
begin
sentence := "this is a test";
result := is_palindrome( sentence );
put( sentence ) @ ( " : " ) @ ( result );
new_line;
sentence := "ablewasiereisawelba";
result := is_palindrome( sentence );
put( sentence ) @ ( " : " ) @ ( result );
new_line;
end palindrome;
SQL
SET @txt = REPLACE('In girum imus nocte et consumimur igni', ' ', '');
SELECT REVERSE(@txt) = @txt;
Swift
import Foundation
// Allow for easy character checking
extension String {
subscript (i: Int) -> String {
return String(Array(self)[i])
}
}
func isPalindrome(str:String) -> Bool {
if (count(str) == 0 || count(str) == 1) {
return true
}
let removeRange = Range<String.Index>(start: advance(str.startIndex, 1), end: advance(str.endIndex, -1))
if (str[0] == str[count(str) - 1]) {
return isPalindrome(str.substringWithRange(removeRange))
}
return false
}
func isPal(str: String) -> Bool {
let c = str.characters
return lazy(c).reverse()
.startsWith(c[c.startIndex...advance(c.startIndex, c.count / 2)])
}
Tailspin
templates palindrome
[$...] -> #
when <=$(last..first:-1)> do '$...;' !
end palindrome
[['rotor', 'racecar', 'level', 'rosetta']... -> palindrome ] -> !OUT::write
- Output:
[rotor, racecar, level]
Tcl
Non-recursive
package require Tcl 8.5
proc palindrome {s} {
return [expr {$s eq [string reverse $s]}]
}
Recursive
proc palindrome_r {s} {
if {[string length $s] <= 1} {
return true
} elseif {[string index $s 0] ne [string index $s end]} {
return false
} else {
return [palindrome_r [string range $s 1 end-1]]
}
}
Testing
set p ingirumimusnocteetconsumimurigni
puts "'$p' is palindrome? [palindrome $p]"
puts "'$p' is palindrome? [palindrome_r $p]"
TUSCRIPT
$$ MODE TUSCRIPT
pal ="ingirumimusnocteetconsumimurigni"
pal_r=TURN(pal)
SELECT pal
CASE $pal_r
PRINT "true"
DEFAULT
PRINT/ERROR "untrue"
ENDSELECT
- Output:
true
TypeScript
const detectNonLetterRegexp=/[^A-ZÀ-ÞЀ-Я]/g;
function stripDiacritics(phrase:string){
return phrase.normalize('NFD').replace(/[\u0300-\u036f]/g, "")
}
function isPalindrome(phrase:string){
const TheLetters = stripDiacritics(phrase.toLocaleUpperCase().replace(detectNonLetterRegexp, ''));
const middlePosition = TheLetters.length/2;
const leftHalf = TheLetters.substr(0, middlePosition);
const rightReverseHalf = TheLetters.substr(-middlePosition).split('').reverse().join('');
return leftHalf == rightReverseHalf;
}
console.log(isPalindrome('Sueño que esto no es un palíndromo'))
console.log(isPalindrome('Dábale arroz a la zorra el abad!'))
console.log(isPalindrome('Я иду с мечем судия'))
Uiua
Does not ignore spaces.
≍⇌."tacocat"
Extra Credit
Ignores whitespace, converts A-Z to lowercase, only checks a-z, includes tests.
IsPal ← ≍⇌.+×32<@a.▽:⟜∊:/⊂+⊙¤"Aa"⇡26
IsPal "A man, a plan, a canal: Panama!"
UNIX Shell
if [[ "${text}" == "$(rev <<< "${text}")" ]]; then
echo "Palindrome"
else
echo "Not a palindrome"
fi
Ursala
The algorithm is to convert to lower case, and then compare the intersection of the argument and the set of letters (declared in the standard library) with its reversal. This is done using the built in operator suffixes for intersection (c), identity (i), reversal (x) and equality (E).
#import std
palindrome = ~&cixE\letters+ * -:~& ~=`A-~rlp letters
This test programs applies the function to each member of a list of three strings, of which only the first two are palindromes.
#cast %bL
examples = palindrome* <'abccba','foo ba rra bo of','notone'>
- Output:
<true,true,false>
Vala
Checks if a word is a palindrome ignoring the case and spaces.
bool is_palindrome (string str) {
var tmp = str.casefold ().replace (" ", "");
return tmp == tmp.reverse ();
}
int main (string[] args) {
print (is_palindrome (args[1]).to_string () + "\n");
return 0;
}
VBA
This function uses function Reverse() (or Rreverse()) from Reverse a string, after first stripping spaces from the string using the built-in function Replace and converting it to lower case. It can't handle punctuation (yet). Just like the VBScript version it could also work using StrReverse.
Public Function isPalindrome(aString as string) as Boolean
dim tempstring as string
tempstring = Lcase(Replace(aString, " ", ""))
isPalindrome = (tempstring = Reverse(tempstring))
End Function
- Example:
print isPalindrome("In girum imus nocte et consumimur igni") True
VBScript
Implementation
function Squish( s1 )
dim sRes
sRes = vbNullString
dim i, c
for i = 1 to len( s1 )
c = lcase( mid( s1, i, 1 ))
if instr( "abcdefghijklmnopqrstuvwxyz0123456789", c ) then
sRes = sRes & c
end if
next
Squish = sRes
end function
function isPalindrome( s1 )
dim squished
squished = Squish( s1 )
isPalindrome = ( squished = StrReverse( squished ) )
end function
Invocation
wscript.echo isPalindrome( "My dog has fleas")
wscript.echo isPalindrome( "Madam, I'm Adam.")
wscript.echo isPalindrome( "1 on 1")
wscript.echo isPalindrome( "In girum imus nocte et consumimur igni")
- Output:
0 -1 0 -1
Vedit macro language
This routine checks if current line is a palindrome:
:PALINDROME:
EOL #2 = Cur_Col-2
BOL
for (#1 = 0; #1 <= #2/2; #1++) {
if (CC(#1) != CC(#2-#1)) { Return(0) }
}
Return(1)
Testing:
Call("PALINDROME")
if (Return_Value) {
Statline_Message("Yes")
} else {
Statline_Message("No")
}
Return
Visual Basic .NET
Module Module1
Function IsPalindrome(p As String) As Boolean
Dim temp = p.ToLower().Replace(" ", "")
Return StrReverse(temp) = temp
End Function
Sub Main()
Console.WriteLine(IsPalindrome("In girum imus nocte et consumimur igni"))
End Sub
End Module
- Output:
True
V (Vlang)
fn is_pal_1(ss string) bool {
s := ss.runes()
for i in 0..s.len/2 {
if s[i] != s[s.len-1-i]{
return false
}
}
return true
}
fn is_pal_2(word string) bool {
if word == word.runes().reverse().string() {return true}
return false
}
fn main() {
words := ["rotor", "rosetta", "step on no pets", "été", "wren", "🦊😀🦊"]
println('Check from is_pal_1:')
for word in words {
println('$word => ${is_pal_1(word)}')
}
println('\nCheck from is_pal_2:')
for word in words {
println('$word => ${is_pal_2(word)}')
}
}
- Output:
Are the following palindromes? rotor => true rosetta => false step on no pets => true été => true wren => false 🦊😀🦊 => true
Wortel
@let {
; Using a hook
pal1 @(= @rev)
; Function with argument
pal2 &s = s @rev s
; for inexact palindromes
pal3 ^(@(= @rev) .toLowerCase. &\@replace[&"\s+"g ""])
[[
!pal1 "abcba"
!pal2 "abcbac"
!pal3 "In girum imus nocte et consumimur igni"
]]
}
Returns:
[true false true]
Wren
var isPal = Fn.new { |word| word == ((word.count > 0) ? word[-1..0] : "") }
System.print("Are the following palindromes?")
for (word in ["rotor", "rosetta", "step on no pets", "été", "wren", "🦊😀🦊"]) {
System.print(" %(word) => %(isPal.call(word))")
}
- Output:
Are the following palindromes? rotor => true rosetta => false step on no pets => true été => true wren => false 🦊😀🦊 => true
X86 Assembly
; x86_84 Linux nasm
section .text
isPalindrome:
mov rsi, rax
mov rdi, rax
get_end:
cmp byte [rsi], 0
je get_result
inc rsi
jmp get_end
get_result:
mov rax, 0
dec rsi
compare:
mov cl, byte [rdi]
cmp byte [rsi], cl
jne not_palindrome
cmp rsi, rdi
je palindrome
inc rdi
cmp rdi, rsi
je palindrome
dec rsi
jmp compare
not_palindrome:
mov rax, 0
ret
palindrome:
mov rax, 1
ret
XPL0
include c:\cxpl\codes; \intrinsic 'code' declarations
string 0; \use zero-terminated strings
func StrLen(Str); \Return number of characters in an ASCIIZ string
char Str;
int I;
for I:= 0 to -1>>1-1 do
if Str(I) = 0 then return I;
func Palindrome(S); \Return 'true' if S is a palindrome
char S;
int L, I;
[L:= StrLen(S);
for I:= 0 to L/2-1 do
if S(I) # S(L-1-I) then return false;
return true;
]; \Palindrome
int Word, I;
[Word:=
["otto", "mary", "ablewasiereisawelba", "ingirumimusnocteetconsumimurigni"];
for I:= 0 to 4-1 do
[Text(0, if Palindrome(Word(I)) then "yes" else "no");
CrLf(0);
];
]
- Output:
yes no yes yes
YAMLScript
!yamlscript/v0
defn main(n):
say: "$n is $when(
(str(n) != str(n).reverse())
'not '
)a palindrome."
Yorick
Function is_palindrome meets the task description. Function prep_palindrome demonstrates how to convert an English sentence into a form that can be tested with is_palindrome (by changing case and stripping non-alphabetical characters).
func is_palindrome(str) {
s = strchar(str)(:-1);
return allof(s == s(::-1));
}
func prep_palindrome(str) {
s = strchar(strlower(str));
w = where(s >= 'a' & s <= 'z');
return strchar(s(w));
}
Z80 Assembly
Use the /S8 switch on the ZSM4 assembler for 8 significant characters for labels and names
Inexact palindrome detection is integrated - blanks are eliminated and all characters converted to uppercase
Converted string is printed
;
; Check if input string is a palindrome using Z80 assembly language
;
; Runs under CP/M 3.1 on YAZE-AG-2.51.2 Z80 emulator
; Assembled with zsm4 on same emulator/OS, uses macro capabilities of said assembler
; Created with vim under Windows
;
; 2023-04-17 Xorph
;
;
; Useful definitions
;
bdos equ 05h ; Call to CP/M BDOS function
strdel equ 6eh ; Set string delimiter
readstr equ 0ah ; Read string from console
wrtstr equ 09h ; Write string to console
nul equ 00h ; ASCII control characters
esc equ 1bh
cr equ 0dh
lf equ 0ah
buflen equ 30h ; Length of input buffer
;
; Macros for BDOS calls
;
setdel macro char ; Set string delimiter to char
ld c,strdel
ld e,char
call bdos
endm
print macro msg ; Output string to console
ld c,wrtstr
ld de,msg
call bdos
endm
newline macro ; Print newline
ld c,wrtstr
ld de,crlf
call bdos
endm
readln macro buf ; Read a line from input
ld c,readstr
ld de,buf
call bdos
endm
;
; Other macros
;
toupper macro
local notlow
cp 'a'
jr c,notlow
cp 'z'+1
jr nc,notlow
add a,'A'-'a'
notlow:
endm
;
; =====================
; Start of main program
; =====================
;
cseg
setdel nul ; Set string delimiter to 00h
ld b,buflen ; Clear input buffer
ld hl,bufcont
clrloop:
ld (hl),0
inc hl
djnz clrloop
readln inputbuf ; Read a line from input
newline ; Newline is discarded during input, so write one...
ld b,buflen ; Convert all to uppercase
ld hl,bufcont
uprloop:
ld a,(hl)
toupper
ld (hl),a
inc hl
djnz uprloop
ld a,(inputbuf+1) ; Eliminate all spaces
ld b,a
ld c,0 ; Counter for non-spaces
ld ix,bufcont ; String (buffer) address in ix
ld iy,compress ; Compressed string (without blanks) goes to iy
spcloop:
ld a,(ix)
cp ' '
jr z,isblank
inc c ; If not blank, move to (iy) and increment counter
ld (iy),a
inc iy
isblank:
inc ix
djnz spcloop
ld a,c ; Move back to original buffer
ld (inputbuf+1),a ; New length of text without spaces for further processing
ld b,0 ; bc now set correctly to new length
ld de,bufcont ; Set up and use block move
ld hl,compress
ldir
ex de,hl ; Add nul terminator - target is in de, but memory load only via hl
ld (hl),nul
print bufcont ; Print actual text before start of check
newline
ld a,(inputbuf+1) ; Get number of characters entered into bc, if 0 quit
ld b,0 ; bc can be used for adding the text length to iy
cp b ; b is 0 for setting bc correctly and so can also be used for comparison
jr z,isnopali
ld c,a ; bc is now loaded correctly
ld ix,bufcont ; ix points to start of string
ld iy,bufcont ; iy points to end of string: Let it point to start...
add iy,bc ; ...and add the string's length - 1
dec iy
ld b,c ; Use b as counter for comparison (djnz)
srl b ; Only need to check half the chars - if odd, the middle char need not be checked
chkloop:
ld a,(ix) ; Actual comparison: Get (ix) into a and compare with (iy)
cp (iy) ; Upon mismatch, quit immediately
jr nz,isnopali
inc ix
dec iy
djnz chkloop
; All comparisons ok, print success - fall through to ispali
ispali:
ld de,messagey
jr writeres
isnopali:
ld de,messagen
; Fall through to writeres
writeres:
ld c,wrtstr ; Echo the text on screen
call bdos
newline
ret ; Return to CP/M
;
; ===================
; End of main program
; ===================
;
;
; ================
; Data definitions
; ================
;
dseg
inputbuf: ; Input buffer
defb buflen ; Maximum possible length
defb 00h ; Returned length of actual input
bufcont:
defs buflen ; Actual input area
compress:
defs buflen ; For eliminating spaces
messagey:
defz 'Yes' ; Is a Palindrome
messagen:
defz 'No' ; Is not a Palindrome
crlf: defb cr,lf,nul ; Generic newline
- Output:
E>palindrm 1 2 3 2 1 12321 Yes E>palindrm Hello World HELLOWORLD No E>palindrm AbC D cBa ABCDCBA Yes E>palindrm aaabbbccc AAABBBCCC No
zkl
fcn pali(text){
if (text.len()<2) return(False);
text==text.reverse();
}
fcn pali2(text){ pali((text - " \t\n.,").toLower()) } // or whatever punctuation is
- Output:
pali("red rum sir is murder") //--> False pali("red rum sir is murder" - " ") //-->True, remove spaces pali2("In girum imus nocte et consumimur igni") //-->True
Zoea
program: palindrome
case: 1
input: abcdcba
output: true
case: 2
input: dog
output: false
case: 3
input: x
output: true
case: 4
input: abc
output: false
Zoea Visual
- Programming Tasks
- Text processing
- Recursion
- String manipulation
- Classic CS problems and programs
- Palindromes
- 11l
- 360 Assembly
- 8080 Assembly
- 8086 Assembly
- ACL2
- Acornsoft Lisp
- Action!
- ActionScript
- Ada
- ALGOL 68
- APL
- AppleScript
- Applesoft BASIC
- ARM Assembly
- Arturo
- AutoHotkey
- AutoIt
- AWK
- BaCon
- Bash
- BASIC
- IS-BASIC
- Sinclair ZX81 BASIC
- BBC BASIC
- Batch File
- BCPL
- Befunge
- BQN
- Bracmat
- Bruijn
- Burlesque
- C
- C sharp
- C++
- Clojure
- CLU
- COBOL
- CoffeeScript
- Common Lisp
- Component Pascal
- Cowgol
- Crystal
- D
- Dart
- Delphi
- Dyalect
- Déjà Vu
- E
- EasyLang
- EchoLisp
- Ed
- Eiffel
- Ela
- Elixir
- Elm
- Emacs Lisp
- Erlang
- Euphoria
- Excel
- F Sharp
- Factor
- Falcon
- Fantom
- FBSL
- Forth
- Fortran
- FreeBASIC
- Frink
- FutureBasic
- Fōrmulæ
- GAP
- GML
- Go
- GolfScript
- Groovy
- Haskell
- HicEst
- HicEst examples needing attention
- Examples needing attention
- Icon
- Unicon
- Icon Programming Library
- Insitux
- Ioke
- J
- Jakt
- Java
- JavaScript
- Jq
- Jsish
- Julia
- K
- Kotlin
- LabVIEW
- Langur
- Lasso
- Liberty BASIC
- LiveCode
- Logo
- Lua
- M4
- MACRO-11
- Maple
- Mathematica
- Wolfram Language
- MATLAB
- Maxima
- MAXScript
- Min
- MiniScript
- Mirah
- ML
- MLite
- Standard ML
- MMIX
- Modula-2
- Modula-3
- Nanoquery
- Nemerle
- NetRexx
- NewLISP
- Nim
- Objeck
- OCaml
- Octave
- Oforth
- Ol
- Oz
- PARI/GP
- Pascal
- PascalABC.NET
- Perl
- Phix
- Phixmonti
- PHP
- Picat
- PicoLisp
- Pike
- PL/I
- PL/M
- Plain English
- Pointless
- Potion
- PowerBASIC
- PowerShell
- Processing
- Prolog
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- Rascal
- REBOL
- Retro
- Refal
- REXX
- Ring
- RPL
- Ruby
- Rhovas
- Run BASIC
- Rust
- SAS
- Scala
- Scheme
- Sed
- Seed7
- SequenceL
- Sidef
- Simula
- Slate
- Smalltalk
- SNOBOL4
- SparForte
- SQL
- Swift
- Tailspin
- Tcl
- TUSCRIPT
- TypeScript
- Uiua
- UNIX Shell
- Ursala
- Vala
- VBA
- VBScript
- Vedit macro language
- Visual Basic .NET
- V (Vlang)
- Wortel
- Wren
- X86 Assembly
- XPL0
- YAMLScript
- Yorick
- Z80 Assembly
- Zkl
- Zoea
- Zoea Visual
- Pages with too many expensive parser function calls