psm1:

ckp_v4<-function(th=0,depth_level=0,source_pattern,search,target_file_loc,type=c("None","Shortest Path","Full Path"))
  {
    require(igraph)
    search<-paste0(source_pattern,search)
    name<-list()
    current_node_list<-list()
    tab_name_list<-list()
    pattern_list<-list()
    final_list<-list()
    is_shortest_path<-FALSE

    forward_search<-function()
    {
      network=igraph::graph_from_data_frame(d=tab_target, directed=T)
      if(!(length(final_list)==0))
      {
        counter<-1
        lot_df_list<-list()
        temp3<-NULL
        for(i in final_list)
        {
          t=subcomponent(network, i, "out")
          g3<-induced_subgraph(network,t)
          g_ego <- ego(g3, depth_level, nodes=which((V(g3)$name)==i),mode="out")
          g5<-induced_subgraph(g3,g_ego[[1]])
          net_df.el <- as.data.frame(get.edgelist(g5))
          lot_df_list[[counter]] = net_df.el
          counter=counter+1
        }
        list.of.data.frames = lot_df_list
        merged.data.frame = Reduce(function(...) merge(..., all=T),list.of.data.frames)
        write.csv(merged.data.frame,"C:/Users/User/LTrace/finalobj/df1.csv",row.names = FALSE)
        g2=igraph::graph_from_data_frame(d=merged.data.frame,directed=T)
        plot(g2,
             vertex.size=10,
             vertex.label.font=2,
             vertex.label.family="Helvetica",
             vertex.label.cex=0.75,
             vertex.label.color="black",
             vertex.frame.color="white",
             edge.color='grey23',
             edge.width=0.5,
             edge.arrow.size=0.5,
             layout=layout.fruchterman.reingold(g2, niter=10000))
      }
    }


    url_d<-"C://Users/user/LTrace/data"
    #set the current directory to the specified directory
    setwd(url_d)
    #get the list of all csv file object in the current directory
    temp = list.files(pattern="*.csv")
    myfiles <- lapply(temp,function(i){ read.csv(i, fileEncoding="UTF-8-BOM") })

    is_source_target_pattern_same<-FALSE
    gt_end<-FALSE
    gt_starting<-FALSE
    for(a in 1:length(myfiles))
    {
      name[[a]]<-paste(gsub('.csv','', temp[[a]]))
      assign(name[[a]], myfiles[[a]])
      tab_name_call <- sprintf(name[[a]])
      tab <- eval(parse(text = tab_name_call))
      target<-paste0(url_d,"/",temp[[a]])
      if(target_file_loc==target)
      {
        tab_target_name<-name[[a]]
        tab_target <- tab
        tab_name_list<-c(tab_name_list,tab_target_name)
      }
      col_names<-colnames(tab)
      number=nrow(tab)*(th/100)
      rand_rows_tab<-tab[sample(nrow(tab), number),]
      for(c in 1:length(col_names))
      {
        column_call <- sprintf(paste0(name[[a]],'$',col_names[[c]]))
        nth_column<-as.character(eval(parse(text = column_call)))
        nth_column
        pattern<-paste0(Reduce(intersect, strsplit(nth_column, "")),collapse = "")
        if(!gt_end)
        {
          if(name[[a]]==tab_target_name)
          {
            target_pattern<-pattern
            if(source_pattern==target_pattern)
            {
              is_source_target_pattern_same<-TRUE
              break
            }
            gt_end<-TRUE
          }
        }
        if(!(tab_target_name==name[[a]]))
        {
          if(pattern==target_pattern)
          {
            end_point_table<-name[[a]]
          }
        }
        if(pattern==source_pattern)
        {
          if(!gt_starting)
          {
            if(search %in% nth_column)
            {
              source_tab_name<-name[[a]]
              source_col_name<-col_names[[c]]
              source_tab<-tab
              current_node<-paste0(name[[a]],'$',col_names[[c]],'|',pattern)
              current_node_list<-c(current_node_list,current_node)
              tab_name_list<-c(tab_name_list,name[[a]])
              gt_starting<-TRUE
            }
          }
        }
        pattern_node<-paste0(name[[a]],'$',col_names[[c]],'|',pattern)
        pattern_list<-c(pattern_list,pattern_node)
      }
      if(is_source_target_pattern_same)
      {
        break
      }
    }


    is_target_in_source_tab<-FALSE
    if (is.na(tab_target_name) || tab_target_name == '')
    {
      stop("We can't found this target file in our record!Please try again.")
    }


    #if for the multi data source use cases
    if(!(source_pattern==target_pattern))
    {
      if(type=="None")
      {
        stop("Please choose the option for shortest path or multiple path in the select type bar.")
      }
      else
      {
        if(length(current_node_list)==0)
        {
          stop("We can't found this source prefix in our record!Please try again.")
        }
        for(d in 1:length(pattern_list))
        {
          tab_name1<-sub("\\$.*", "", pattern_list[[d]])
          if(source_tab_name==tab_name1)
          {
            tab_col_name<-gsub(".*[$]([^.]+)[|].*", "\\1",pattern_list[[d]])
            if(!(source_col_name==tab_col_name))
            {
              tab_pattern<-sub(".*[|]", "", pattern_list[[d]])

              if(tab_pattern==target_pattern)
              {
                tab_filter<-source_tab[source_tab[[source_col_name]] %in% search,]
                tab_tabcol_name<-paste0("tab_filter$",tab_col_name)
                column_call <- sprintf(tab_tabcol_name)
                final_list <- eval(parse(text = column_call))
                final_list<-as.character(final_list)
                is_target_in_source_tab<-TRUE

                #for the multi data sources use case
                forward_search()
              }
            }
          }
        }
        if(!is_target_in_source_tab)
        {
          f<-1
          temp_current_node_list<-list()
          temp_target_data_list<-list()
          target_data_list<-list()
          target_data_list[[length(target_data_list)+1]]<-list(search)

          ###when there still have the element in the list
          while(f<=length(current_node_list))
          {
            current_node_tab_name<-sub("\\$.*", "",current_node_list[[f]])
            current_node_col_name<-gsub(".*[$]([^.]+)[|].*", "\\1",current_node_list[[f]])
            column_call <- sprintf(current_node_tab_name)
            current_node_tab <- eval(parse(text = column_call))
            current_tab_filter<-current_node_tab[current_node_tab[[current_node_col_name]] %in% target_data_list[[f]][[1]],]
            if(!(nrow(current_tab_filter)==0))
            {
              for(j in 1:length(pattern_list))
              {
                current_tab_name<-sub("\\$.*", "", pattern_list[[j]])
                if(current_tab_name==current_node_tab_name)
                {
                  if(current_tab_name==end_point_table)
                  {
                    pattern_list_pattern<-sub(".*[|]", "",pattern_list[[j]])
                    if(pattern_list_pattern==target_pattern)
                    {
                      124
                      pattern_list_col_name<-gsub(".*[$]([^.]+)[|].*","\\1", pattern_list[[j]])
                      column_call <-sprintf(paste0("current_tab_filter$",pattern_list_col_name))
                      if(type=="Full Path")
                      {
                        final_list[[length(final_list)+1]]<-list(eval(parse(text = column_call)))
                        break
                      }
                      if(type == "Shortest Path")
                      {
                        final_list <-as.character(eval(parse(text=column_call)))
                        is_shortest_path<-TRUE
                        break
                      }
                    }
                    else
                    {
                      next
                    }
                  }
                  for(g in 1:length(pattern_list))
                  {
                    next_tab_name<-sub("\\$.*", "", pattern_list[[g]])
                    if(!(next_tab_name %in% tab_name_list))
                    {
                      125
                      next_full_name<-pattern_list[[g]]
                      current_pattern<-sub(".*[|]", "",pattern_list[[j]])
                      next_pattern<-sub(".*[|]", "", pattern_list[[g]])
                      if(next_pattern==current_pattern)
                      {
                        current_col_name<-gsub(".*[$]([^.]+)[|].*","\\1", pattern_list[[j]])
                        current_column_call <-sprintf(paste0("current_tab_filter$",current_col_name))

                        temp_target_data_list[[length(temp_target_data_list)+1]] <-list(eval(parse(text = current_column_call)))
                        temp_current_node_list<-c(temp_current_node_list,next_full_name)
                        if(!(next_tab_name==end_point_table))
                        {
                          tab_name_list<-c(tab_name_list,next_tab_name)
                        }
                      }
                    }
                  }
                }
              }
              if(is_shortest_path)
              {
                print(final_list)
                forward_search()
                break
              }
            }
            if(f==length(current_node_list))
            {
              if(!(length(temp_current_node_list)==0 && length(temp_target_data_list)==0))
              {
                target_data_list<-NULL
                target_data_list
                target_data_list<-temp_target_data_list
                temp_target_data_list<-NULL
                temp_target_data_list
                current_node_list<-NULL
                current_node_list<-temp_current_node_list
                temp_current_node_list<-NULL
                temp_current_node_list
                tab_name_list
                tab_name_list<-unique(tab_name_list)
                tab_name_list
                f<-0
              }
              else
              {
                if(!(length(final_list)==0))
                {
                  list1<-unlist(final_list, recursive = FALSE)
                  list2<-unlist(list1, recursive = FALSE)
                  final_list<-unique(list2)
                  print(final_list)
                  forward_search()
                }

                else
                {
                  stop("No related Poblem Lot with this search input.")
                }
              }
            }
            f<-f+1
          }
        }
      }
    }

    else
    {
      network=igraph::graph_from_data_frame(d=tab_target, directed=T)
      s=subcomponent(network, search, "in")
      print(search)
      g1<-induced_subgraph(network,s)
      d1<-which(sapply(sapply(V(g1), function(x) neighbors(g1,x,mode="in")), length) == 0)
      print(d1)
      d<-as.vector(names(d1))
      counter<-1
      lot_df_list<-list()
      temp3<-NULL
      for(i in d)
      {
        root=subcomponent(network, i, "out")
        if(is.null(temp3))
        {
          temp3<-root
        }
        else
        {
          temp3<-union(root,temp3)
        }
      }
      g3<-induced_subgraph(network,temp3)
      g_ego2 <- ego(g3, depth_level, nodes=which((V(g3)$name)==search))
      g5<-induced_subgraph(g3,g_ego2[[1]])
      net_df.el <- as.data.frame(get.edgelist(g5))
      write.csv(net_df.el,"C:/Users/user/LTrace/finalobj/df1.csv",row.names = FALSE)
      plot.igraph(g5,edge.color='grey23',
                  vertex.size=10,
                  vertex.label.font=2,
                  vertex.label.family="Helvetica",
                  vertex.label.cex=0.9,
                  vertex.label.color="black",
                  vertex.frame.color="white",
                  edge.width=0.5,
                  edge.arrow.size=0.5,
                  layout=layout.fruchterman.reingold(g5,niter=10000))
    }
  }