Palindrome by deleting a character

Question

I need to find a list of strings with input string length n for whom are palindrome by deleting a character from it . The strings are stored inside function DictionaryLookup[]. Therefore I wrote a support function below

aStringisPal[s_String] := 
 DeleteDuplicates[
  If[StringLength[#] > 0, s, ## &[]] & /@ 
   Select[If[StringLength[#] == StringLength[s] - 1, #, ## &[]] & /@ 
     Map[StringJoin, Subsets[Characters[s]]], PalindromeQ]]

Then I wrote,

aPalInDictionary[n_Integer?Positive] := 
 DeleteCases[
  Map[StringJoin, 
   aStringisPal[#] & /@ 
    Select[DictionaryLookup[], StringLength[#] == n &]], ""]

The output should be a list of words found in DictionaryLookup[] with no duplicates and empty words, which are Palindrome by deleting a character from it .

For example :

aPalInDictionary[3] should give a list below :

{aah, add, all, Ann, ass, baa, BBC, bee, boo, brr, CNN, coo, DDT, \
Dee, ebb, eek, eel, eff, egg, ell, err, fee, gee, goo, ill, inn, lee, \
Lee, LLB, loo, moo, nee, odd, off, ooh, Orr, pee, ppm, see, shh, ssh, \
tee, too, wee, woo, XXL, zoo}

aPalInDictionary[4] should give a list below :

{afar, agar, agog, ahas, ajar, alas, alga, anal, anon, aqua, area, 
   aria, asap, asks, asps, aura, away, ayah, babe, baby, barb, Bede, 
   bibs, blab, blob, bobs, bomb, bozo, bubo, bubs, bulb, Cara, ceca, 
   cede, chic, choc, coca, cock, coco, { ...}, Zeke, Zulu}

The code can run with no error. Unfortunately the code above ran too slow, how can I improve the code to make it more efficient. Besides, is there a way to combine these two functions?

I would appreciate if anyone can help.

Answer 1

It seems like in aStringisPal you're generating all the possible substrings of a string then filtering for those of aproriate length. That seems very inefficient. Also, you should make it as a condition instead of returning the result.

aStringisPal[s_String] :=  
 Select[Map[StringDrop[s, {#}] &, Range[1, StringLength[s]]], 
   PalindromeQ] =!= {}


aPalInDictionary[n_Integer?Positive] := 
 Select[DictionaryLookup[], 
  StringLength[#] == n &&  aStringisPal[#] & ]

aStringisPal can be made faster with for loops or dynamical programing.

Edit: Dynamical programing version of aStringisPal:.

aStringisPal[s_] :=  True /; StringLength[s] <= 2
aStringisPal[s_] := If[StringTake[s, -1] === StringTake[s, 1], 
  aStringisPal[StringDrop[StringDrop[s, 1], -1]],  
  PalindromeQ[StringDrop[s, 1]] || PalindromeQ[StringDrop[s, -1]]]