Palindrome detection: Difference between revisions
→{{header|langur}}
Langurmonkey (talk | contribs) |
|||
| (27 intermediate revisions by 20 users not shown) | |||
Line 218:
(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!}}==
Line 1,116 ⟶ 1,202:
palindrome
</pre>
=={{header|Bruijn}}==
<syntaxhighlight lang="bruijn">
:import std/String .
main [<~>0 =? 0]
:test (main "tacocat") ([[1]])
:test (main "bruijn") ([[0]])
</syntaxhighlight>
=={{header|Burlesque}}==
Line 1,779 ⟶ 1,875:
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}}==
Line 1,898 ⟶ 2,018:
<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}}==
Line 2,490 ⟶ 2,624:
=={{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]]
=={{header|GAP}}==
Line 2,601 ⟶ 2,743:
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}}==
Line 2,762 ⟶ 2,923:
return x
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|Ioke}}==
Line 2,801 ⟶ 2,974:
'isPalin2 foo' %&ts 'isPalin0 foo'
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}}==
Line 3,060 ⟶ 3,259:
=={{header|langur}}==
<syntaxhighlight lang="langur">val .ispal =
val .tests =
"": false,
"z": true,
Line 3,195 ⟶ 3,394:
palindro(`ingirumimusnocteetconsumimurigni')
palindro(`this is not palindrome')</syntaxhighlight>
=={{header|MACRO-11}}==
<syntaxhighlight lang="macro11"> .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</syntaxhighlight>
{{out}}
<pre>.palin racecar
EXACT PALINDROME
.palin raceCAR
INEXACT PALINDROME
.palin rosetta
NOT A PALINDROME</pre>
=={{header|Maple}}==
Line 3,996 ⟶ 4,260:
<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}}==
Line 4,908 ⟶ 5,209:
'ingirumimusnocteetconsumimurigni palindrome? n:put
</syntaxhighlight>
=={{header|Refal}}==
<syntaxhighlight lang="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;
};</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}}==
Line 4,975 ⟶ 5,328:
</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>
{{out}}
<pre>
2: 1
1: 1
</pre>
=={{header|Ruby}}==
Line 5,013 ⟶ 5,395:
iterative 0.062000 0.000000 0.062000 ( 0.055000)
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
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
Line 5,209 ⟶ 5,634:
#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}}==
Line 5,245 ⟶ 5,685:
'''Built-in'''
<syntaxhighlight lang="ruby">say "noon".is_palindrome
'''Non-recursive'''
Line 5,259 ⟶ 5,699:
true
}
elsif (s.first
false
}
else {
__FUNC__(s.
}
}</syntaxhighlight>
Line 5,398 ⟶ 5,838:
The quick brown fox jumped over the lazy dogs
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}}==
Line 5,510 ⟶ 5,992:
console.log(isPalindrome('Я иду с мечем судия'))
</syntaxhighlight>
=={{header|Uiua}}==
Does not ignore spaces.
<syntaxhighlight lang="uiua">≍⇌."tacocat"</syntaxhighlight>
=={{header|UNIX Shell}}==
Line 5,696 ⟶ 6,182:
=={{header|Wren}}==
<syntaxhighlight lang="
System.print("Are the following palindromes?")
Line 5,805 ⟶ 6,291:
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}}==
| |||